Commit 338af8ca authored by Francois-Rene Rideau's avatar Francois-Rene Rideau

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.
parent 3dd1f67d
......@@ -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 ()
......
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