Commit da8b51ef authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

1.707: Move upgrade methods around to minimize warnings on some implementations.

parent e258cad5
Loading
Loading
Loading
Loading
+16 −22
Original line number Diff line number Diff line
@@ -63,7 +63,7 @@
        (remove "asdf" excl::*autoload-package-name-alist* :test 'equalp :key 'car))
  (let* ((asdf-version
          ;; the 1+ hair is to ensure that we don't do an inadvertent find and replace
          (subseq "VERSION:1.706" (1+ (length "VERSION"))))
          (subseq "VERSION:1.707" (1+ (length "VERSION"))))
         (existing-asdf (find-package :asdf))
         (versym '#:*asdf-version*)
         (existing-version (and existing-asdf
@@ -313,27 +313,6 @@ Defaults to `t`.")
  (when (boundp 'excl:*warn-on-nested-reader-conditionals*)
    (setf excl:*warn-on-nested-reader-conditionals* nil)))

;;;; -------------------------------------------------------------------------
;;;; Cleanups before hot-upgrade.
;;;; Things to do in case we're upgrading from a previous version of ASDF.
;;;; See https://bugs.launchpad.net/asdf/+bug/485687
;;;; * define methods on UPDATE-INSTANCE-FOR-REDEFINED-CLASS
;;;;   for each of the classes we define that has changed incompatibly.
(eval-when (:compile-toplevel :load-toplevel :execute)
  (when (find-class 'module nil)
    (eval ;; without this protection, Lispworks issues a warning. Sigh.
     '(defmethod update-instance-for-redefined-class :after
       ((m module) added deleted plist &key)
       (when (member 'components-by-name added)
         (compute-module-components-by-name m)))))
  #+ecl
  (when (find-class 'compile-op nil)
    (defmethod update-instance-for-redefined-class :after
        ((c compile-op) added deleted plist &key)
      (format *trace-output* "~&UI4RC:a ~S~%" (list c added deleted plist))
      (let ((system-p (getf plist 'system-p)))
        (when system-p (setf (getf (slot-value c 'flags) :system-p) system-p))))))

;;;; -------------------------------------------------------------------------
;;;; ASDF Interface, in terms of generic functions.

@@ -872,6 +851,13 @@ actually-existing directory."
      :do (setf (gethash name (module-components-by-name module)) c))
    hash))

;; Cleanup before hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687
(when (find-class 'module nil)
  (defmethod update-instance-for-redefined-class :after
      ((m module) added deleted plist &key)
    (when (member 'components-by-name added)
      (compute-module-components-by-name m))))

(defclass module (component)
  ((components
    :initform nil
@@ -1588,6 +1574,14 @@ recursive calls to traverse.")
;;;; -------------------------------------------------------------------------
;;;; compile-op

;; Cleanup before hot-upgrade. See https://bugs.launchpad.net/asdf/+bug/485687
#+ecl
(when (find-class 'compile-op nil)
  (defmethod update-instance-for-redefined-class :after
      ((c compile-op) added deleted plist &key)
    (let ((system-p (getf plist 'system-p)))
      (when system-p (setf (getf (slot-value c 'flags) :system-p) system-p)))))

(defclass compile-op (operation)
  ((proclamations :initarg :proclamations :accessor compile-op-proclamations :initform nil)
   (on-warnings :initarg :on-warnings :accessor operation-on-warnings
+1 −0
Original line number Diff line number Diff line
@@ -43,6 +43,7 @@
;;; code adapted from cl-launch (any errors in transcription are mine!)
;; http://www.cliki.net/cl-launch
(defun leave-lisp (message return)
  (fresh-line *error-output*)
  (when message
    (format *error-output* message)
    (terpri *error-output*))