Skip to content
Snippets Groups Projects
Commit 1722af58 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

More test system tweaks.

parent 08635fc3
No related branches found
No related tags found
No related merge requests found
......@@ -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
}
......
......@@ -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
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment