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

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
......@@ -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)
......
......@@ -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
......
......@@ -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))))))
......
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment