;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; ID: $Id: result.lisp,v 1.5 2003/08/04 16:42:27 kevin Exp $
+;;;; ID: $Id$
;;;; Purpose: Result functions for XLUnit
;;;;
;;;; *************************************************************************
(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-results))
- (incf (run-tests res))
(mapc (lambda (listener) (end-test listener tcase)) (listeners res))
res)
(defclass test-failure ()
((failed-test :initarg :failed-test :reader failed-test)
(thrown-condition :initarg :thrown-condition
- :reader 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))
+ :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-results))
"Returns T if a result has no failures or errors"
(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-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)))