diff --git a/find-system.lisp b/find-system.lisp index 9a3b1f1917e93e1c276a43f3e9a5f9326b292040..b9c9464fdd0a7812ad4864ccdcf28ac88e7352e4 100644 --- a/find-system.lisp +++ b/find-system.lisp @@ -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))))))))))) diff --git a/test/script-support.lisp b/test/script-support.lisp index 6b0a4069d294afae386dc517ad38237a5c422b8b..c85f209a1c03262f07f6e55f1362840de5ce5519 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -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 ()