From 1ef5c95980501a04d571d7a0c701f48ade3ff6fe Mon Sep 17 00:00:00 2001
From: "Robert P. Goldman" <rpgoldman@sift.net>
Date: Sun, 24 Jul 2016 12:10:22 -0500
Subject: [PATCH] Modify test-running scripts to catch SERIOUS-CONDITIONs.

There are some serious conditions (e.g., STORAGE-CONDITION) that are not
ERRORs.  Previously, our test scripts only caught ERRORs, meaning that
if a lisp implementation encountered a non-ERROR SERIOUS-CONDITION in
the course of running the tests, odd behavior could result.  E.g.,
running in ECL we would drop into the debugger instead of exiting with a
non-zero exit status.
---
 test/script-support.lisp | 31 ++++++++++++++-----------------
 1 file changed, 14 insertions(+), 17 deletions(-)

diff --git a/test/script-support.lisp b/test/script-support.lisp
index 4409f3dea..e4104481d 100644
--- a/test/script-support.lisp
+++ b/test/script-support.lisp
@@ -373,23 +373,20 @@ is bound, write a message and exit on an error.  If
 *asdf-test-debug* is true, enter the debugger."
   (redirect-outputs)
   (let ((result
-          (catch :asdf-test-done
-            (handler-bind
-                ((error (lambda (c)
-                          (ignore-errors
-                           (format *error-output* "~&TEST ABORTED: ~A~&" c))
-                          (finish-outputs*)
-                          (cond
-                            (*debug-asdf*
-                             (format t "~&It's your baby, fix it!~%")
-                             (break))
-                            (t
-                             (ignore-errors
-                              (acall :print-condition-backtrace
-                                     c :count 69 :stream *error-output*))
-                             (leave-test "Script failed" 1))))))
-              (funcall (or (asym :call-with-asdf-cache) 'funcall) thunk)
-              (leave-test "Script succeeded" 0)))))
+         (catch :asdf-test-done
+           (handler-bind
+               ((serious-condition
+                 (lambda (c)
+                   (ignore-errors
+                     (format *error-output* "~&TEST ABORTED: ~A~&" c))
+                   (finish-outputs*)
+                   (unless *debug-asdf*
+                     (ignore-errors
+                       (acall :print-condition-backtrace
+                              c :count 69 :stream *error-output*))
+                     (leave-test "Script failed" 1)))))
+             (funcall (or (asym :call-with-asdf-cache) 'funcall) thunk)
+             (leave-test "Script succeeded" 0)))))
     (when *quit-when-done*
       (exit-lisp result))))
 
-- 
GitLab