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."
(if-let (system (and (not (registered-system name)) (sysdef-preloaded-system-search name)))
(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)
"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
......@@ -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.
Preloaded systems (including immutable ones) will be reset, other systems will be de-registered."
(loop :for name :being :the :hash-keys :of *defined-systems*
:unless (equal name "asdf") :do (clear-system name)))
(register-hook-function '*post-upgrade-cleanup-hook* 'clear-defined-systems nil)
:unless (member name '("asdf" "uiop") :test 'equal) :do (clear-system name)))
(defun map-systems (fn)
"Apply FN to each defined system.
......@@ -262,11 +262,19 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms."))
(with-upgradability ()
(defun restart-upgraded-asdf ()
;; If we're in the middle of something, restart it.
(when *asdf-cache*
(let ((l (loop :for k :being :the hash-keys :of *asdf-cache*
:when (eq (first k) 'find-system) :collect (second k))))
(clrhash *asdf-cache*)
(dolist (s l) (find-system s nil)))))
(let ((systems-being-defined
(when *asdf-cache*
(loop :for k :being :the hash-keys :of *asdf-cache*
: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.
;; The configuration also may have to be upgraded.
;; 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)
;; The following function's symbol is from asdf/find-system.
......@@ -152,9 +152,4 @@ previously-loaded version of ASDF."
(let ((*load-print* nil)
(*compile-print* nil))
(handler-bind (((or style-warning) #'muffle-warning))
(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))
(symbol-call :asdf :load-system :asdf :verbose nil)))))
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