;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; ID: $Id: assert.lisp,v 1.7 2003/08/06 14:15:32 kevin Exp $
+;;;; ID: $Id: assert.lisp,v 1.8 2003/08/06 14:51:01 kevin Exp $
;;;; Purpose: Assert functions for XLUnit
;;;;
;;;; *************************************************************************
(failure-message ,message "Assert false: ~S" ',v)))
(defmacro assert-condition (condition v &optional message)
+
)
(defmacro assert-not-condition (condition v &optional message)
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; ID: $Id: tcase.lisp,v 1.4 2003/08/05 22:56:25 kevin Exp $
+;;;; ID: $Id: tcase.lisp,v 1.5 2003/08/06 14:51:01 kevin Exp $
;;;; Purpose: Test fixtures for XLUnit
;;;;
;;;; *************************************************************************
(set-up test)
(unwind-protect
(run-test test)
- (tear-down test)))
+ (tear-down test))
+ (values))
(defmethod run-test ((test test-case))
(funcall (method-body test)))
-(defmethod run-protected ((test test-case) res &key (handle-errors t))
+(defmethod run-protected ((test test-case) res
+ &key (handle-errors t) test-condition)
(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)))
- (run-base test))
+ (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))
res)
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Id: $Id: tests.lisp,v 1.12 2003/08/06 11:37:23 kevin Exp $
+;;;; Id: $Id: tests.lisp,v 1.13 2003/08/06 14:51:01 kevin Exp $
;;;; Purpose: Self Test suite for XLUnit
;;;;
;;;; *************************************************************************
(assert-equal "2 run, 0 erred, 0 failed"
(summary (run (get-suite test-two-cases)))))
+(define-condition test-condition (error)
+ ())
+(def-test-method test-condition ((self test-case-test) :run nil)
+ (assert-condition
+ test-condition
+ (error (make-instance 'test-condition))))
+
(textui-test-run (get-suite test-case-test))