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

Another take on bug1335323

parent fe907bbd
Loading
Loading
Loading
Loading
+10 −24
Original line number Diff line number Diff line
@@ -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))
+2 −8
Original line number Diff line number Diff line
@@ -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)))))))))))
+3 −4
Original line number Diff line number Diff line
@@ -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
   ))
+0 −1
Original line number Diff line number Diff line
@@ -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
+48 −45
Original line number Diff line number Diff line
@@ -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,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)
@@ -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")))
@@ -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)))
@@ -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
@@ -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