projects
/
fiveam.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
FIX: Store *package* at definition time for tests and rebind it at runtime
[fiveam.git]
/
src
/
run.lisp
diff --git
a/src/run.lisp
b/src/run.lisp
index
274521e
..
dbdd4ed
100644
(file)
--- a/
src/run.lisp
+++ b/
src/run.lisp
@@
-36,6
+36,9
@@
(defparameter *debug-on-error* nil
"T if we should drop into a debugger on error, NIL otherwise.")
(defparameter *debug-on-error* nil
"T if we should drop into a debugger on error, NIL otherwise.")
+(defparameter *debug-on-failure* nil
+ "T if we should drop into a debugger on a failing check, NIL otherwise.")
+
(defun import-testing-symbols (package-designator)
(import '(5am::is 5am::is-true 5am::is-false 5am::signals 5am::finishes)
package-designator))
(defun import-testing-symbols (package-designator)
(import '(5am::is 5am::is-true 5am::is-false 5am::signals 5am::finishes)
package-designator))
@@
-128,24
+131,32
@@
run."))
(add-result 'unexpected-test-failure
:test-expr nil
:test-case test
(add-result 'unexpected-test-failure
:test-expr nil
:test-case test
- :reason (format nil "Unexpected Error: ~S." e)
+ :reason (format nil "Unexpected Error: ~S~%~A." e e)
:condition e))
(run-it ()
(let ((result-list '()))
(declare (special result-list))
:condition e))
(run-it ()
(let ((result-list '()))
(declare (special result-list))
- (handler-bind ((error (lambda (e)
- (unless *debug-on-error*
+ (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
(abort-test e)
(return-from run-it result-list)))))
(restart-case
- (funcall (test-lambda test))
+ (let ((*readtable* (copy-readtable))
+ (*package* (runtime-package test)))
+ (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)
(retest ()
:report (lambda (stream)
(format stream "~@<Rerun the test ~S~@:>" test))
(return-from run-it (run-it)))
(ignore ()
:report (lambda (stream)
- (format stream "~@<Signal a test failure and abort the test ~S.~@:>" test))
+ (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))))
(abort-test (make-instance 'test-failure :test-case test
:reason "Failure restart."))))
result-list))))
@@
-161,6
+172,9
@@
run."))
(defmethod %run ((test test-case))
(run-resolving-dependencies test))
(defmethod %run ((test test-case))
(run-resolving-dependencies test))
+(defmethod %run ((tests list))
+ (mapc #'%run tests))
+
(defmethod %run ((suite test-suite))
(let ((suite-results '()))
(bind-run-state ((result-list '()))
(defmethod %run ((suite test-suite))
(let ((suite-results '()))
(bind-run-state ((result-list '()))
@@
-185,7
+199,7
@@
run."))
;;;; ** Public entry points
;;;; ** Public entry points
-(defun run! (test-spec)
+(defun run! (&optional (test-spec *suite*))
"Equivalent to (explain (run TEST-SPEC))."
(explain! (run test-spec)))
"Equivalent to (explain (run TEST-SPEC))."
(explain! (run test-spec)))