diff --git a/cache.lisp b/cache.lisp index ec395ad116b83a50d87392ee6ef30908143710c2..1d15e40da146c9002e5b4545e714527089570b71 100644 --- a/cache.lisp +++ b/cache.lisp @@ -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: @@ -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) @@ -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*))) @@ -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)) diff --git a/find-system.lisp b/find-system.lisp index ba1c3961a0883789b1057eae81e190618164e3b5..9a3b1f1917e93e1c276a43f3e9a5f9326b292040 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -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))))))))))) diff --git a/interface.lisp b/interface.lisp index 7ce3764b5de185e4e9a5b7c031e218b93ec7365a..f637b3a818a84dbd47d1e36c44ac44c014d372d0 100644 --- a/interface.lisp +++ b/interface.lisp @@ -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* @@ -169,6 +169,5 @@ #:system-source-registry #:user-source-registry-directory #:system-source-registry-directory - #:clear-asdf-cache )) diff --git a/source-registry.lisp b/source-registry.lisp index cc7fd3d4b7ca1d19b5dd94b0bff9dfdda62031ed..d85285fdb052002cdd4a0602f035397121f01d34 100644 --- a/source-registry.lisp +++ b/source-registry.lisp @@ -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 diff --git a/test/test-try-refinding.script b/test/test-try-refinding.script index 330ea0afc83801bd6537e0a494a1bf20c3783119..ec1da8d30ff42e642c4a73294970edab4572deea 100644 --- a/test/test-try-refinding.script +++ b/test/test-try-refinding.script @@ -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.") @@ -20,25 +21,26 @@ (DBG "Correctly failed to find system.") (assert (let (tried-once) - (handler-bind - ((asdf:missing-component - #'(lambda (c) - (DBG "Caught MISSING-COMPONENT condition.") - (if (not tried-once) - (let ((missing (asdf::missing-requires c))) - (assert (equal missing "test-asdf/force1")) - (setf tried-once t) - (setf asdf:*central-registry* *old-registry*) - (invoke-restart 'asdf:reinitialize-source-registry-and-retry) - ) - ;; avoid infinite looping - (error c))))) - (asdf:find-system "test-asdf/force1" t)))) + (with-asdf-cache (:override t) + (handler-bind + ((asdf:missing-component + #'(lambda (c) + (DBG "Caught MISSING-COMPONENT condition.") + (if (not tried-once) + (let ((missing (asdf::missing-requires c))) + (assert (equal missing "test-asdf/force1")) + (setf tried-once t) + (setf asdf:*central-registry* *old-registry*) + (invoke-restart 'asdf:retry)) + ;; avoid infinite looping + (error c))))) + (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"))) @@ -47,34 +49,35 @@ ;; (trace asdf::component-find-path) ;; (trace operate) (let (tried-once) - (flet ((handle-missing (c) - (if (not tried-once) - (let ((missing (asdf::missing-requires c))) - (assert (equal missing "test-asdf/force1")) - (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.")) - (DBG "Before invoking restart, CENTRAL-REGISTRY is:" - asdf:*central-registry*) - (invoke-restart 'asdf:reinitialize-source-registry-and-retry) - (DBG "After invoking restart, CENTRAL-REGISTRY is:" - asdf:*central-registry*)) - ;; avoid infinite looping - (error c)))) - (handler-bind - ((asdf:missing-dependency-of-version - #'(lambda (c) - ;; Nothing Quicklisp can do to recover from this, so - ;; just resignal - (error c))) - (asdf:missing-dependency - #'(lambda (c) - (DBG "Catching MISSING-DEPENDENCY condition:" tried-once) - (handle-missing c))) - (asdf:missing-component - #'(lambda (c) - (DBG "Catching MISSING-COMPONENT condition:" tried-once) - (handle-missing c)))) - (asdf:load-system "test-missing-dependency")))) + (with-asdf-cache (:override t) + (flet ((handle-missing (c) + (if (not tried-once) + (let ((missing (asdf::missing-requires c))) + (assert (equal missing "test-asdf/force1")) + (setf tried-once t) + (DBG "Trying to reset the central registry and retry.") + (setf asdf:*central-registry* *old-registry*) + (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:clear-configuration-and-retry) + (DBG "After invoking restart, CENTRAL-REGISTRY is:" + asdf:*central-registry*)) + ;; avoid infinite looping + (error c)))) + (handler-bind + ((asdf:missing-dependency-of-version + #'(lambda (c) + ;; Nothing Quicklisp can do to recover from this, so + ;; just resignal + (error c))) + (asdf:missing-dependency + #'(lambda (c) + (DBG "Catching MISSING-DEPENDENCY condition:" tried-once) + (handle-missing c))) + (asdf:missing-component + #'(lambda (c) + (DBG "Catching MISSING-COMPONENT condition:" tried-once) + (handle-missing c)))) + (asdf:load-system "test-missing-dependency"))))) diff --git a/test/test-utilities.script b/test/test-utilities.script index de51182ec9fbeb23092ecd24806794a47d485256..ec02a68fd54411ff6690d82cbb8bc89ca65bf3cd 100644 --- a/test/test-utilities.script +++ b/test/test-utilities.script @@ -161,7 +161,7 @@ asdf/find-system:contrib-sysdef-search asdf/find-system:sysdef-find-asdf ;; restart - asdf/cache:reinitialize-source-registry-and-retry + asdf/cache:clear-configuration-and-retry )) (defun defined-symbol-p (symbol)