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

Fix the upgrade hooks

The order in which the upgrade fixups were called wasn't very robust.
We need to first get a list of systems being defined, then
clear defined systems (but not asdf, and *neither uiop* that asdf depends on),
then upgrade the configuration, and *finally* reload any of the systems being
defined (including their defsystem-depends-on dependencies!),
which means this all has to be coordinated within the same function.
parent 9893534c
...@@ -154,13 +154,6 @@ then define and register said preloaded system." ...@@ -154,13 +154,6 @@ then define and register said preloaded system."
(if-let (system (and (not (registered-system name)) (sysdef-preloaded-system-search name))) (if-let (system (and (not (registered-system name)) (sysdef-preloaded-system-search name)))
(register-system system))) (register-system system)))
(defun ensure-all-preloaded-systems-registered ()
"Make sure all registered preloaded systems are defined.
This function is run whenever ASDF is upgraded."
(loop :for name :being :the :hash-keys :of *preloaded-systems*
:do (ensure-preloaded-system-registered name)))
(register-hook-function '*post-upgrade-cleanup-hook* 'ensure-all-preloaded-systems-registered)
(defun register-preloaded-system (system-name &rest keys &key (version t) &allow-other-keys) (defun register-preloaded-system (system-name &rest keys &key (version t) &allow-other-keys)
"Register a system as being preloaded. If the system has not been loaded from the filesystem "Register a system as being preloaded. If the system has not been loaded from the filesystem
yet, or if its build information is later cleared with CLEAR-SYSTEM, a dummy system will be yet, or if its build information is later cleared with CLEAR-SYSTEM, a dummy system will be
...@@ -230,9 +223,7 @@ Returns T if system was or is now undefined, NIL if a new preloaded system was r ...@@ -230,9 +223,7 @@ Returns T if system was or is now undefined, NIL if a new preloaded system was r
"Clear all currently registered defined systems. "Clear all currently registered defined systems.
Preloaded systems (including immutable ones) will be reset, other systems will be de-registered." Preloaded systems (including immutable ones) will be reset, other systems will be de-registered."
(loop :for name :being :the :hash-keys :of *defined-systems* (loop :for name :being :the :hash-keys :of *defined-systems*
:unless (equal name "asdf") :do (clear-system name))) :unless (member name '("asdf" "uiop") :test 'equal) :do (clear-system name)))
(register-hook-function '*post-upgrade-cleanup-hook* 'clear-defined-systems nil)
(defun map-systems (fn) (defun map-systems (fn)
"Apply FN to each defined system. "Apply FN to each defined system.
......
...@@ -262,11 +262,19 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) ...@@ -262,11 +262,19 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms."))
(with-upgradability () (with-upgradability ()
(defun restart-upgraded-asdf () (defun restart-upgraded-asdf ()
;; If we're in the middle of something, restart it. ;; If we're in the middle of something, restart it.
(when *asdf-cache* (let ((systems-being-defined
(let ((l (loop :for k :being :the hash-keys :of *asdf-cache* (when *asdf-cache*
:when (eq (first k) 'find-system) :collect (second k)))) (prog1
(clrhash *asdf-cache*) (loop :for k :being :the hash-keys :of *asdf-cache*
(dolist (s l) (find-system s nil))))) :when (eq (first k) 'find-system) :collect (second k))
(clrhash *asdf-cache*)))))
;; Regardless, clear defined systems, since they might be invalid
;; after an incompatible ASDF upgrade.
(clear-defined-systems)
;; The configuration also may have to be upgraded.
(upgrade-configuration)
;; If we were in the middle of an operation, be sure to restore the system being defined.
(dolist (s systems-being-defined) (find-system s nil))))
(register-hook-function '*post-upgrade-cleanup-hook* 'restart-upgraded-asdf) (register-hook-function '*post-upgrade-cleanup-hook* 'restart-upgraded-asdf)
;; The following function's symbol is from asdf/find-system. ;; The following function's symbol is from asdf/find-system.
......
...@@ -152,9 +152,4 @@ previously-loaded version of ASDF." ...@@ -152,9 +152,4 @@ previously-loaded version of ASDF."
(let ((*load-print* nil) (let ((*load-print* nil)
(*compile-print* nil)) (*compile-print* nil))
(handler-bind (((or style-warning) #'muffle-warning)) (handler-bind (((or style-warning) #'muffle-warning))
(symbol-call :asdf :load-system :asdf :verbose nil)))) (symbol-call :asdf :load-system :asdf :verbose nil)))))
;; Register the upgrade-configuration function from UIOP,
;; to ensure configuration is upgraded as needed.
(register-hook-function '*post-upgrade-cleanup-hook* 'upgrade-configuration))
Supports Markdown
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