Commit 604f5422 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Include DEFINE-OP in mark-component-preloaded

Move it to asdf/find-system.
parent 3d0d07c3
...@@ -246,5 +246,19 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. ...@@ -246,5 +246,19 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(load-asd pathname :name name))))) (load-asd pathname :name name)))))
;; Try again after having loaded from disk if needed ;; Try again after having loaded from disk if needed
(or (registered-system name) (or (registered-system name)
(when error-p (error 'missing-component :requires name)))))))) (when error-p (error 'missing-component :requires name)))))))
;; Resolved forward reference for asdf/system-registry.
(defun mark-component-preloaded (component)
"Mark a component as preloaded."
(let ((component (find-component component nil :registered t)))
;; Recurse to children, so asdf/plan will hopefully be happy.
(map () 'mark-component-preloaded (component-children component))
;; Mark the timestamps of the common lisp-action operations as 0.
(let ((times (component-operation-times component)))
(dolist (o `(,@(when (and (typep component 'system)
(equal (coerce-name component) (primary-system-name component)))
'(define-op))
prepare-op compile-op load-op))
(setf (gethash (make-operation o) times) 0))))))
...@@ -272,17 +272,4 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) ...@@ -272,17 +272,4 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms."))
(upgrade-configuration) (upgrade-configuration)
;; If we were in the middle of an operation, be sure to restore the system being defined. ;; 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)))) (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.
;; It is defined here to resolve what would otherwise be forward package references.
(defun mark-component-preloaded (component)
"Mark a component as preloaded."
(let ((component (find-component component nil :registered t)))
;; Recurse to children, so asdf/plan will hopefully be happy.
(map () 'mark-component-preloaded (component-children component))
;; Mark the timestamps of the common lisp-action operations as 0.
(let ((times (component-operation-times component)))
(dolist (o '(load-op compile-op prepare-op))
(setf (gethash (make-operation o) times) 0))))))
...@@ -15,7 +15,7 @@ ...@@ -15,7 +15,7 @@
#:find-system-if-being-defined #:find-system-if-being-defined
#:contrib-sysdef-search #:sysdef-find-asdf ;; backward compatibility symbols, functions removed #:contrib-sysdef-search #:sysdef-find-asdf ;; backward compatibility symbols, functions removed
#:sysdef-preloaded-system-search #:register-preloaded-system #:*preloaded-systems* #:sysdef-preloaded-system-search #:register-preloaded-system #:*preloaded-systems*
#:mark-component-preloaded ;; forward reference to asdf/operate #:mark-component-preloaded ;; forward reference to asdf/find-system
#:sysdef-immutable-system-search #:register-immutable-system #:*immutable-systems* #:sysdef-immutable-system-search #:register-immutable-system #:*immutable-systems*
#:*defined-systems* #:clear-defined-systems #:*defined-systems* #:clear-defined-systems
;; defined in source-registry, but specially mentioned here: ;; defined in source-registry, but specially mentioned here:
...@@ -81,7 +81,7 @@ called with an object of type asdf:system." ...@@ -81,7 +81,7 @@ called with an object of type asdf:system."
(defvar *preloaded-systems* (make-hash-table :test 'equal) (defvar *preloaded-systems* (make-hash-table :test 'equal)
"Registration table for preloaded systems.") "Registration table for preloaded systems.")
(declaim (ftype (function (t) t) mark-component-preloaded)) ; defined in asdf/operate (declaim (ftype (function (t) t) mark-component-preloaded)) ; defined in asdf/find-system
(defun make-preloaded-system (name keys) (defun make-preloaded-system (name keys)
"Make a preloaded system of given NAME with build information from KEYS" "Make a preloaded system of given NAME with build information from KEYS"
......
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