;;;; Purpose: Result functions for XLUnit
;;;;
;;;; *************************************************************************
;;;; Purpose: Result functions for XLUnit
;;;;
;;;; *************************************************************************
((test :initarg :test :reader result-test)
(count :initform 0 :accessor run-tests)
(failures :initarg :failures :accessor failures :initform nil)
((test :initarg :test :reader result-test)
(count :initform 0 :accessor run-tests)
(failures :initarg :failures :accessor failures :initform nil)
((failed-test :initarg :failed-test :reader failed-test)
(thrown-condition :initarg :thrown-condition
:reader thrown-condition))
((failed-test :initarg :failed-test :reader failed-test)
(thrown-condition :initarg :thrown-condition
:reader thrown-condition))
(defmethod print-object ((obj test-failure) stream)
(print-unreadable-object (obj stream :type t :identity nil)
(defmethod print-object ((obj test-failure) stream)
(print-unreadable-object (obj stream :type t :identity nil)
(simple-condition-format-control (thrown-condition obj))
(simple-condition-format-arguments (thrown-condition obj)))))
(simple-condition-format-control (thrown-condition obj))
(simple-condition-format-arguments (thrown-condition obj)))))
"Returns T if a result has no failures or errors"
(and (null (failures result)) (null (errors result))))
"Returns T if a result has no failures or errors"
(and (null (failures result)) (null (errors result))))
; methods add-error, add-failure
;----------------------------------------------------------------------
; methods add-error, add-failure
;----------------------------------------------------------------------
(push (make-test-failure tcase condition) (errors ob))
(mapc #'(lambda (single-listener)
(add-error single-listener tcase condition))
(listeners ob)))
(push (make-test-failure tcase condition) (errors ob))
(mapc #'(lambda (single-listener)
(add-error single-listener tcase condition))
(listeners ob)))
(push (make-test-failure tcase condition) (failures ob))
(mapc #'(lambda (single-listener)
(add-failure single-listener tcase condition))
(push (make-test-failure tcase condition) (failures ob))
(mapc #'(lambda (single-listener)
(add-failure single-listener tcase condition))