diff --git a/test/script-support.lisp b/test/script-support.lisp index a09eae12bcfd2899ae6dc28f9ed3088bac1a9aea..f4252d89916e1745d9c102d1cddeaf9d87be80e5 100644 --- a/test/script-support.lisp +++ b/test/script-support.lisp @@ -41,7 +41,7 @@ Some constraints: `(;; If you want to trace some stuff while debugging ASDF, ;; here's a nice place to say what. ;; These string designators will be interned in ASDF after it is loaded. - + ;;#+ecl ,@'( :perform :input-files :output-files :compile-file* :compile-file-pathname* :load*) )) @@ -114,17 +114,22 @@ Some constraints: (format *error-output* "~&Checking whether ~S~%" ',x) (finish-output *error-output*) (assert ,x))) -(defmacro signals (condition sexp) +(defmacro signals (condition sexp &aux (x (gensym))) `(progn (format *error-output* "~&Checking whether ~S signals ~S~%" ',sexp ',condition) (finish-output *error-output*) (handler-case ,sexp - (,condition () t) - (t (c) - (error "Expression ~S raises signal ~S, not ~S" ',sexp c ',condition)) - (:no-error () - (error "Expression ~S fails to raise condition ~S" ',sexp ',condition))))) + (,condition (,x) + (format *error-output* "~&Received signal ~S~%" ,x) + (finish-output *error-output*) + t) + (:no-error (&rest ,x) + (error "Expression ~S fails to raise condition ~S, instead returning~{ ~S~}" + ',sexp ',condition ,x)) + (t (,x) + (error "Expression ~S raises signal ~S, not ~S" ',sexp ,x ',condition))))) + ;;; Helpful for debugging (defun pathname-components (p) @@ -477,7 +482,7 @@ is bound, write a message and exit on an error. If (null "1.0")))))) (defun output-location (&rest sublocation) - (list* *asdf-directory* "build/fasls" :implementation-type sublocation)) + (list* *asdf-directory* "build/fasls" :implementation sublocation)) (defun resolve-output (&rest sublocation) (acall :resolve-location (apply 'output-location sublocation))) diff --git a/test/stamp-propagation/test-stamp-propagation.lisp b/test/stamp-propagation/test-stamp-propagation.lisp index 544cacb142943bbf04bb4362372b471bdc984fd9..44de66f239af9ccf87dbebfd36cc3f6b8053b177 100644 --- a/test/stamp-propagation/test-stamp-propagation.lisp +++ b/test/stamp-propagation/test-stamp-propagation.lisp @@ -3,7 +3,7 @@ (unless (find-package :asdf-test) (load (merge-pathnames - (make-pathname :defaults *load-pathname* + (make-pathname :defaults *load-pathname* :name "script-support" :directory '(:relative :back)) *load-pathname*))) @@ -145,10 +145,10 @@ (test-defsystem :asdf) -#+(or genera) +#+(or genera lispworks) (test-defsystem :native) -#+(or allegro lispworks) +#+(or allegro) (signals error (test-defsystem :native)) #+mkdefsystem