(defparameter *debug-on-failure* nil
"T if we should drop into a debugger on a failing check, NIL otherwise.")
+(defparameter *print-names* t
+ "T if we should print test running progress, NIL otherwise.")
+
(defun import-testing-symbols (package-designator)
(import '(5am::is 5am::is-true 5am::is-false 5am::signals 5am::finishes)
package-designator))
(defgeneric run-resolving-dependencies (test)
(:documentation "Given a dependency spec determine if the spec
is satisfied or not, this will generally involve running other
-tests. If the dependency spec can be satisfied the test is alos
+tests. If the dependency spec can be satisfied the test is also
run."))
(defmethod run-resolving-dependencies ((test test-case))
(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
!!, !!!"))
(defmethod %run ((test test-case))
+ (when *print-names*
+ (format *test-dribble* "~% Running test ~A " (name test)))
(run-resolving-dependencies test))
(defmethod %run ((tests list))
(mapc #'%run tests))
(defmethod %run ((suite test-suite))
+ (when *print-names*
+ (format *test-dribble* "~%Running test suite ~A~%" (name suite)))
(let ((suite-results '()))
(flet ((run-tests ()
(loop
(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)))))))
;;;; ** Public entry points
-(defun run! (&optional (test-spec *suite*))
- "Equivalent to (explain (run TEST-SPEC))."
+(defun run! (&optional (test-spec *suite*)
+ &key ((:print-names *print-names*) *print-names*))
+ "Equivalent to (explain! (run TEST-SPEC))."
(explain! (run test-spec)))
(defun explain! (result-list)
(*debug-on-failure* t))
(run! test-spec)))
-(defun run (test-spec)
+(defun run (test-spec &key ((:print-names *print-names*) *print-names*))
"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))
+ (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))