;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; ID: $Id: result.lisp,v 1.3 2003/08/04 12:28:46 kevin Exp $
+;;;; ID: $Id: result.lisp,v 1.6 2003/08/04 19:31:34 kevin Exp $
;;;; Purpose: Result functions for XLUnit
;;;;
;;;; *************************************************************************
(in-package #:xlunit)
-(defclass test-result ()
+(defclass test-results ()
((test :initarg :test :reader result-test)
- (count :initform 0 :accessor test-count)
- (failures :initarg :failures :reader test-failures :initform nil)
- (errors :initarg :errors :reader test-errors :initform nil))
+ (count :initform 0 :accessor run-tests)
+ (failures :initarg :failures :accessor failures :initform nil)
+ (errors :initarg :errors :accessor errors :initform nil)
+ (listeners :initform nil :accessor listeners)
+ (stop :initform nil :accessor stop))
(:documentation "Results of running test(s)"))
-(defun make-test-result ()
- (make-instance 'test-result))
+(defmethod failure-count ((res test-results))
+ (length (failures res)))
+
+(defmethod error-count ((res test-results))
+ (length (errors res)))
+
+(defun make-test-results ()
+ (make-instance 'test-results))
+
+
+(defmethod start-test ((tcase test) (res test-results))
+ (incf (run-tests res))
+ (mapc (lambda (listener) (start-test listener tcase)) (listeners res))
+ res)
+
+(defmethod end-test ((tcase test) (res test-results))
+ (mapc (lambda (listener) (end-test listener tcase)) (listeners res))
+ res)
+
+(defmethod add-listener ((res test-results) (listener test-listener))
+ (push listener (listeners res)))
+
+
+;; Test Failures
(defclass test-failure ()
((failed-test :initarg :failed-test :reader failed-test)
(thrown-condition :initarg :thrown-condition
:reader thrown-condition))
- (:documentation "Stored failures/errors in test-result slots"))
+ (:documentation "Stored failures/errors in test-results slots"))
(defun make-test-failure (test condition)
(make-instance 'test-failure :failed-test test
(simple-condition-format-control (thrown-condition obj))
(simple-condition-format-arguments (thrown-condition obj)))))
-(defmethod was-successful ((result test-result))
+(defmethod was-successful ((result test-results))
"Returns T if a result has no failures or errors"
- (and (null (test-failures result)) (null (test-errors result))))
+ (and (null (failures result)) (null (errors result))))
+
+
+;----------------------------------------------------------------------
+; methods add-error, add-failure
+;----------------------------------------------------------------------
+
+(defmethod add-error ((ob test-results) (tcase test-case) condition)
+ (push (make-test-failure tcase condition) (errors ob))
+ (mapc #'(lambda (single-listener)
+ (add-error single-listener tcase condition))
+ (listeners ob)))
+
+
+(defmethod add-failure ((ob test-results) (tcase test-case) condition)
+ (push (make-test-failure tcase condition) (failures ob))
+ (mapc #'(lambda (single-listener)
+ (add-failure single-listener tcase condition))
+ (listeners ob)))
+