X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;ds=sidebyside;f=result.lisp;h=80f411a7aab49ca343251cc9f144af6215cb2bb4;hb=HEAD;hp=3ddead3d9fcd39df3a24b2b28db7d517afc6015f;hpb=53e193feda5d4cb757ef13d622fac03cf99178a2;p=xlunit.git diff --git a/result.lisp b/result.lisp index 3ddead3..80f411a 100644 --- a/result.lisp +++ b/result.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; ID: $Id: result.lisp,v 1.4 2003/08/04 16:13:58 kevin Exp $ +;;;; ID: $Id$ ;;;; Purpose: Result functions for XLUnit ;;;; ;;;; ************************************************************************* @@ -10,7 +10,7 @@ (in-package #:xlunit) -(defclass test-result () +(defclass test-results () ((test :initarg :test :reader result-test) (count :initform 0 :accessor run-tests) (failures :initarg :failures :accessor failures :initform nil) @@ -19,27 +19,28 @@ (stop :initform nil :accessor stop)) (:documentation "Results of running test(s)")) -(defmethod failure-count ((res test-result)) +(defmethod failure-count ((res test-results)) (length (failures res))) -(defmethod error-count ((res test-result)) +(defmethod error-count ((res test-results)) (length (errors res))) -(defun make-test-result () - (make-instance 'test-result)) +(defun make-test-results () + (make-instance 'test-results)) -(defmethod start-test ((tcase test) (res test-result)) +(defmethod start-test ((tcase test) (res test-results)) (incf (run-tests res)) - (mapc (lambda (listener) (start-test listener tcase)) (listeners res)) + (mapc (lambda (listener) + (start-test listener tcase)) + (listeners res)) res) -(defmethod end-test ((tcase test) (res test-result)) - (incf (run-tests res)) +(defmethod end-test ((tcase test) (res test-results)) (mapc (lambda (listener) (end-test listener tcase)) (listeners res)) res) -(defmethod add-listener ((res test-result) (listener test-listener)) +(defmethod add-listener ((res test-results) (listener test-listener)) (push listener (listeners res))) @@ -48,25 +49,25 @@ (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")) + :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)) + :thrown-condition condition)) (defmethod is-failure ((failure test-failure)) "Returns T if a failure was a test-failure condition" - (typep (thrown-condition failure) '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-result)) +(defmethod was-successful ((result test-results)) "Returns T if a result has no failures or errors" (and (null (failures result)) (null (errors result)))) @@ -75,16 +76,16 @@ ; methods add-error, add-failure ;---------------------------------------------------------------------- -(defmethod add-error ((ob test-result) (tcase test-case) condition) +(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))) + (add-error single-listener tcase condition)) + (listeners ob))) -(defmethod add-failure ((ob test-result) (tcase test-case) condition) +(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))) + (add-failure single-listener tcase condition)) + (listeners ob)))