`(if ,test
(handler-case
,form
- ,@cases)
+ ,@cases)
,form))
(defmacro unwind-protect-if (test protected cleanup)
`(if ,test
(unwind-protect
- ,protected
- ,cleanup)
+ ,protected
+ ,cleanup)
(progn ,protected ,cleanup)))
(defmethod run-test ((test test-fixture)
- &key (result (make-instance 'test-result))
- (handle-errors t))
+ &key (result (make-instance 'test-result))
+ (handle-errors t))
"Perform the test represented by the given test-case or test-suite.
Returns a test-result object."
(incf (test-count result))
(with-slots (failures errors) result
(unwind-protect-if handle-errors
- (handler-case-if handle-errors
- (let ((res (progn (setup test)
- (funcall (test-fn test) test))))
- (when (typep res 'test-failure-condition)
- (push (make-test-failure test res) failures)))
- (test-failure-condition (failure)
- (push (make-test-failure test failure) failures))
- (error (err)
- (push (make-test-failure test err) errors)))
-
- (if handle-errors
- (handler-case
- (teardown test)
- (error (err)
- (push (make-test-failure test err) errors)))
- (teardown test))))
+ (handler-case-if handle-errors
+ (let ((res (progn (setup test)
+ (funcall (test-fn test) test))))
+ (when (typep res 'test-failure-condition)
+ (push (make-test-failure test res) failures)))
+ (test-failure-condition (failure)
+ (push (make-test-failure test failure) failures))
+ (error (err)
+ (push (make-test-failure test err) errors)))
+
+ (if handle-errors
+ (handler-case
+ (teardown test)
+ (error (err)
+ (push (make-test-failure test err) errors)))
+ (teardown test))))
result)
symbol or a lambda taking a single argument, the test-fixture
instance. DESCRIPTION is obviously what it says it is."
(let ((newtest (make-instance fixture
- :test-name (etypecase name
- (symbol
- (string-downcase (symbol-name name)))
- (string
- name))
- :test-fn
- (if(and (symbolp name) (null test-fn))
- name
- test-fn)
- :description description)))
+ :test-name (etypecase name
+ (symbol
+ (string-downcase (symbol-name name)))
+ (string
+ name))
+ :test-fn
+ (if(and (symbolp name) (null test-fn))
+ name
+ test-fn)
+ :description description)))
(when test-suite (add-test newtest test-suite))
newtest))