Loading cache.lisp +10 −24 Original line number Diff line number Diff line Loading @@ -7,11 +7,7 @@ #:set-asdf-cache-entry #:unset-asdf-cache-entry #:consult-asdf-cache #:do-asdf-cache #:normalize-namestring #:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache* #:clear-asdf-cache #:reinitialize-source-registry-and-retry ;; defined in source-registry, but specially mentioned here: #:initialize-source-registry )) #:clear-configuration-and-retry #:retry)) (in-package :asdf/cache) ;;; This stamp cache is useful for: Loading @@ -20,8 +16,6 @@ ;; * the ability to test with fake timestamps, without touching files (with-upgradability () (declaim (ftype (function (&optional t) t) initialize-source-registry)) ; forward reference (defvar *asdf-cache* nil) (defun set-asdf-cache-entry (key value-list) Loading @@ -30,10 +24,6 @@ (setf (gethash key *asdf-cache*) value-list) value-list))) (defun clear-asdf-cache () (when *asdf-cache* (setf *asdf-cache* (clrhash *asdf-cache*)))) (defun unset-asdf-cache-entry (key) (when *asdf-cache* (remhash key *asdf-cache*))) Loading @@ -53,21 +43,17 @@ (let ((fun (if key #'(lambda () (consult-asdf-cache key thunk)) thunk))) (if (and *asdf-cache* (not override)) (funcall fun) (flet ((establish-cache-and-call () (let ((*asdf-cache* (make-hash-table :test 'equal))) (funcall fun)))) (loop (restart-case (establish-cache-and-call) (reinitialize-source-registry-and-retry () (let ((*asdf-cache* (make-hash-table :test 'equal))) (return (funcall fun))) (retry () :report (lambda (s) (format s (compatfmt "~@<Retry ASDF operation.~@:>")))) (clear-configuration-and-retry () :report (lambda (s) (format s (compatfmt "~@<Retry ASDF operation after reinitializing the source-registry.~@:>"))) ;; since you're reinitializing the source registry, an arbitrary ;; amount of the ASDF cache is invalidated, not just the entry ;; for the current NAME. (clear-asdf-cache) ;; (unset-asdf-cache-entry `(locate-system ,name)) (initialize-source-registry) (establish-cache-and-call))))))) (format s (compatfmt "~@<Retry ASDF operation after resetting the configuration.~@:>"))) (clear-configuration))))))) (defmacro with-asdf-cache ((&key key override) &body body) `(call-with-asdf-cache #'(lambda () ,@body) :override ,override :key ,key)) Loading find-system.lisp +2 −8 Original line number Diff line number Diff line Loading @@ -423,12 +423,6 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (cdr in-memory)) (error-p (error 'missing-component :requires name)) (t ;; not found: don't keep negative cache (t ;; not found: don't keep negative cache, see lp#1335323 (unset-asdf-cache-entry `(locate-system ,name)) (return-from find-system nil)))))) (reinitialize-source-registry-and-retry () :report (lambda (s) (format s (compatfmt "~@<Retry finding system ~A after reinitializing the source-registry.~@:>") name)) (unset-asdf-cache-entry `(locate-system ,name)) (initialize-source-registry))))))) (return-from find-system nil))))))))))) interface.lisp +3 −4 Original line number Diff line number Diff line Loading @@ -126,12 +126,12 @@ #:package-inferred-system-missing-package-error #:operation-definition-warning #:operation-definition-error #:try-recompiling #:try-recompiling ; restarts #:retry #:accept ; restarts #:accept #:coerce-entry-to-directory #:remove-entry-from-registry #:reinitialize-source-registry-and-retry #:clear-configuration-and-retry #:*encoding-detection-hook* Loading Loading @@ -169,6 +169,5 @@ #:system-source-registry #:user-source-registry-directory #:system-source-registry-directory #:clear-asdf-cache )) source-registry.lisp +0 −1 Original line number Diff line number Diff line Loading @@ -5,7 +5,6 @@ (uiop/package:define-package :asdf/source-registry (:recycle :asdf/source-registry :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/find-system) (:import-from :asdf/cache #:initialize-source-registry) (:export #:*source-registry-parameter* #:*default-source-registries* #:invalid-source-registry Loading test/test-try-refinding.script +48 −45 Original line number Diff line number Diff line Loading @@ -12,6 +12,7 @@ (defun clear-caches-and-search () (setf asdf:*central-registry* nil) (asdf/find-system:clear-defined-system "test-asdf") (asdf/find-system:clear-defined-system "test-asdf/force1")) (DBG "Clearing the caches and finding.") Loading @@ -20,6 +21,7 @@ (DBG "Correctly failed to find system.") (assert (let (tried-once) (with-asdf-cache (:override t) (handler-bind ((asdf:missing-component #'(lambda (c) Loading @@ -29,16 +31,16 @@ (assert (equal missing "test-asdf/force1")) (setf tried-once t) (setf asdf:*central-registry* *old-registry*) (invoke-restart 'asdf:reinitialize-source-registry-and-retry) ) (invoke-restart 'asdf:retry)) ;; avoid infinite looping (error c))))) (asdf:find-system "test-asdf/force1" t)))) (asdf:find-system "test-asdf/force1" t))))) (DBG "Refinding test successful.") (DBG "Now trying LOAD-SYSTEM with refinding.") (clear-caches-and-search) (def-test-system test-missing-dependency :depends-on ("test-asdf/force1") :components ((:file "file2"))) Loading @@ -47,6 +49,7 @@ ;; (trace asdf::component-find-path) ;; (trace operate) (let (tried-once) (with-asdf-cache (:override t) (flet ((handle-missing (c) (if (not tried-once) (let ((missing (asdf::missing-requires c))) Loading @@ -54,11 +57,11 @@ (setf tried-once t) (DBG "Trying to reset the central registry and retry.") (setf asdf:*central-registry* *old-registry*) (unless (find-restart 'asdf:reinitialize-source-registry-and-retry) (error "Expected REINITIALIZE-SOURCE-REGISTRY-AND-RETRY restart not found.")) (unless (find-restart 'asdf:clear-configuration-and-retry) (error "Expected CLEAR-CONFIGURATION-AND-RETRY restart not found.")) (DBG "Before invoking restart, CENTRAL-REGISTRY is:" asdf:*central-registry*) (invoke-restart 'asdf:reinitialize-source-registry-and-retry) (invoke-restart 'asdf:clear-configuration-and-retry) (DBG "After invoking restart, CENTRAL-REGISTRY is:" asdf:*central-registry*)) ;; avoid infinite looping Loading @@ -77,4 +80,4 @@ #'(lambda (c) (DBG "Catching MISSING-COMPONENT condition:" tried-once) (handle-missing c)))) (asdf:load-system "test-missing-dependency")))) (asdf:load-system "test-missing-dependency"))))) Loading
cache.lisp +10 −24 Original line number Diff line number Diff line Loading @@ -7,11 +7,7 @@ #:set-asdf-cache-entry #:unset-asdf-cache-entry #:consult-asdf-cache #:do-asdf-cache #:normalize-namestring #:call-with-asdf-cache #:with-asdf-cache #:*asdf-cache* #:clear-asdf-cache #:reinitialize-source-registry-and-retry ;; defined in source-registry, but specially mentioned here: #:initialize-source-registry )) #:clear-configuration-and-retry #:retry)) (in-package :asdf/cache) ;;; This stamp cache is useful for: Loading @@ -20,8 +16,6 @@ ;; * the ability to test with fake timestamps, without touching files (with-upgradability () (declaim (ftype (function (&optional t) t) initialize-source-registry)) ; forward reference (defvar *asdf-cache* nil) (defun set-asdf-cache-entry (key value-list) Loading @@ -30,10 +24,6 @@ (setf (gethash key *asdf-cache*) value-list) value-list))) (defun clear-asdf-cache () (when *asdf-cache* (setf *asdf-cache* (clrhash *asdf-cache*)))) (defun unset-asdf-cache-entry (key) (when *asdf-cache* (remhash key *asdf-cache*))) Loading @@ -53,21 +43,17 @@ (let ((fun (if key #'(lambda () (consult-asdf-cache key thunk)) thunk))) (if (and *asdf-cache* (not override)) (funcall fun) (flet ((establish-cache-and-call () (let ((*asdf-cache* (make-hash-table :test 'equal))) (funcall fun)))) (loop (restart-case (establish-cache-and-call) (reinitialize-source-registry-and-retry () (let ((*asdf-cache* (make-hash-table :test 'equal))) (return (funcall fun))) (retry () :report (lambda (s) (format s (compatfmt "~@<Retry ASDF operation.~@:>")))) (clear-configuration-and-retry () :report (lambda (s) (format s (compatfmt "~@<Retry ASDF operation after reinitializing the source-registry.~@:>"))) ;; since you're reinitializing the source registry, an arbitrary ;; amount of the ASDF cache is invalidated, not just the entry ;; for the current NAME. (clear-asdf-cache) ;; (unset-asdf-cache-entry `(locate-system ,name)) (initialize-source-registry) (establish-cache-and-call))))))) (format s (compatfmt "~@<Retry ASDF operation after resetting the configuration.~@:>"))) (clear-configuration))))))) (defmacro with-asdf-cache ((&key key override) &body body) `(call-with-asdf-cache #'(lambda () ,@body) :override ,override :key ,key)) Loading
find-system.lisp +2 −8 Original line number Diff line number Diff line Loading @@ -423,12 +423,6 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. (cdr in-memory)) (error-p (error 'missing-component :requires name)) (t ;; not found: don't keep negative cache (t ;; not found: don't keep negative cache, see lp#1335323 (unset-asdf-cache-entry `(locate-system ,name)) (return-from find-system nil)))))) (reinitialize-source-registry-and-retry () :report (lambda (s) (format s (compatfmt "~@<Retry finding system ~A after reinitializing the source-registry.~@:>") name)) (unset-asdf-cache-entry `(locate-system ,name)) (initialize-source-registry))))))) (return-from find-system nil)))))))))))
interface.lisp +3 −4 Original line number Diff line number Diff line Loading @@ -126,12 +126,12 @@ #:package-inferred-system-missing-package-error #:operation-definition-warning #:operation-definition-error #:try-recompiling #:try-recompiling ; restarts #:retry #:accept ; restarts #:accept #:coerce-entry-to-directory #:remove-entry-from-registry #:reinitialize-source-registry-and-retry #:clear-configuration-and-retry #:*encoding-detection-hook* Loading Loading @@ -169,6 +169,5 @@ #:system-source-registry #:user-source-registry-directory #:system-source-registry-directory #:clear-asdf-cache ))
source-registry.lisp +0 −1 Original line number Diff line number Diff line Loading @@ -5,7 +5,6 @@ (uiop/package:define-package :asdf/source-registry (:recycle :asdf/source-registry :asdf) (:use :uiop/common-lisp :uiop :asdf/upgrade :asdf/find-system) (:import-from :asdf/cache #:initialize-source-registry) (:export #:*source-registry-parameter* #:*default-source-registries* #:invalid-source-registry Loading
test/test-try-refinding.script +48 −45 Original line number Diff line number Diff line Loading @@ -12,6 +12,7 @@ (defun clear-caches-and-search () (setf asdf:*central-registry* nil) (asdf/find-system:clear-defined-system "test-asdf") (asdf/find-system:clear-defined-system "test-asdf/force1")) (DBG "Clearing the caches and finding.") Loading @@ -20,6 +21,7 @@ (DBG "Correctly failed to find system.") (assert (let (tried-once) (with-asdf-cache (:override t) (handler-bind ((asdf:missing-component #'(lambda (c) Loading @@ -29,16 +31,16 @@ (assert (equal missing "test-asdf/force1")) (setf tried-once t) (setf asdf:*central-registry* *old-registry*) (invoke-restart 'asdf:reinitialize-source-registry-and-retry) ) (invoke-restart 'asdf:retry)) ;; avoid infinite looping (error c))))) (asdf:find-system "test-asdf/force1" t)))) (asdf:find-system "test-asdf/force1" t))))) (DBG "Refinding test successful.") (DBG "Now trying LOAD-SYSTEM with refinding.") (clear-caches-and-search) (def-test-system test-missing-dependency :depends-on ("test-asdf/force1") :components ((:file "file2"))) Loading @@ -47,6 +49,7 @@ ;; (trace asdf::component-find-path) ;; (trace operate) (let (tried-once) (with-asdf-cache (:override t) (flet ((handle-missing (c) (if (not tried-once) (let ((missing (asdf::missing-requires c))) Loading @@ -54,11 +57,11 @@ (setf tried-once t) (DBG "Trying to reset the central registry and retry.") (setf asdf:*central-registry* *old-registry*) (unless (find-restart 'asdf:reinitialize-source-registry-and-retry) (error "Expected REINITIALIZE-SOURCE-REGISTRY-AND-RETRY restart not found.")) (unless (find-restart 'asdf:clear-configuration-and-retry) (error "Expected CLEAR-CONFIGURATION-AND-RETRY restart not found.")) (DBG "Before invoking restart, CENTRAL-REGISTRY is:" asdf:*central-registry*) (invoke-restart 'asdf:reinitialize-source-registry-and-retry) (invoke-restart 'asdf:clear-configuration-and-retry) (DBG "After invoking restart, CENTRAL-REGISTRY is:" asdf:*central-registry*)) ;; avoid infinite looping Loading @@ -77,4 +80,4 @@ #'(lambda (c) (DBG "Catching MISSING-COMPONENT condition:" tried-once) (handle-missing c)))) (asdf:load-system "test-missing-dependency")))) (asdf:load-system "test-missing-dependency")))))