;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; ID: $Id: tcase.lisp,v 1.5 2003/08/06 14:51:01 kevin Exp $
+;;;; ID: $Id: tcase.lisp,v 1.6 2003/08/08 00:57:20 kevin Exp $
;;;; Purpose: Test fixtures for XLUnit
;;;;
;;;; *************************************************************************
(set-up test)
(unwind-protect
(run-test test)
- (tear-down test))
- (values))
+ (tear-down test)))
(defmethod run-test ((test test-case))
(funcall (method-body test)))
-(defmethod run-protected ((test test-case) res
- &key (handle-errors t) test-condition)
+(defmethod run-protected ((test test-case) res &key (handle-errors t))
(if handle-errors
(handler-case
(run-base test)
(assertion-failed (condition)
(add-failure res test condition))
- (t (condition)
- (when (and test-condition
- (not (typep condition test-condition)))
- (add-failure res test
- (make-instance 'assertion-failed
- :format-control
- "Assert condition ~A, but condition ~A signaled"
- :format-arguments
- (list test-condition condition)))))
(serious-condition (condition)
- (add-error res test condition))
- (:no-error ()
- (when test-condition
- (add-failure res test
- (make-instance 'assertion-failed
- :format-control "Assert condition ~A, but no condition signaled"
- :format-arguments (list test-condition))))))
- (run-base test))
+ (add-error res test condition)))
+ (run-base test))
res)