;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; ID: $Id: tcase.lisp,v 1.6 2003/08/08 00:57:20 kevin Exp $
+;;;; ID: $Id$
;;;; Purpose: Test fixtures for XLUnit
;;;;
;;;; *************************************************************************
(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."))
(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
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))
(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))
- (serious-condition (condition)
- (add-error res test condition)))
+ (run-base test)
+ (assertion-failed (condition)
+ (add-failure res test condition))
+ (serious-condition (condition)
+ (add-error res test condition)))
(run-base test))
res)