r5452: *** empty log message ***
[xlunit.git] / result.lisp
index e601ec64ac8a89671f861c5da0cef490579c6539..3ddead3d9fcd39df3a24b2b28db7d517afc6015f 100644 (file)
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:      $Id: result.lisp,v 1.3 2003/08/04 12:28:46 kevin Exp $
+;;;; ID:      $Id: result.lisp,v 1.4 2003/08/04 16:13:58 kevin Exp $
 ;;;; Purpose:  Result functions for XLUnit
 ;;;;
 ;;;; *************************************************************************
 
 (defclass test-result ()
   ((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)"))
 
+(defmethod failure-count ((res test-result))
+  (length (failures res)))
+
+(defmethod error-count ((res test-result))
+  (length (errors res)))
+
 (defun make-test-result ()
   (make-instance 'test-result))
 
+
+(defmethod start-test ((tcase test) (res test-result))
+  (incf (run-tests res))
+  (mapc (lambda (listener) (start-test listener tcase)) (listeners res))
+  res)
+
+(defmethod end-test ((tcase test) (res test-result))
+  (incf (run-tests res))
+  (mapc (lambda (listener) (end-test listener tcase)) (listeners res))
+  res)
+
+(defmethod add-listener ((res test-result) (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
 
 (defmethod was-successful ((result test-result))
   "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-result) (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-result) (tcase test-case) condition)
+  (push (make-test-failure tcase condition) (failures ob))
+  (mapc #'(lambda (single-listener)
+           (add-failure single-listener tcase condition))
+       (listeners ob)))
+