X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Frun-tests.lisp;h=f1a046f6e51146d58a2ccd2f36d13c99052f430b;hb=47bf3e24a52a2687bd8f07c4674cb9e81163085d;hp=cc1adc6e4be2b346f8d390df514f5c5f16a58b46;hpb=b3e3fbe7d381147fccc8a3027cb6fae923e57d13;p=sbcl.git

diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp
index cc1adc6..f1a046f 100644
--- a/tests/run-tests.lisp
+++ b/tests/run-tests.lisp
@@ -71,13 +71,10 @@
     (dolist (file files)
       (when (accept-test-file file)
         (format t "// Running ~a~%" file)
-        (handler-case
-            (funcall test-fun file)
-          (error (error)
-                 (push (list :unhandled-error file)
-                       *all-failures*)
-                 (when *break-on-error*
-                   (test-util:really-invoke-debugger error))))))
+        (restart-case
+            (handler-bind ((error (make-error-handler file)))
+              (funcall test-fun file))
+          (skip-file ()))))
     (append-failures)))
 
 (defun impure-runner (files test-fun)
@@ -90,12 +87,11 @@
         (let ((pid (sb-posix:fork)))
           (cond ((= pid 0)
                  (format t "// Running ~a~%" file)
-                 (handler-case
-                     (funcall test-fun file)
-                   (error (error)
-                          (push (list :unhandled-error file) *failures*)
-                          (when *break-on-error*
-                            (test-util:really-invoke-debugger error))))
+                 (restart-case
+                     (handler-bind ((error (make-error-handler file)))
+                       (funcall test-fun file))
+                   (skip-file ()
+                     (format t ">>>~a<<<~%" *failures*)))
                  (report-test-status)
                  (sb-ext:quit :unix-status 104))
                 (t
@@ -111,13 +107,24 @@
                        (push (list :invalid-exit-status file)
                              *all-failures*))))))))))
 
+(defun make-error-handler (file)
+  (lambda (condition)
+    (push (list :unhandled-error file) *failures*)
+    (cond (*break-on-error*
+           (test-util:really-invoke-debugger condition))
+          (t
+           (format *error-output* "~&Unhandled ~a: ~a~%"
+                   (type-of condition) condition)
+           (sb-debug:backtrace)))
+    (invoke-restart 'skip-file)))
+
 (defun append-failures (&optional (failures *failures*))
   (setf *all-failures* (append failures *all-failures*)))
 
 (defun unexpected-failures ()
-  (remove-if (lambda (x) 
-                (or (eq (car x) :expected-failure) 
-		    (eq (car x) :unexpected-success)))
+  (remove-if (lambda (x)
+               (or (eq (car x) :expected-failure)
+                   (eq (car x) :unexpected-success)))
              *all-failures*))
 
 (defun setup-cl-user ()