Kill leftover threads after each test

[sbcl.git] / tests / run-tests.lisp

diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp
index 0069333..2cdd163 100644 (file)
--- a/tests/run-tests.lisp
+++ b/tests/run-tests.lisp
@@ -17,6 +17,7 @@
 
 (defvar *all-failures* nil)
 (defvar *break-on-error* nil)
+(defvar *report-skipped-tests* nil)
 (defvar *accept-files* nil)
 
 (defun run-all ()
@@ -26,6 +27,8 @@
            (setf test-util:*break-on-failure* t))
           ((string= arg "--break-on-expected-failure")
            (setf test-util:*break-on-expected-failure* t))
+          ((string= arg "--report-skipped-tests")
+           (setf *report-skipped-tests* t))
           (t
            (push (truename (parse-namestring arg)) *accept-files*))))
   (pure-runner (pure-load-files) #'load-test)
@@ -34,14 +37,15 @@
   (impure-runner (impure-cload-files) #'cload-test)
   #-win32 (impure-runner (sh-files) #'sh-test)
   (report)
-  (sb-ext:quit :unix-status (if (unexpected-failures)
-                                1
-                                104)))
+  (sb-ext:exit :code (if (unexpected-failures)
+                         1
+                         104)))
 
 (defun report ()
   (terpri)
   (format t "Finished running tests.~%")
-  (let ((skipcount 0))
+  (let ((skipcount 0)
+        (*print-pretty* nil))
     (cond (*all-failures*
            (format t "Status:~%")
            (dolist (fail (reverse *all-failures*))
@@ -54,12 +58,18 @@
                             "Invalid exit status:"
                             (enough-namestring (second fail))))
                    ((eq (car fail) :skipped-disabled)
+                    (when *report-skipped-tests*
+                      (format t " ~20a ~a / ~a~%"
+                              "Skipped (irrelevant):"
+                              (enough-namestring (second fail))
+                              (third fail)))
                     (incf skipcount))
                    (t
                     (format t " ~20a ~a / ~a~%"
                             (ecase (first fail)
                               (:expected-failure "Expected failure:")
                               (:unexpected-failure "Failure:")
+                              (:leftover-thread "Leftover thread (broken):")
                               (:unexpected-success "Unexpected success:")
                               (:skipped-broken "Skipped (broken):")
                               (:skipped-disabled "Skipped (irrelevant):"))
@@ -120,6 +130,7 @@
             ,test-util:*break-on-expected-failure*)
       (let ((file ,test-file)
             (*break-on-error* ,run-tests::*break-on-error*))
+        (declare (special *break-on-error*))
         (format t "// Running ~a~%" file)
         (restart-case
             (handler-bind
@@ -137,7 +148,7 @@
           (skip-file ()
             (format t ">>>~a<<<~%" test-util::*failures*)))
         (test-util:report-test-status)
-        (sb-ext:quit :unix-status 104)))))
+        (sb-ext:exit :code 104)))))
 
 (defun impure-runner (files test-fun)
   (format t "// Running impure tests (~a)~%" test-fun)
@@ -202,7 +213,7 @@
                                       :output *error-output*)))
      (let ((*failures* nil))
        (test-util:report-test-status))
-     (sb-ext:quit :unix-status (process-exit-code process))))
+     (sb-ext:exit :code (process-exit-code process))))
 
 (defun accept-test-file (file)
   (if *accept-files*