diff --git a/src/package.lisp b/src/package.lisp index 3279a9a..5600319 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -79,7 +79,8 @@ #:*on-failure* #:*verbose-failures* #:*print-names* - #:results-status)) + #:results-status + #:test-spec-failure)) ;;;; 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 --git a/src/run.lisp b/src/run.lisp index 89c5223..f09c192 100644 --- a/src/run.lisp +++ b/src/run.lisp @@ -266,6 +266,35 @@ run.")) (when-let (test (get-test test-name)) (%run test))) +(define-condition test-spec-failure (asdf:test-op-test-failures) + ((test-spec :initarg :test-spec + :reader test-spec-failure-spec)) + (:documentation + "Super-class of conditions signalled by RUN to indicate test failures. +See also documentation for parent condition ASDF:TEST-OP-TEST-FAILURES")) + +(define-condition test-spec-failure-no-tests (test-spec-failure) () + (:documentation + "Condition to indicate that the given test spec did not result in any tests being run.") + (:report + (lambda (condition stream) + (write-string "Error: no tests ran for test spec: " stream) + (prin1 (test-spec-failure-spec condition) stream)))) + +(define-condition test-spec-failure-tests-failed (test-spec-failure) + ((result-list :initarg :result-list + :reader test-spec-failure-result-list)) + (:documentation "Condition to indicate that the given test spec has one or more failing tests.") + (:report + (lambda (condition stream) + (write-string "Failing tests in test spec " stream) + (prin1 (test-spec-failure-spec condition) stream) + (terpri stream) + (let ((*print-names* nil) + (*test-dribble* stream)) + (explain! + (test-spec-failure-result-list condition)))))) + (defvar *initial-!* (lambda () (format t "Haven't run that many tests yet.~%"))) (defvar *!* *initial-!*) @@ -319,7 +348,29 @@ performed by the !, !! and !!! functions." (format *test-dribble* "*DEBUG-ON-FAILURE* is obsolete. Use *ON-FAILURE*.") :debug) (t nil))))) - (funcall *!*))) + (let ((result-list (funcall *!*))) + (multiple-value-bind (all-pass? failed skipped) + (results-status result-list) + (cond + ((= (length result-list) (length skipped)) + (restart-case (signal 'test-spec-failure-no-tests + :test-spec test-spec) + ;; here for FiveAM's test suite, where RUN is called + ;; from RUN + (ignore-failure ()))) + ((not all-pass?) + (restart-case + (signal 'test-spec-failure-tests-failed + :test-spec test-spec + :result-list result-list + :tests-run-count (length result-list) + :failed-test-names + (mapcar (lambda (test-result) + (prin1-to-string + (name (test-case test-result)))) + failed)) + (ignore-failure ()))))) + result-list))) (defun ! () "Rerun the most recently run test and explain the results." diff --git a/t/tests.lisp b/t/tests.lisp index ed1c565..48650bf 100644 --- a/t/tests.lisp +++ b/t/tests.lisp @@ -7,8 +7,12 @@ (def-suite test-suite :description "Suite for tests which should fail.") (defmacro with-test-results ((results test-name) &body body) - `(let ((,results (with-*test-dribble* nil (run ',test-name)))) - ,@body)) + `(handler-bind + ((test-spec-failure (lambda (condition) + (declare (ignore condition)) + (invoke-restart 'ignore-failure)))) + (let ((,results (with-*test-dribble* nil (run ',test-name)))) + ,@body))) (def-fixture null-fixture () `(progn ,@(&body))) @@ -129,7 +133,7 @@ (is (= 2 (length (remove-if-not #'test-passed-p results)))) (is (= 1 (length (remove-if-not #'test-failure-p results)))))) -(def-test circular-0 (:depends-on (and circular-1 circular-2 or1) +(def-test circular-0 (:depends-on (and circular-1 circular-2 or1) :suite test-suite) (fail "we depend on a circular dependency, we should not be tested.")) @@ -187,7 +191,7 @@ (def-test before () (with-test-results (results before-test-suite) (is (some #'test-skipped-p results))) - + (with-test-results (results before-test-suite-2) (is (every #'test-passed-p results)))) @@ -273,8 +277,27 @@ (def-test return-values () "Return values indicate test failures." - (is-true (with-*test-dribble* nil (explain! (run 'is1)))) - (is-true (with-*test-dribble* nil (run! 'is1))) - - (is-false (with-*test-dribble* nil (explain! (run 'is2)))) - (is-false (with-*test-dribble* nil (run! 'is2)))) + (handler-bind + ((test-spec-failure (lambda (condition) + (declare (ignore condition)) + (invoke-restart 'ignore-failure)))) + (is-true (with-*test-dribble* nil (explain! (run 'is1)))) + (is-true (with-*test-dribble* nil (run! 'is1))) + + (is-false (with-*test-dribble* nil (explain! (run 'is2)))) + (is-false (with-*test-dribble* nil (run! 'is2))))) + +(def-test signals-on-empty-test-suite () + (signals test-spec-failure + (run ()))) + +(def-test signals-on-failing-tests () + (signals test-spec-failure + (run 'fail1))) + +(def-test does-not-signal-on-success () + (is (= 0 + (handler-case (progn (run 'is1) 0) + (test-spec-failure (condition) + (declare (ignore condition)) + 1)))))