tests: better reports when /bin/ed is not present.

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

diff --git a/tests/run-tests.lisp b/tests/run-tests.lisp
index b67497e..3d8c3d4 100644 (file)
--- a/tests/run-tests.lisp
+++ b/tests/run-tests.lisp
@@ -1,7 +1,3 @@
-#+#.(cl:if (cl:find-package "ASDF") '(or) '(and))
-(require :asdf)
-
-#+#.(cl:if (cl:find-package "SB-POSIX") '(or) '(and))
 (handler-bind (#+win32 (warning #'muffle-warning))
   (require :sb-posix))
 
@@ -14,10 +10,12 @@
 
 (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)
+(defvar *explicit-test-files* nil)
 
 (defun run-all ()
   (dolist (arg (cdr *posix-argv*))
@@ -28,8 +26,9 @@
            (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*))))
+           (push (truename (parse-namestring arg)) *explicit-test-files*))))
   (pure-runner (pure-load-files) #'load-test)
   (pure-runner (pure-cload-files) #'cload-test)
   (impure-runner (impure-load-files) #'load-test)
@@ -49,12 +48,14 @@
            (format t "Status:~%")
            (dolist (fail (reverse *all-failures*))
              (cond ((eq (car fail) :unhandled-error)
-                    (format t " ~20a ~a~%"
-                            "Unhandled error"
+                    (output-colored-text (car fail)
+                                          " Unhandled Error")
+                    (format t " ~a~%"
                             (enough-namestring (second fail))))
                    ((eq (car fail) :invalid-exit-status)
-                    (format t " ~20a ~a~%"
-                            "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*
@@ -64,14 +65,16 @@
                               (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):"))
+                    (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)
@@ -81,18 +84,18 @@
            (format t "All tests succeeded~%")))))
 
 (defun pure-runner (files test-fun)
-  (format t "// Running pure tests (~a)~%" test-fun)
-  (let ((*package* (find-package :cl-user))
-        (*failures* nil))
-    (setup-cl-user)
-    (dolist (file files)
-      (when (accept-test-file file)
+  (when files
+    (format t "// Running pure tests (~a)~%" test-fun)
+    (let ((*package* (find-package :cl-user))
+          (*failures* nil))
+      (setup-cl-user)
+      (dolist (file files)
         (format t "// Running ~a~%" file)
         (restart-case
             (handler-bind ((error (make-error-handler file)))
               (eval (funcall test-fun file)))
-          (skip-file ()))))
-    (append-failures)))
+          (skip-file ())))
+      (append-failures))))
 
 (defun run-in-child-sbcl (load-forms forms)
   ;; We used to fork() for POSIX platforms, and use this for Windows.
@@ -141,7 +144,7 @@
                                 (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 ()
@@ -150,11 +153,11 @@
         (sb-ext:exit :code 104)))))
 
 (defun impure-runner (files test-fun)
-  (format t "// Running impure tests (~a)~%" test-fun)
-  (let ((*package* (find-package :cl-user)))
-    (setup-cl-user)
-    (dolist (file files)
-      (when (accept-test-file file)
+  (when files
+    (format t "// Running impure tests (~a)~%" test-fun)
+    (let ((*package* (find-package :cl-user)))
+      (setup-cl-user)
+      (dolist (file files)
         (force-output)
         (let ((exit-code (run-impure-in-child-sbcl file
                                                    (funcall test-fun file))))
@@ -174,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*))
@@ -208,28 +211,29 @@
   ;; 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*)))
      (let ((*failures* nil))
        (test-util:report-test-status))
      (sb-ext:exit :code (process-exit-code process))))
 
-(defun accept-test-file (file)
-  (if *accept-files*
-      (find (truename file) *accept-files* :test #'equalp)
-      t))
+(defun filter-test-files (wild-mask)
+  (if *explicit-test-files*
+      (loop for file in *explicit-test-files*
+            when (pathname-match-p file wild-mask)
+            collect file)
+      (directory wild-mask)))
 
 (defun pure-load-files ()
-  (directory "*.pure.lisp"))
+  (filter-test-files "*.pure.lisp"))
 
 (defun pure-cload-files ()
-  (directory "*.pure-cload.lisp"))
+  (filter-test-files "*.pure-cload.lisp"))
 
 (defun impure-load-files ()
-  (directory "*.impure.lisp"))
+  (filter-test-files "*.impure.lisp"))
 
 (defun impure-cload-files ()
-  (directory "*.impure-cload.lisp"))
+  (filter-test-files "*.impure-cload.lisp"))
 
 (defun sh-files ()
-  (directory "*.test.sh"))
+  (filter-test-files "*.test.sh"))