X-Git-Url: http://git.kpe.io/?p=xlunit.git;a=blobdiff_plain;f=tcase.lisp;h=7aefbddd639047b90c1c63b3efac3196bc59777e;hp=4c13e1eefc05871c2516ffb87701b39094ec9780;hb=HEAD;hpb=77e80d4f7d2d8a1aea36f9239abc7e1b25500ecc diff --git a/tcase.lisp b/tcase.lisp index 4c13e1e..7aefbdd 100644 --- a/tcase.lisp +++ b/tcase.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; ID: $Id: tcase.lisp,v 1.5 2003/08/06 14:51:01 kevin Exp $ +;;;; ID: $Id$ ;;;; Purpose: Test fixtures for XLUnit ;;;; ;;;; ************************************************************************* @@ -15,17 +15,17 @@ (defclass test-case (test) ((existing-suites :initform nil :accessor existing-suites - :allocation :class) + :allocation :class) (method-body :initarg :method-body :accessor method-body :initform nil :documentation "A function designator which will be applied to this instance to perform that test-case.") (name :initarg :name :reader name :initform "" - :documentation "The name of this test-case, used in reports.") + :documentation "The name of this test-case, used in reports.") (description :initarg :description :reader description - :documentation - "Short description of this test-case, uses in reports") + :documentation + "Short description of this test-case, uses in reports") (suite :initform nil :accessor suite :initarg :suite)) (:documentation "Base class for test-cases.")) @@ -38,7 +38,7 @@ to perform that test-case.") (setf (gethash (type-of ob) (existing-suites ob)) (make-instance 'test-suite))) ;;specifi suite singleton (setf (suite ob) (gethash (type-of ob) (existing-suites ob)))) - + (defgeneric set-up (test) (:documentation @@ -63,7 +63,7 @@ that the setup method did for this instance.")) res)) (defmethod run-on-test-results ((test test-case) result - &key (handle-errors t)) + &key (handle-errors t)) (start-test test result) (run-protected test result :handle-errors handle-errors) (end-test test result)) @@ -72,35 +72,18 @@ that the setup method did for this instance.")) (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)) + (run-base test) + (assertion-failed (condition) + (add-failure res test condition)) + (serious-condition (condition) + (add-error res test condition))) + (run-base test)) res)