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

Fix upgrade on clisp on ecl

Get rid of undefined-function and any clisp or ecl specific code in it in
uiop/utility as well as of a lingering #-clisp in asdf/upgrade. Whatever
issues previous generations of upgrade code tried to address, they happily
do not apply today.

Update test-sysdef-asdf to better test asdf self-upgrade.
parent 90b32a83
Loading
Loading
Loading
Loading
+3 −3
Original line number Diff line number Diff line
@@ -22,9 +22,9 @@
   ))
(in-package :asdf/output-translations)

;; (setf output-translations) at some point used to be a macro for the sake of
;; obsolete versions of GCL. Make sure that macro doesn't come to haunt us.
(when-upgrading () (undefine-function '(setf output-translations)))
;; (setf output-translations) between 2.27 and 3.0.3 was using a defsetf macro
;; for the sake of obsolete versions of GCL 2.6. Make sure it doesn't come to haunt us.
(when-upgrading (:version "3.1.2") (fmakunbound '(setf output-translations)))

(with-upgradability ()
  (define-condition invalid-output-translation (invalid-configuration warning)
+21 −13
Original line number Diff line number Diff line
@@ -51,11 +51,13 @@
;; But if we cheat on our version, that should work
(setf asdf::*asdf-version* "3.0")
(clear-system "asdf")
(defparameter *count* 0)
(defmethod input-files :after ((load-op operation) (c system))
  (incf *count*))
(def-test-system "fooey")
(defparameter *ticks* 0)
(defun tick () (incf *ticks*))
(defmethod input-files :after ((load-op operation) (c system)) (tick))
(input-files 'load-op "asdf")
(assert-equal *count* 3)
(assert-equal *ticks* 3)
(assert (find-system "fooey" nil))
(with-expected-failure (#+xcl t)
  ;; expected-failure: XCL has trouble with the ASDF upgrade
  (load-system :asdf)
@@ -63,29 +65,35 @@
                         (system-source-file (find-system :asdf))))

;; Upgrading from an old-enough version redefined away the input-files method!
(setf *count* 4)
(setf *ticks* 4)
(input-files 'load-op "asdf")
(assert-equal *count* 4)
(assert-equal *ticks* 4)
;; It also cleared away previously defined systems
(assert (not (find-system "fooey" nil)))


;; The data-punting upgrade will mess up component identity, so clear the cache
(clear-cache)

(setf asdf::*asdf-version* asdf/upgrade::*oldest-forward-compatible-asdf-version*)
(clear-system "asdf")
(setf *count* 5)
(def-test-system "fooey")
(setf *ticks* 5)
(defmethod input-files :after ((load-op operation) (c system))
  (incf *count*))
  (incf *ticks*))
(input-files 'load-op "uiop")
(assert-equal *count* 8)
(assert-equal *ticks* 8)
(with-expected-failure (#+xcl t)
  ;; expected-failure: XCL has trouble with the ASDF upgrade
  (load-system :asdf))
;; Upgrading from an recent-enough version, the input-files method was preserved!
;; Upgrading from a recent-enough version, the input-files method was preserved!
;; But we need to clear the cache for it not to be short-circuited.
(clear-cache)
(setf *count* 9)
(input-files 'load-op "uiop")
(assert-equal *count* 12)
(assert (find-system "fooey" nil))

(setf *ticks* 9)
(eval '(input-files 'load-op "uiop"))
(assert-equal *ticks* 12)

;;; disabling this test on windows since it relies on running make-asdf.bat, which
;;; does not work for me under cygwin. - rpg 2016-03-20
+3 −21
Original line number Diff line number Diff line
@@ -12,7 +12,7 @@
   ;; magic helper to define debugging functions:
   #:uiop-debug #:load-uiop-debug-utility #:*uiop-debug-utility*
   #:with-upgradability ;; (un)defining functions in an upgrade-friendly way
   #:undefine-function #:undefine-functions #:defun* #:defgeneric*
   #:defun* #:defgeneric*
   #:nest #:if-let ;; basic flow control
   #:while-collecting #:appendf #:length=n-p #:ensure-list ;; lists
   #:remove-plist-keys #:remove-plist-key ;; plists
@@ -43,24 +43,6 @@
;; even if the signature and/or generic-ness of the function has changed.
;; For a generic function, this invalidates any previous DEFMETHOD.
(eval-when (:load-toplevel :compile-toplevel :execute)
  (defun undefine-function (function-spec)
    (cond
      ((symbolp function-spec)
       ;; undefining the previous function is the portable way
       ;; of overriding any incompatible previous gf,
       ;; but CLISP needs extra help with getting rid of previous methods.
       #+clisp
       (let ((f (and (fboundp function-spec) (fdefinition function-spec))))
         (when (typep f 'clos:standard-generic-function)
           (loop :for m :in (clos:generic-function-methods f)
                 :do (remove-method f m))))
       (fmakunbound function-spec))
      ((and (consp function-spec) (eq (car function-spec) 'setf)
            (consp (cdr function-spec)) (null (cddr function-spec)))
       (fmakunbound function-spec))
      (t (error "bad function spec ~S" function-spec))))
  (defun undefine-functions (function-spec-list)
    (map () 'undefine-function function-spec-list))
  (macrolet
      ((defdef (def* def)
         `(defmacro ,def* (name formals &rest rest)
@@ -72,8 +54,8 @@
              `(progn
                 ;; We usually try to do it only for the functions that need it,
                 ;; which happens in asdf/upgrade - however, for ECL, we need this hammer.
                 ,@(when (or supersede #+(or clasp ecl) t)
                     `((undefine-function ',name)))
                 ,@(when supersede
                     `((fmakunbound ',name)))
                 ,@(when (and #+(or clasp ecl) (symbolp name)) ; fails for setf functions on ecl
                     `((declaim (notinline ,name))))
                 (,',def ,name ,formals ,@rest))))))
+4 −5
Original line number Diff line number Diff line
@@ -123,11 +123,10 @@ previously-loaded version of ASDF."
         ;; with the old ASDF during upgrade, and many implementations bork
         '((#:compile-concatenated-source-op (#:operation) ()))))
    (loop :for name :in redefined-functions
          :for sym = (find-symbol* name :asdf nil) :do
            (when sym
              ;; CLISP seemingly can't fmakunbound and define a function in the same fasl. Sigh.
              #-clisp (fmakunbound sym)))
    (labels ((asym (x) (multiple-value-bind (s p) (if (consp x) (values (car x) (cadr x)) (values x :asdf))
      :for sym = (find-symbol* name :asdf nil)
      :do (when sym (fmakunbound sym)))
    (labels ((asym (x) (multiple-value-bind (s p)
                           (if (consp x) (values (car x) (cadr x)) (values x :asdf))
                         (find-symbol* s p nil)))
             (asyms (l) (mapcar #'asym l)))
      (loop* :for (name superclasses slots) :in redefined-classes