Commit 2301a5e9 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

Another take on bug1335323

parent fe907bbd
......@@ -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))
......
......@@ -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)))))))))))
......@@ -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
))
......@@ -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
......
......@@ -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")))))
......@@ -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)
......
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