From 604f542293ab69431fba1faa8091ee1d5cbd99b0 Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Mon, 7 Nov 2016 08:14:16 -0500 Subject: [PATCH] Include DEFINE-OP in mark-component-preloaded Move it to asdf/find-system. --- find-system.lisp | 16 +++++++++++++++- operate.lisp | 15 +-------------- system-registry.lisp | 4 ++-- 3 files changed, 18 insertions(+), 17 deletions(-) diff --git a/find-system.lisp b/find-system.lisp index c33d11657..8203a30c4 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -246,5 +246,19 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (load-asd pathname :name name))))) ;; Try again after having loaded from disk if needed (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)))))) diff --git a/operate.lisp b/operate.lisp index 051afe558..8c2a21d4b 100644 --- a/operate.lisp +++ b/operate.lisp @@ -272,17 +272,4 @@ the implementation's REQUIRE rather than by internal ASDF mechanisms.")) (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) - - ;; 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)))))) - + (register-hook-function '*post-upgrade-cleanup-hook* 'restart-upgraded-asdf)) diff --git a/system-registry.lisp b/system-registry.lisp index a6a647bd9..c2c023d1e 100644 --- a/system-registry.lisp +++ b/system-registry.lisp @@ -15,7 +15,7 @@ #:find-system-if-being-defined #:contrib-sysdef-search #:sysdef-find-asdf ;; backward compatibility symbols, functions removed #: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* #:*defined-systems* #:clear-defined-systems ;; defined in source-registry, but specially mentioned here: @@ -81,7 +81,7 @@ called with an object of type asdf:system." (defvar *preloaded-systems* (make-hash-table :test 'equal) "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) "Make a preloaded system of given NAME with build information from KEYS" -- GitLab