Commit 9ee02fc8 authored by Robert P. Goldman's avatar Robert P. Goldman
Browse files

Simpler FIND-SYSTEM patch by just not doing negative caching. Thanks to Fare.

parent 999cdd21
Loading
Loading
Loading
Loading
+50 −55
Original line number Diff line number Diff line
@@ -21,11 +21,11 @@
   #:clear-defined-system #:clear-defined-systems #:*defined-systems*
   #:*immutable-systems*
   ;; defined in source-registry, but specially mentioned here:
   #:sysdef-source-registry-search
   ))
   #:initialize-source-registry #:sysdef-source-registry-search))
(in-package :asdf/find-system)

(with-upgradability ()
  (declaim (ftype (function (&optional t) t) initialize-source-registry)) ; forward reference

  (define-condition missing-component (system-definition-error)
    ((requires :initform "(unnamed)" :reader missing-requires :initarg :requires)
@@ -382,12 +382,13 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
             (setf found-system found pathname nil))))
        (values foundp found-system pathname previous previous-time))))

  (defun find-system-1 (name)
  (defmethod find-system ((name string) &optional (error-p t))
    (with-asdf-cache (:key `(find-system ,name))
      (let ((primary-name (primary-system-name name)))
        (unless (equal name primary-name)
          (find-system primary-name nil)))
                             (prog ()
      (loop
        (restart-case
            (multiple-value-bind (foundp found-system pathname previous previous-time)
                (locate-system name)
              (when (and found-system (eq found-system previous)
@@ -415,25 +416,19 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
                  (load-asd pathname :name name)))
              (let ((in-memory (system-registered-p name))) ; try again after loading from disk if needed
                (return
                                        (when in-memory
                  (cond
                    (in-memory
                     (when pathname
                       (setf (car in-memory) (get-file-stamp pathname)))
                                          (cdr in-memory))))))))

  (defmethod find-system ((name string) &optional (error-p t))
    (restart-case
     (let ((ret (find-system-1 name)))
       (cond (ret ret)
                     (cdr in-memory))
                    (error-p
                     (error 'missing-component :requires name))
             (t nil)))
                    (t ;; not found: don't keep negative cache
                     (unset-asdf-cache-entry `(locate-system ,name))
                     (return-from find-system nil))))))
          (reinitialize-source-registry-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)
                                             (find-system name error-p)))))
                      (format s (compatfmt "~@<Retry finding system ~A after reinitializing the source-registry.~@:>") name))
            (unset-asdf-cache-entry `(locate-system ,name))
            (initialize-source-registry)))))))