X-Git-Url: http://git.kpe.io/?p=xlunit.git;a=blobdiff_plain;f=result.lisp;h=80f411a7aab49ca343251cc9f144af6215cb2bb4;hp=ba95e4a00eb7658075ed9a9bc51fd6704781c1f9;hb=HEAD;hpb=318cda1a328e9d99af2270c73cb13262e485a1ff

diff --git a/result.lisp b/result.lisp
index ba95e4a..80f411a 100644
--- a/result.lisp
+++ b/result.lisp
@@ -2,41 +2,90 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; Name:        result.lisp
-;;;; Purpose:     Result functions for XLUnit
-;;;; Authors:     Kevin Rosenberg
+;;;; ID:      $Id$
+;;;; Purpose:  Result functions for XLUnit
 ;;;;
-;;;; $Id: result.lisp,v 1.1 2003/08/04 12:01:54 kevin Exp $
 ;;;; *************************************************************************
 
 (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))
-  (:documentation "The result of applying a test"))
+   (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-results))
+  (length (failures res)))
 
-(defun make-test-result ()
-  (make-instance 'test-result))
+(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)))
+   (thrown-condition :initarg :thrown-condition
+                     :reader thrown-condition))
+  (:documentation "Stored failures/errors in test-results slots"))
+
+(defun make-test-failure (test condition)
+  (make-instance 'test-failure :failed-test test
+                 :thrown-condition condition))
 
 (defmethod is-failure ((failure test-failure))
-  (typep (thrown-condition failure) 'test-failure-condition))
+  "Returns T if a failure was a test-failure condition"
+  (typep (thrown-condition failure) 'assertion-failed))
 
 (defmethod print-object ((obj test-failure) stream)
   (print-unreadable-object (obj stream :type t :identity nil)
     (format stream "~A: " (failed-test obj))
-    (apply #'format stream 
-	   (simple-condition-format-control (thrown-condition obj))
-	   (simple-condition-format-arguments (thrown-condition obj)))))
+    (apply #'format stream
+           (simple-condition-format-control (thrown-condition obj))
+           (simple-condition-format-arguments (thrown-condition obj)))))
+
+(defmethod was-successful ((result test-results))
+  "Returns T if a result has no failures or errors"
+  (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)))
 
-(defmethod was-successful ((result test-result))
-  (and (null (test-failures result))
-       (null (test-errors result))))