X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Frun-tests.lisp;h=68cc941a017277360f3e63ee9febec54733e1b9f;hb=062283b901155792f65775491aea51481c56faaa;hp=8cb583f67656bda3ccd317d03711769030b60b07;hpb=01b41fdd69d197da85f86a2e4f8971f3ef9dda82;p=sbcl.git

diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp
index 8cb583f..68cc941 100644
--- a/tests/run-tests.lisp
+++ b/tests/run-tests.lisp
@@ -1,10 +1,5 @@
-#+#.(cl:if (cl:find-package "ASDF") '(or) '(and))
-(load (merge-pathnames "../contrib/asdf/asdf.fasl"))
-
-#+#.(cl:if (cl:find-package "SB-POSIX") '(or) '(and))
-(let ((asdf:*central-registry*
-       (cons "../contrib/systems/" asdf:*central-registry*)))
-  (asdf:oos 'asdf:load-op 'sb-posix))
+(handler-bind (#+win32 (warning #'muffle-warning))
+  (require :sb-posix))
 
 (load "test-util.lisp")
 
@@ -15,8 +10,11 @@
 
 (in-package run-tests)
 
+(load "colorize.lisp")
+
 (defvar *all-failures* nil)
 (defvar *break-on-error* nil)
+(defvar *report-skipped-tests* nil)
 (defvar *accept-files* nil)
 
 (defun run-all ()
@@ -26,6 +24,9 @@
            (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))
+          ((string= arg "--no-color"))
           (t
            (push (truename (parse-namestring arg)) *accept-files*))))
   (pure-runner (pure-load-files) #'load-test)
@@ -34,34 +35,53 @@
   (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.~%")
-  (cond (*all-failures*
-         (format t "Status:~%")
-         (dolist (fail (reverse *all-failures*))
-           (cond ((eq (car fail) :unhandled-error)
-                  (format t " ~20a ~a~%"
-                          "Unhandled error"
-                          (enough-namestring (second fail))))
-                 ((eq (car fail) :invalid-exit-status)
-                  (format t " ~20a ~a~%"
-                          "Invalid exit status:"
-                          (enough-namestring (second fail))))
-                 (t
-                  (format t " ~20a ~a / ~a~%"
-                          (ecase (first fail)
-                            (:expected-failure "Expected failure:")
-                            (:unexpected-failure "Failure:")
-                            (:unexpected-success "Unexpected success:"))
-                          (enough-namestring (second fail))
-                          (third fail))))))
-        (t
-         (format t "All tests succeeded~%"))))
+  (let ((skipcount 0)
+        (*print-pretty* nil))
+    (cond (*all-failures*
+           (format t "Status:~%")
+           (dolist (fail (reverse *all-failures*))
+             (cond ((eq (car fail) :unhandled-error)
+                    (output-colored-text (car fail)
+                                          " Unhandled Error")
+                    (format t " ~a~%"
+                            (enough-namestring (second fail))))
+                   ((eq (car fail) :invalid-exit-status)
+                    (output-colored-text (car fail)
+                                          " Invalid exit status:")
+                    (format t " ~a~%"
+                            (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
+                    (output-colored-text
+                     (first fail)
+                     (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):")))
+                    (format t " ~a / ~a~%"
+                            (enough-namestring (second fail))
+                            (third fail)))))
+           (when (> skipcount 0)
+             (format t " (~a tests skipped for this combination of platform and features)~%"
+                     skipcount)))
+          (t
+           (format t "All tests succeeded~%")))))
 
 (defun pure-runner (files test-fun)
   (format t "// Running pure tests (~a)~%" test-fun)
@@ -112,6 +132,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
@@ -123,13 +144,13 @@
                                 (t
                                  (format *error-output* "~&Unhandled ~a: ~a~%"
                                          (type-of condition) condition)
-                                 (sb-debug:backtrace)))
+                                 (sb-debug:print-backtrace)))
                           (invoke-restart 'skip-file))))
               ,test-code)
           (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)
@@ -156,7 +177,7 @@
           (t
            (format *error-output* "~&Unhandled ~a: ~a~%"
                    (type-of condition) condition)
-           (sb-debug:backtrace)))
+           (sb-debug:print-backtrace)))
     (invoke-restart 'skip-file)))
 
 (defun append-failures (&optional (failures *failures*))
@@ -165,7 +186,9 @@
 (defun unexpected-failures ()
   (remove-if (lambda (x)
                (or (eq (car x) :expected-failure)
-                   (eq (car x) :unexpected-success)))
+                   (eq (car x) :unexpected-success)
+                   (eq (car x) :skipped-broken)
+                   (eq (car x) :skipped-disabled)))
              *all-failures*))
 
 (defun setup-cl-user ()
@@ -188,9 +211,10 @@
   ;; What? No SB-POSIX:EXECV?
   `(let ((process (sb-ext:run-program "/bin/sh"
                                       (list (native-namestring ,file))
-                                      :environment (test-util::test-env)
                                       :output *error-output*)))
-     (sb-ext:quit :unix-status (process-exit-code process))))
+     (let ((*failures* nil))
+       (test-util:report-test-status))
+     (sb-ext:exit :code (process-exit-code process))))
 
 (defun accept-test-file (file)
   (if *accept-files*