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