Source
(defmethod run-test-lambda ((test test-case))
(with-run-state (result-list)
(bind-run-state ((current-test test))
(labels ((abort-test (e)
(add-result 'unexpected-test-failure
:test-expr nil
:test-case test
:reason (format nil "Unexpected Error: ~S." e)
:condition e))
(run-it ()
(let ((result-list '()))
(declare (special result-list))
(handler-bind ((check-failure (lambda (e)
(declare (ignore e))
(unless *debug-on-failure*
(invoke-restart
(find-restart 'ignore-failure)))))
(error (lambda (e)
(unless (or *debug-on-error*
(typep e 'check-failure))
(abort-test e)
(return-from run-it result-list)))))
(restart-case
(funcall (test-lambda test))
(retest ()
:report (lambda (stream)
(format stream "~@<Rerun the test ~S~@:>" test))
(return-from run-it (run-it)))
(ignore ()
:report (lambda (stream)
(format stream "~@<Signal an exceptional test failure and abort the test ~S.~@:>" test))
(abort-test (make-instance 'test-failure :test-case test
:reason "Failure restart."))))
result-list))))
(let ((results (run-it)))
(setf (status test) (results-status results)
result-list (nconc result-list results)))))))Source Context