Commit 00256418 authored by Robert P. Goldman's avatar Robert P. Goldman

Drop caching from LOCATE-SYSTEM.

Caching negative results here causes pervasive problems, and removing
negative caching only would be very messy, so we are removing caching
here altogether.

This required some modification to the test code, which was directly
using LOCATE-SYSTEM, and LOCATE-SYSTEM cannot be safely invoked unless
the ASDF-CACHE has been established.
parent 2301a5e9
...@@ -358,8 +358,7 @@ PATHNAME when not null is a path from which to load the system, ...@@ -358,8 +358,7 @@ PATHNAME when not null is a path from which to load the system,
either associated with FOUND-SYSTEM, or with the PREVIOUS 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 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." PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded."
(with-asdf-cache (:key `(locate-system ,name)) (let* ((name (coerce-name name))
(let* ((name (coerce-name name))
(in-memory (system-registered-p name)) ; load from disk if absent or newer on disk (in-memory (system-registered-p name)) ; load from disk if absent or newer on disk
(previous (cdr in-memory)) (previous (cdr in-memory))
(previous (and (typep previous 'system) previous)) (previous (and (typep previous 'system) previous))
...@@ -380,7 +379,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. ...@@ -380,7 +379,7 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(setf found (sysdef-preloaded-system-search "asdf")) (setf found (sysdef-preloaded-system-search "asdf"))
(assert (typep found 'system)) (assert (typep found 'system))
(setf found-system found pathname nil)))) (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)) (defmethod find-system ((name string) &optional (error-p t))
(with-asdf-cache (:key `(find-system ,name)) (with-asdf-cache (:key `(find-system ,name))
...@@ -423,6 +422,5 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded. ...@@ -423,6 +422,5 @@ PREVIOUS-TIME when not null is the time at which the PREVIOUS system was loaded.
(cdr in-memory)) (cdr in-memory))
(error-p (error-p
(error 'missing-component :requires name)) (error 'missing-component :requires name))
(t ;; not found: don't keep negative cache, see lp#1335323 (t
(unset-asdf-cache-entry `(locate-system ,name))
(return-from find-system nil))))))))))) (return-from find-system nil)))))))))))
...@@ -552,16 +552,18 @@ is bound, write a message and exit on an error. If ...@@ -552,16 +552,18 @@ is bound, write a message and exit on an error. If
(when (asym :*verbose-out*) (setf (asymval :*verbose-out*) *standard-output*)) (when (asym :*verbose-out*) (setf (asymval :*verbose-out*) *standard-output*))
(when (and (asym :locate-system) (asym :pathname-directory-pathname) (asym :pathname-equal)) (when (and (asym :locate-system) (asym :pathname-directory-pathname) (asym :pathname-equal))
(format t "Comparing directories~%") (format t "Comparing directories~%")
(let ((x (acall :pathname-directory-pathname (nth-value 2 (acall :locate-system :test-asdf))))) (acall :call-with-asdf-cache
(assert-pathname-equal-helper ;; not always EQUAL (!) #'(lambda ()
'*test-directory* *test-directory* (let ((x (acall :pathname-directory-pathname (nth-value 2 (acall :locate-system :test-asdf)))))
'(:pathname-directory-pathname (nth-value 2 (:locate-system :test-asdf))) x) (assert-pathname-equal-helper ;; not always EQUAL (!)
(unless (equal *test-directory* x) '*test-directory* *test-directory*
(format t "Interestingly, while *test-directory* has components~% ~S~%~ '(:pathname-directory-pathname (nth-value 2 (:locate-system :test-asdf))) x)
(unless (equal *test-directory* x)
(format t "Interestingly, while *test-directory* has components~% ~S~%~
ASDF finds the ASDs in~% ~S~%Using the latter.~%" ASDF finds the ASDs in~% ~S~%Using the latter.~%"
(pathname-components *test-directory*) (pathname-components *test-directory*)
(pathname-components x))) (pathname-components x)))
(setf *test-directory* x))) (setf *test-directory* x)))))
t) t)
(defun frob-packages () (defun frob-packages ()
......
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