From c3d059c840b2fd413296e49e6e4f69a1e2ab9edf Mon Sep 17 00:00:00 2001 From: Vladimir Sedach Date: Sat, 14 Sep 2019 17:18:20 -0700 Subject: [PATCH 1/3] SIGNAL a condition on test failures, for use with ASDF:TEST-SYSTEM --- src/package.lisp | 3 ++- src/run.lisp | 47 ++++++++++++++++++++++++++++++++++++++++++++++- t/tests.lisp | 37 ++++++++++++++++++++++++++++--------- 3 files changed, 76 insertions(+), 11 deletions(-) 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..30fc261 100644 --- a/src/run.lisp +++ b/src/run.lisp @@ -266,6 +266,37 @@ run.")) (when-let (test (get-test test-name)) (%run test))) +(define-condition test-spec-failure (warning) + ((test-spec :initarg :test-spec + :reader test-spec-failure-spec)) + (:documentation + "Superclass of conditions signalled by RUN to indicate test failures. +Intended for use with ASDF:TEST-SYSTEM")) + +(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. +See also documentation for parent condition TEST-SPEC-FAILURE") + (: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. +See also documentation for parent condition TEST-SPEC-FAILURE") + (: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 +350,21 @@ 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) + (declare (ignore failed)) + (with-simple-restart + (continue "Here so FiveAM can asdf:test-system itself") + (cond + ((= (length result-list) (length skipped)) + (signal 'test-spec-failure-no-tests + :test-spec test-spec)) + ((not all-pass?) + (signal 'test-spec-failure-tests-failed + :test-spec test-spec + :result-list result-list))))) + 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..ab45a03 100644 --- a/t/tests.lisp +++ b/t/tests.lisp @@ -7,8 +7,10 @@ (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 (function continue))) + (let ((,results (with-*test-dribble* nil (run ',test-name)))) + ,@body))) (def-fixture null-fixture () `(progn ,@(&body))) @@ -129,7 +131,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 +189,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 +275,25 @@ (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 (function continue))) + (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))))) From bd414b32397ab8cfafedc3ec0acb551f57d09a61 Mon Sep 17 00:00:00 2001 From: Vladimir Sedach Date: Sun, 15 Sep 2019 20:50:39 -0700 Subject: [PATCH 2/3] Associate a specific restart with test-spec-failure, instead of using continue --- src/run.lisp | 22 ++++++++++++---------- t/tests.lisp | 8 ++++++-- 2 files changed, 18 insertions(+), 12 deletions(-) diff --git a/src/run.lisp b/src/run.lisp index 30fc261..dfa585b 100644 --- a/src/run.lisp +++ b/src/run.lisp @@ -354,16 +354,18 @@ performed by the !, !! and !!! functions." (multiple-value-bind (all-pass? failed skipped) (results-status result-list) (declare (ignore failed)) - (with-simple-restart - (continue "Here so FiveAM can asdf:test-system itself") - (cond - ((= (length result-list) (length skipped)) - (signal 'test-spec-failure-no-tests - :test-spec test-spec)) - ((not all-pass?) - (signal 'test-spec-failure-tests-failed - :test-spec test-spec - :result-list 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) + (ignore-failure ()))))) result-list))) (defun ! () diff --git a/t/tests.lisp b/t/tests.lisp index ab45a03..48650bf 100644 --- a/t/tests.lisp +++ b/t/tests.lisp @@ -8,7 +8,9 @@ (defmacro with-test-results ((results test-name) &body body) `(handler-bind - ((test-spec-failure (function continue))) + ((test-spec-failure (lambda (condition) + (declare (ignore condition)) + (invoke-restart 'ignore-failure)))) (let ((,results (with-*test-dribble* nil (run ',test-name)))) ,@body))) @@ -276,7 +278,9 @@ (def-test return-values () "Return values indicate test failures." (handler-bind - ((test-spec-failure (function continue))) + ((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))) From 582cc3a739a02a3720f8768e977ae1bbe4787585 Mon Sep 17 00:00:00 2001 From: Vladimir Sedach Date: Thu, 26 Sep 2019 23:23:05 -0700 Subject: [PATCH 3/3] Use ASDF:TEST-OP-TEST-FAILURES to signal on failing tests --- src/run.lisp | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/src/run.lisp b/src/run.lisp index dfa585b..f09c192 100644 --- a/src/run.lisp +++ b/src/run.lisp @@ -266,17 +266,16 @@ run.")) (when-let (test (get-test test-name)) (%run test))) -(define-condition test-spec-failure (warning) +(define-condition test-spec-failure (asdf:test-op-test-failures) ((test-spec :initarg :test-spec :reader test-spec-failure-spec)) (:documentation - "Superclass of conditions signalled by RUN to indicate test failures. -Intended for use with ASDF:TEST-SYSTEM")) + "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. -See also documentation for parent condition TEST-SPEC-FAILURE") + "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) @@ -285,8 +284,7 @@ See also documentation for parent condition TEST-SPEC-FAILURE") (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. -See also documentation for parent condition TEST-SPEC-FAILURE") + (: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) @@ -353,7 +351,6 @@ performed by the !, !! and !!! functions." (let ((result-list (funcall *!*))) (multiple-value-bind (all-pass? failed skipped) (results-status result-list) - (declare (ignore failed)) (cond ((= (length result-list) (length skipped)) (restart-case (signal 'test-spec-failure-no-tests @@ -362,9 +359,16 @@ performed by the !, !! and !!! functions." ;; from RUN (ignore-failure ()))) ((not all-pass?) - (restart-case (signal 'test-spec-failure-tests-failed - :test-spec test-spec - :result-list result-list) + (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)))