Merge branch 'rt'

[fiveam.git] / src / run.lisp

diff --git a/src/run.lisp b/src/run.lisp
index 6e5a7ec..286a7c4 100644 (file)
--- a/src/run.lisp
+++ b/src/run.lisp
@@ -30,8 +30,8 @@
 ;;;;   on this one (even if the dependency is not circular) will be
 ;;;;   skipped.
 
-;;;; The functions RUN!, !, !! and !!! are convenient wrappers around
-;;;; RUN and EXPLAIN.
+;;;; The functions RUN! is a convenient wrapper around RUN and
+;;;; EXPLAIN.
 
 (defparameter *debug-on-error* nil
   "T if we should drop into a debugger on error, NIL otherwise.")
@@ -117,10 +117,12 @@ run."))
 (defun results-status (result-list)
   "Given a list of test results (generated while running a test)
   return true if all of the results are of type TEST-PASSED,
-  faile otherwise."
-  (every (lambda (res)
-           (typep res 'test-passed))
-         result-list))
+  fail otherwise.
+  Returns a second value, which is the set of failed tests."
+  (let ((failed-tests
+          (remove-if #'test-passed-p result-list)))
+    (values (null failed-tests)
+            failed-tests)))
 
 (defun return-result-list (test-lambda)
   "Run the test function TEST-LAMBDA and return a list of all
@@ -202,9 +204,7 @@ run."))
                       (run-tests)
                       (run-tests)))
              (setf suite-results result-list
-                   (status suite) (every (lambda (res)
-                                           (typep res 'test-passed))
-                                         suite-results)))
+                   (status suite) (every #'test-passed-p suite-results)))
         (with-run-state (result-list)
           (setf result-list (nconc result-list suite-results)))))))
 
@@ -226,7 +226,7 @@ run."))
 
 (defun explain! (result-list)
   "Explain the results of RESULT-LIST using a
-detailed-text-explainer with output going to *test-dribble*"
+detailed-text-explainer with output going to `*test-dribble*`"
   (explain (make-instance 'detailed-text-explainer) result-list *test-dribble*))
 
 (defun debug! (&optional (test-spec *suite*))
@@ -265,17 +265,34 @@ a testable-object object. This function changes the operations
 performed by the !, !! and !!! functions."
   (run-and-bind-result-list (lambda () (%run test-spec))))
 
-(defun ! ()
-  "Rerun the most recently run test and explain the results."
-  (explain! (funcall *!*)))
-
-(defun !! ()
-  "Rerun the second most recently run test and explain the results."
-  (explain! (funcall *!!*)))
-
-(defun !!! ()
-  "Rerun the third most recently run test and explain the results."
-  (explain! (funcall *!!!*)))
+(defun run-all-tests ()
+  "Run all tests in arbitrary order."
+  (run-and-bind-result-list
+   (lambda ()
+     (maphash-values
+      (lambda (test)
+        (when (typep test 'test-case)
+          (%run test)))
+      *test*))))
+
+(defun run-all-tests! ()
+  "Equivalent to (explain! (run-all-tests))."
+  (explain! (run-all-tests)))
+
+(defun run-all-test-suites ()
+  "Run all test suites in arbitrary order."
+  (run-and-bind-result-list
+   (lambda ()
+     (maphash-values
+      (lambda (test)
+        (when (typep test 'test-suite)
+          (format *test-dribble* "~& ~A: " (name test))
+          (%run test)))
+      *test*))))
+
+(defun run-all-test-suites! ()
+  "Equivalent to (explain (run-all-test-suites))."
+  (explain! (run-all-test-suites)))
 
 ;; Copyright (c) 2002-2003, Edward Marco Baringer
 ;; All rights reserved.