Commit 815a1833 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Fix upgrade issues on ABCL and ECL

Fix upgrade on ABCL, that failed to properly process the fact that
initialize-source-registry had moved from asdf/find-system to
asdf/source-registry, yet was called in a cleanup function.

Fix upgrade on ECL, that failed to correctly process that
find-component was fmakunbound.
It also seems to clear *central-registry* in some upgrade scenarios
(that also moved from find-system to system-registry).

Tweak script-support to not unconditionally frob-packages
when ASDF isn't loaded yet, and to not include the asdf directory
when loading and testing only UIOP.
parent 41f397c9
...@@ -7,6 +7,7 @@ ...@@ -7,6 +7,7 @@
:asdf/session :asdf/component :asdf/system :asdf/operation :asdf/action :asdf/lisp-action :asdf/session :asdf/component :asdf/system :asdf/operation :asdf/action :asdf/lisp-action
:asdf/find-component :asdf/system-registry :asdf/plan :asdf/operate) :asdf/find-component :asdf/system-registry :asdf/plan :asdf/operate)
(:import-from #:asdf/component #:%additional-input-files) (:import-from #:asdf/component #:%additional-input-files)
#+abcl (:intern #:initialize-source-registry) ;; to upgrade from 3.1.x
(:export (:export
#:find-system #:locate-system #:load-asd #:define-op #:find-system #:locate-system #:load-asd #:define-op
#:load-system-definition-error #:error-name #:error-pathname #:error-condition)) #:load-system-definition-error #:error-name #:error-pathname #:error-condition))
......
...@@ -5,6 +5,7 @@ ...@@ -5,6 +5,7 @@
(uiop/package:define-package :asdf/source-registry (uiop/package:define-package :asdf/source-registry
(:recycle :asdf/source-registry :asdf) (:recycle :asdf/source-registry :asdf)
(:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/system :asdf/system-registry) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/system :asdf/system-registry)
#+abcl (:import-from :asdf/find-system #:initialize-source-registry) ;; to upgrade from 3.1.x
(:export (:export
#:*source-registry-parameter* #:*default-source-registries* #:*source-registry-parameter* #:*default-source-registries*
#:invalid-source-registry #:invalid-source-registry
......
...@@ -449,7 +449,7 @@ is bound, write a message and exit on an error. If ...@@ -449,7 +449,7 @@ is bound, write a message and exit on an error. If
(quietly (load (asdf-fasl tag)))) (quietly (load (asdf-fasl tag))))
(defun register-directory (dir) (defun register-directory (dir)
(pushnew dir (symbol-value (asym :*central-registry*)))) (pushnew dir (symbol-value (asym :*central-registry*)) :test #'equal))
(defun load-asdf-system (&rest keys) (defun load-asdf-system (&rest keys)
(quietly (quietly
...@@ -659,10 +659,14 @@ is bound, write a message and exit on an error. If ...@@ -659,10 +659,14 @@ is bound, write a message and exit on an error. If
t) t)
(defun frob-packages () (defun frob-packages ()
(format t "Frob packages~%") (cond
(use-package :asdf :asdf-test) ((find-package :asdf)
(when (find-package :uiop) (use-package :uiop :asdf-test)) (format t "Frob packages~%")
(when (find-package :asdf/session) (use-package :asdf/session :asdf-test)) (use-package :asdf :asdf-test)
(when (find-package :uiop) (use-package :uiop :asdf-test))
(when (find-package :asdf/session) (use-package :asdf/session :asdf-test)))
(t
(format t "NB: No packages to frob, because ASDF not loaded yet.")))
(setf *package* (find-package :asdf-test)) (setf *package* (find-package :asdf-test))
t) t)
...@@ -673,12 +677,17 @@ is bound, write a message and exit on an error. If ...@@ -673,12 +677,17 @@ is bound, write a message and exit on an error. If
(and (member :asdf2 *features*) (acall :version-satisfies (acall :asdf-version) "2.11.4")))) (and (member :asdf2 *features*) (acall :version-satisfies (acall :asdf-version) "2.11.4"))))
(leave-test "UIOP will break ASDF < 2.011.4 - skipping test." 0)) (leave-test "UIOP will break ASDF < 2.011.4 - skipping test." 0))
(configure-asdf) (configure-asdf)
(register-directory *asdf-directory*) ;; do NOT include *asdf-directory*, which would defeat the purpose by causing an upgrade
(register-directory *uiop-directory*) (register-directory *uiop-directory*)
(register-directory *test-directory*) (register-directory *test-directory*)
(format t "CR ~S~%" (symbol-value (asym :*central-registry*)))
(format t "loading uiop~%")
(quietly (quietly
(acall :oos (asym :load-op) :uiop)) (acall :oos (asym :load-op) :uiop))
(acall :oos (asym :load-op) :test-module-depend)) (format t "CR ~S~%" (symbol-value (asym :*central-registry*)))
(format t "loading test-module-depend~%")
(acall :oos (asym :load-op) :test-module-depend)
(format t "done loading~%"))
(defun load-asdf (&optional tag) (defun load-asdf (&optional tag)
(load-asdf-fasl tag) (load-asdf-fasl tag)
......
...@@ -106,32 +106,32 @@ previously-loaded version of ASDF." ...@@ -106,32 +106,32 @@ previously-loaded version of ASDF."
;;; Upon upgrade, specially frob some functions and classes that are being incompatibly redefined ;;; Upon upgrade, specially frob some functions and classes that are being incompatibly redefined
(when-upgrading () (when-upgrading ()
(let ((redefined-functions ;; List of functions that changes incompatibly since 2.27: (let* ((previous-version (first *previous-asdf-versions*))
;; gf signature changed (should NOT happen), defun that became a generic function, (redefined-functions ;; List of functions that changes incompatibly since 2.27:
;; method removed that will mess up with new ones (especially :around :before :after, ;; gf signature changed (should NOT happen), defun that became a generic function,
;; more specific or call-next-method'ed method) and/or semantics otherwise modified. Oops. ;; method removed that will mess up with new ones (especially :around :before :after,
;; NB: it's too late to do anything about functions in UIOP! ;; more specific or call-next-method'ed method) and/or semantics otherwise modified. Oops.
;; If you introduce some critical incompatibility there, you must change the function name. ;; NB: it's too late to do anything about functions in UIOP!
;; Note that we don't need do anything about functions that changed incompatibly ;; If you introduce some critical incompatibility there, you must change the function name.
;; from ASDF 2.26 or earlier: we wholly punt on the entire ASDF package in such an upgrade. ;; Note that we don't need do anything about functions that changed incompatibly
;; Also note that we don't include the defgeneric=>defun, because they are ;; from ASDF 2.26 or earlier: we wholly punt on the entire ASDF package in such an upgrade.
;; done directly with defun* and need not trigger a punt on data. ;; Also note that we don't include the defgeneric=>defun, because they are
;; See discussion at https://gitlab.common-lisp.net/asdf/asdf/merge_requests/36 ;; done directly with defun* and need not trigger a punt on data.
'(#:component-depends-on #:input-files ;; methods removed before 3.1.2 ;; See discussion at https://gitlab.common-lisp.net/asdf/asdf/merge_requests/36
#:find-component ;; gf modified in 3.1.7.20 `(,@(when (version<= previous-version "3.1.2") '(#:component-depends-on #:input-files)) ;; crucial methods *removed* before 3.1.2
)) ,@(when (version<= previous-version "3.1.7.20") '(#:find-component))))
(redefined-classes (redefined-classes
;; redefining the classes causes interim circularities ;; redefining the classes causes interim circularities
;; with the old ASDF during upgrade, and many implementations bork ;; with the old ASDF during upgrade, and many implementations bork
#-clozure () #-clozure ()
#+clozure #+clozure
'((#:compile-concatenated-source-op (#:operation) ()) '((#:compile-concatenated-source-op (#:operation) ())
(#:compile-bundle-op (#:operation) ()) (#:compile-bundle-op (#:operation) ())
(#:concatenate-source-op (#:operation) ()) (#:concatenate-source-op (#:operation) ())
(#:dll-op (#:operation) ()) (#:dll-op (#:operation) ())
(#:lib-op (#:operation) ()) (#:lib-op (#:operation) ())
(#:monolithic-compile-bundle-op (#:operation) ()) (#:monolithic-compile-bundle-op (#:operation) ())
(#:monolithic-concatenate-source-op (#:operation) ())))) (#:monolithic-concatenate-source-op (#:operation) ()))))
(loop :for name :in redefined-functions (loop :for name :in redefined-functions
:for sym = (find-symbol* name :asdf nil) :for sym = (find-symbol* name :asdf nil)
:do (when sym (fmakunbound sym))) :do (when sym (fmakunbound sym)))
......
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