Merge remote-tracking branch 'strawhatguy/master'

Bring in typo fixes; run-all-tests and friends and nicer IS output.

Conflicts:
	src/check.lisp
	src/run.lisp
	src/suite.lisp

diff --combined src/package.lisp
index fc53982,f6e211b..3ceb1ef
--- 1/src/package.lisp
--- 2/src/package.lisp
+++ b/src/package.lisp
@@@ -20,8 -20,6 +20,8 @@@
  (defpackage :it.bese.fiveam
    (:use :common-lisp :alexandria)
    (:nicknames :5am :fiveam)
 +  #+sb-package-locks
 +  (:lock t)
    (:export
     ;; creating tests and test-suites
     #:make-suite
@@@ -52,8 -50,6 +52,8 @@@
     #:fail
     #:*test-dribble*
     #:for-all
 +   #:*num-trials*
 +   #:*max-trials*
     #:gen-integer
     #:gen-float
     #:gen-character
@@@ -65,9 -61,12 +65,12 @@@
     ;; running tests
     #:run
     #:run-all-tests
+    #:run-all-test-suites
     #:explain
     #:explain!
     #:run!
+    #:run-all-tests!
+    #:run-all-test-suites!
     #:debug!
     #:!
     #:!!
@@@ -76,9 -75,7 +79,9 @@@
     #:*debug-on-error*
     #:*debug-on-failure*
     #:*verbose-failures*
 -   #:results-status))
 +   #:results-status
 +   ;; introspection
 +   #:list-all-suites))
  
  ;;;; You can use #+5am to put your test-defining code inline with your
  ;;;; other code - and not require people to have fiveam to run your

diff --combined src/run.lisp
index 6e50213,15e6ef9..257bff9
--- 1/src/run.lisp
--- 2/src/run.lisp
+++ b/src/run.lisp
@@@ -117,12 -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
@@@ -204,7 -202,9 +204,7 @@@
                        (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)))))))
  
@@@ -221,12 -221,12 +221,12 @@@
  ;;;; ** Public entry points
  
  (defun run! (&optional (test-spec *suite*))
-   "Shortcut for (explain! (run TEST-SPEC))."
+   "Equivalent to (explain! (run TEST-SPEC))."
    (explain! (run test-spec)))
  
  (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*))
@@@ -235,22 -235,35 +235,35 @@@
          (*debug-on-failure* t))
      (run! test-spec)))
  
+ (defun reset-all-tests-status (&optional (tests *test*))
+   "Resets the status of all TESTS to :unknown."
+   (maphash-values
+    (lambda (test)
+      (setf (status test) :unknown))
+    tests))
+ 
+ (defun run-and-set-recently (function)
+   "Shifts the recently executed tests and lastly executes FUNCTION."
+   (shiftf *!!!* *!!* *!* function)
+   (funcall function))
+ 
+ (defun run-and-bind-result-list (function)
+   (run-and-set-recently
+    (lambda ()
+      (reset-all-tests-status)
+      (bind-run-state ((result-list '()))
+        (with-simple-restart
+            (explain "Ignore the rest of the tests and explain current results")
+          (funcall function))
+        result-list))))
+ 
  (defun run (test-spec)
    "Run the test specified by TEST-SPEC.
  
  TEST-SPEC can be either a symbol naming a test or test suite, or
  a testable-object object. This function changes the operations
  performed by the !, !! and !!! functions."
-   (psetf *!* (lambda ()
-                (loop :for test :being :the :hash-keys :of *test*
-                      :do (setf (status (get-test test)) :unknown))
-                (bind-run-state ((result-list '()))
-                  (with-simple-restart (explain "Ignore the rest of the tests and explain current results")
-                    (%run test-spec))
-                  result-list))
-          *!!* *!*
-          *!!!* *!!*)
-   (funcall *!*))
+   (run-and-bind-result-list (lambda () (%run test-spec))))
  
  (defun ! ()
    "Rerun the most recently run test and explain the results."
@@@ -264,6 -277,35 +277,35 @@@
    "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.
  ;;