- (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 *!*))
-
-(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 *!!!*)))
+ (run-and-bind-result-list (lambda () (%run test-spec))))
+
+(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)))