From 142531784ff443f761bb52e5024f7b5c5d84cea1 Mon Sep 17 00:00:00 2001
From: Francois-Rene Rideau <tunes@google.com>
Date: Mon, 14 Oct 2013 18:18:59 -0400
Subject: [PATCH] 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.

---
 test/script-support.lisp                      | 21 ++++++++++++-------
 .../test-stamp-propagation.lisp               |  6 +++---
 2 files changed, 16 insertions(+), 11 deletions(-)

diff --git a/test/script-support.lisp b/test/script-support.lisp
index a09eae12b..f4252d899 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 544cacb14..44de66f23 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
-- 
GitLab