diff --git a/test/run-tests.sh b/test/run-tests.sh index 4adc9309449ee5cb967ccedb6faef11b97a40133..46f86d367c4ff4ffd7114d1bfd3bc743c9fa82cd 100755 --- a/test/run-tests.sh +++ b/test/run-tests.sh @@ -286,7 +286,8 @@ valid_upgrade_test_p () { # my old ubuntu clisp 2.44.1 is wired in with an antique ASDF 1.374 from CLC that can't be downgraded. # 2.00[0-7] use UID, which fails on that CLISP and was removed afterwards. # Note that for the longest time, CLISP has included 2.011 in its distribution. - clisp:2.00[0-7]:*) : ;; + # Since we punt on the upgrade, let's only do the test once, for 2.26. + clisp:2.00[0-7]:*|clisp:1.*|clisp:2.0[01]*|clisp:2.2[0-5]:*) : ;; # Skip, CMUCL has problems before 2.014.7 due to source-registry upgrade # Weird unidentified problems before 2.018, so we punt equally for everything before, # and only need to test it once: above, for 2.017. @@ -319,7 +320,7 @@ run_upgrade_tests () { echo "or more interactively (and maybe with rlwrap or in emacs), start with:" echo "$cmd" echo "then copy/paste:" - echo "(load\"$su\") (da) (test-upgrade $method \"$tag\")" + echo "(load\"$su\") (asdf-test::da) (test-upgrade $method \"$tag\")" exit 1 ;} fi ; done ; done 2>&1 | tee build/results/${lisp}-upgrade.text } diff --git a/test/script-support.lisp b/test/script-support.lisp index f51cf074fd9693fff3b2a9b508fbeeb323ae1764..c00c9dfd2164aeb0f505d95dc0a3ed5a7cb38220 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -75,7 +75,7 @@ Some constraints: (namestring (make-pathname :name nil :type nil :defaults path)))))) ;;; Survival utilities -(defun asym (name &optional package (errorp t)) +(defun asym (name &optional package errorp) (let* ((pname (or package :asdf)) (package (find-package pname))) (if package @@ -290,7 +290,7 @@ is bound, write a message and exit on an error. If (acall :print-condition-backtrace c :count 69 :stream *error-output*)) (leave-test "Script failed" 1)))))) - (funcall (or (asym :call-with-asdf-cache :asdf nil) 'funcall) thunk) + (funcall (or (asym :call-with-asdf-cache) 'funcall) thunk) (leave-test "Script succeeded" 0))))) (when *quit-when-done* (exit-lisp result)))) @@ -453,24 +453,30 @@ is bound, write a message and exit on an error. If (clean-asdf-system)) (defun configure-asdf () - (when (asym :getenvp nil nil) + (format t "Configuring ASDF~%") + (when (asym :getenvp) + (format t "Enabling debugging~%") (setf *debug-asdf* (or *debug-asdf* (acall :getenvp "DEBUG_ASDF_TEST")))) - (eval `(trace ,@(loop :for s :in *trace-symbols* :collect (asym s)))) - (when (asym :initialize-source-registry nil nil) + (when *trace-symbols* + (format t "Tracing~{ ~A~}~%" *trace-symbols*) + (eval `(trace ,@(loop :for s :in *trace-symbols* :collect (asym s))))) + (when (asym :initialize-source-registry) (acall :initialize-source-registry `(:source-registry :ignore-inherited-configuration))) - (when (asym :initialize-output-translations nil nil) + (when (asym :initialize-output-translations) (acall :initialize-output-translations `(:output-translations - ((,*asdf-directory*) ,(output-location "asdf")) + ((,(namestring *asdf-directory*)) ,(output-location "asdf")) (t ,(output-location "root")) :ignore-inherited-configuration))) - (when (asym :*central-registry* nil nil) + (when (asym :*central-registry*) (set (asym :*central-registry*) `(,*test-directory*))) + (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 (asym :system-source-directory nil nil) - (let ((x (acall :system-source-directory :test-module-depend))) + (when (and (asym :locate-system) (asym :pathname-directory-pathname)) + (format t "Comparing directories~%") + (let ((x (acall :pathname-directory-pathname (nth-value 2 (acall :locate-system :test-asdf))))) (assert-pathname-equal *test-directory* x) ;; not always EQUAL (!) (unless (equal *test-directory* x) (format t "Interestingly, while *test-directory* has components~% ~S~%~ @@ -531,16 +537,15 @@ is bound, write a message and exit on an error. If (t (format t "Loading old asdf ~A via ~A~%" tag old-method) (funcall old-method tag)))) - (configure-asdf) - (when (asym :*asdf-verbose* nil nil) (setf (asymval :*asdf-verbose*) t)) - (when (asym :*verbose-out* nil nil) (setf (asymval :*verbose-out*) *standard-output*)) + (when (find-package :asdf) + (configure-asdf)) (format t "Now loading new asdf via method ~A~%" new-method) (funcall new-method) (format t "Testing it~%") (register-directory *test-directory*) (load-test-system :test-module-depend) - (assert (eval (intern (symbol-name '#:*file1*) :test-package))) - (assert (eval (intern (symbol-name '#:*file3*) :test-package))))) + (assert (asymval '#:*file1* :test-package)) + (assert (asymval '#:*file3* :test-package)))) ;; These are shorthands for interactive debugging of test scripts: (!a