From 338af8cad45a74a3534236e100f36484147cc49b Mon Sep 17 00:00:00 2001 From: Francois-Rene Rideau <fare@tunes.org> Date: Sat, 17 Sep 2016 18:45:47 -0400 Subject: [PATCH] script-support: reinstate call-with-asdf-cache When testing upgrade from old versions of ASDF, we must accommodate the need that some old versions have for us to wrap the calls in c-w-a-c, and the need for yet older versions for us not to call c-w-a-c, that didn't exist back then. --- test/script-support.lisp | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/test/script-support.lisp b/test/script-support.lisp index f47482433..0e8a94cff 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -621,18 +621,24 @@ is bound, write a message and exit on an error. If (format t "Being a bit verbose~%") (when (asym :*asdf-verbose*) (setf (asymval :*asdf-verbose*) t)) (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~%~ + (funcall + ;; Old versions of ASDF don't always use with-asdf-cache in locate system, but need it. + ;; So we do it for them for the sake of testing upgrade from these old versions. + ;; Yet older versions of ASDF don't even have this cache, so then we don't. + (or (asym :call-with-asdf-cache) 'funcall) + (lambda () + (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~%~ 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 () -- GitLab