Commit 14253178 authored by Francois-Rene Rideau's avatar Francois-Rene Rideau
Browse files

Use :implementation, not :implementation-type in script-support's output-translations,

or else allegro and allegromodern will clash wrt fasls.
Make test-stamp-propagation pass on LispWorks.
parent 99628bca
......@@ -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)))
......
......@@ -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
......
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