-;; -*- lisp -*-
+;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
-(in-package :it.bese.FiveAM)
+(in-package :it.bese.fiveam)
;;;; * Running Tests
;;;; 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.")
(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))
(setf (status test) :circular))))
(t (status test))))
+(defgeneric resolve-dependencies (depends-on))
+
(defmethod resolve-dependencies ((depends-on symbol))
"A test which depends on a symbol is interpreted as `(AND
,DEPENDS-ON)."
(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
(funcall test-lambda)
result-list))
+(defgeneric run-test-lambda (test))
+
(defmethod run-test-lambda ((test test-case))
(with-run-state (result-list)
(bind-run-state ((current-test test))
(let ((*readtable* (copy-readtable))
(*package* (runtime-package test)))
(if (collect-profiling-info test)
- (setf (profiling-info test)
- (arnesi:collect-timing (test-lambda test)))
+ ;; Timing info doesn't get collected ATM, we need a portable library
+ ;; (setf (profiling-info test) (collect-timing (test-lambda test)))
+ (funcall (test-lambda test))
(funcall (test-lambda test))))
(retest ()
:report (lambda (stream)
(bind-run-state ((result-list '()))
(unwind-protect
(if (collect-profiling-info suite)
- (setf (profiling-info suite) (collect-timing #'run-tests))
+ ;; Timing info doesn't get collected ATM, we need a portable library
+ ;; (setf (profiling-info suite) (collect-timing #'run-tests))
+ (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)))))))
(defmethod %run ((test-name symbol))
- (when-bind test (get-test test-name)
+ (when-let (test (get-test test-name))
(%run test)))
(defvar *initial-!* (lambda () (format t "Haven't run that many tests yet.~%")))
;;;; ** Public entry points
(defun run! (&optional (test-spec *suite*))
- "Equivalent to (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*))
(*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 *!*))
-
-(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)))
;; Copyright (c) 2002-2003, Edward Marco Baringer
;; All rights reserved.
projects / fiveam.git / blobdiff