Commit 438e1a97 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Have locate-system use with-asdf-cache but not cache its own results

This should make Daniel K happy.
Also remove obsolete cleaning of locate-system cached results,
for we haven't cached the result since 00256418 (3.1.2.9, 2014),
that this commit partly undoes, partly re-does
(due to merge conflict at the time).
parent c47c22a6
Loading
Loading
Loading
Loading
+26 −25
Original line number Diff line number Diff line
@@ -160,7 +160,6 @@ NIL if not cleared because the system was found to be immutable."
    (let ((name (coerce-name system)))
      (unless (and *immutable-systems* (gethash name *immutable-systems*))
        (remhash (coerce-name name) *defined-systems*)
        (unset-asdf-cache-entry `(locate-system ,name))
        (unset-asdf-cache-entry `(find-system ,name))
        t)))

@@ -383,6 +382,9 @@ PATHNAME when not null is a path from which to load the system,
either associated with FOUND-SYSTEM, or with the PREVIOUS system.
PREVIOUS when not null is a previously loaded SYSTEM object of same name.
PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded."
    (with-asdf-cache () ;; NB: We don't cache the results. We once used to, but it wasn't useful,
      ;; and keeping a negative cache was a bug (see lp#1335323), which required
      ;; explicit invalidation in clear-system and find-system (when unsucccessful).
      (let* ((name (coerce-name name))
             (in-memory (system-registered-p name)) ; load from disk if absent or newer on disk
             (previous (cdr in-memory))
@@ -404,7 +406,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
             (setf found (sysdef-preloaded-system-search "asdf"))
             (assert (typep found 'system))
             (setf found-system found pathname nil))))
      (values foundp found-system pathname previous previous-time)))
        (values foundp found-system pathname previous previous-time))))

  (defmethod find-system ((name string) &optional (error-p t))
    (with-asdf-cache (:key `(find-system ,name))
@@ -443,6 +445,5 @@ 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, see lp#1335323
                 (unset-asdf-cache-entry `(locate-system ,name))
                (t
                 (return-from find-system nil)))))))))
+10 −12
Original line number Diff line number Diff line
@@ -619,8 +619,6 @@ is bound, write a message and exit on an error. If
  (when (asym :*verbose-out*) (setf (asymval :*verbose-out*) *standard-output*))
  (when (and (asym :locate-system) (asym :pathname-directory-pathname) (asym :pathname-equal))
    (format t "Comparing directories~%")
    (acall :call-with-asdf-cache
             #'(lambda ()
    (let ((x (acall :pathname-directory-pathname (nth-value 2 (acall :locate-system :test-asdf)))))
      (assert-pathname-equal-helper ;; not always EQUAL (!)
       '*test-directory* *test-directory*
@@ -630,7 +628,7 @@ is bound, write a message and exit on an error. If
                 ASDF finds the ASDs in~% ~S~%Using the latter.~%"
                (pathname-components *test-directory*)
                (pathname-components x)))
                   (setf *test-directory* x)))))
      (setf *test-directory* x)))
  t)

(defun frob-packages ()
+0 −1
Original line number Diff line number Diff line
@@ -89,7 +89,6 @@

(DBG "Check that require-system of touched .asd will reload the asdf.")
(DBG "(That's what it does now, but if it could be fixed that'd be nice.)")
(unset-asdf-cache-entry '(locate-system "test-asdf"))
(unset-asdf-cache-entry '(find-system "test-asdf"))
(unset-asdf-cache-entry '(find-system "test-asdf/force"))
(touch-file "test-asdf.asd" :timestamp (+ 10000 (get-file-stamp file1)))