Skip to content
Snippets Groups Projects
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
No related branches found
No related tags found
No related merge requests found
...@@ -41,7 +41,7 @@ Some constraints: ...@@ -41,7 +41,7 @@ Some constraints:
`(;; If you want to trace some stuff while debugging ASDF, `(;; If you want to trace some stuff while debugging ASDF,
;; here's a nice place to say what. ;; here's a nice place to say what.
;; These string designators will be interned in ASDF after it is loaded. ;; These string designators will be interned in ASDF after it is loaded.
;;#+ecl ,@'( :perform :input-files :output-files :compile-file* :compile-file-pathname* :load*) ;;#+ecl ,@'( :perform :input-files :output-files :compile-file* :compile-file-pathname* :load*)
)) ))
...@@ -114,17 +114,22 @@ Some constraints: ...@@ -114,17 +114,22 @@ Some constraints:
(format *error-output* "~&Checking whether ~S~%" ',x) (format *error-output* "~&Checking whether ~S~%" ',x)
(finish-output *error-output*) (finish-output *error-output*)
(assert ,x))) (assert ,x)))
(defmacro signals (condition sexp) (defmacro signals (condition sexp &aux (x (gensym)))
`(progn `(progn
(format *error-output* "~&Checking whether ~S signals ~S~%" ',sexp ',condition) (format *error-output* "~&Checking whether ~S signals ~S~%" ',sexp ',condition)
(finish-output *error-output*) (finish-output *error-output*)
(handler-case (handler-case
,sexp ,sexp
(,condition () t) (,condition (,x)
(t (c) (format *error-output* "~&Received signal ~S~%" ,x)
(error "Expression ~S raises signal ~S, not ~S" ',sexp c ',condition)) (finish-output *error-output*)
(:no-error () t)
(error "Expression ~S fails to raise condition ~S" ',sexp ',condition))))) (: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 ;;; Helpful for debugging
(defun pathname-components (p) (defun pathname-components (p)
...@@ -477,7 +482,7 @@ is bound, write a message and exit on an error. If ...@@ -477,7 +482,7 @@ is bound, write a message and exit on an error. If
(null "1.0")))))) (null "1.0"))))))
(defun output-location (&rest sublocation) (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) (defun resolve-output (&rest sublocation)
(acall :resolve-location (apply 'output-location sublocation))) (acall :resolve-location (apply 'output-location sublocation)))
......
...@@ -3,7 +3,7 @@ ...@@ -3,7 +3,7 @@
(unless (find-package :asdf-test) (unless (find-package :asdf-test)
(load (merge-pathnames (load (merge-pathnames
(make-pathname :defaults *load-pathname* (make-pathname :defaults *load-pathname*
:name "script-support" :directory '(:relative :back)) :name "script-support" :directory '(:relative :back))
*load-pathname*))) *load-pathname*)))
...@@ -145,10 +145,10 @@ ...@@ -145,10 +145,10 @@
(test-defsystem :asdf) (test-defsystem :asdf)
#+(or genera) #+(or genera lispworks)
(test-defsystem :native) (test-defsystem :native)
#+(or allegro lispworks) #+(or allegro)
(signals error (test-defsystem :native)) (signals error (test-defsystem :native))
#+mkdefsystem #+mkdefsystem
......
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