Skip to content
Snippets Groups Projects
Commit 00256418 authored by Robert P. Goldman's avatar Robert P. Goldman
Browse files

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
No related branches found
No related tags found
No related merge requests found
......@@ -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.
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 (: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
(previous (cdr in-memory))
(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.
(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))
......@@ -423,6 +422,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)))))))))))
......@@ -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 (and (asym :locate-system) (asym :pathname-directory-pathname) (asym :pathname-equal))
(format t "Comparing directories~%")
(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*
'(: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~%~
(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*
'(: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.~%"
(pathname-components *test-directory*)
(pathname-components x)))
(setf *test-directory* x)))
(pathname-components *test-directory*)
(pathname-components x)))
(setf *test-directory* x)))))
t)
(defun frob-packages ()
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment