1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
5 ;;;; ID: $Id: result.lisp,v 1.3 2003/08/04 12:28:46 kevin Exp $
6 ;;;; Purpose: Result functions for XLUnit
8 ;;;; *************************************************************************
13 (defclass test-result ()
14 ((test :initarg :test :reader result-test)
15 (count :initform 0 :accessor test-count)
16 (failures :initarg :failures :reader test-failures :initform nil)
17 (errors :initarg :errors :reader test-errors :initform nil))
18 (:documentation "Results of running test(s)"))
20 (defun make-test-result ()
21 (make-instance 'test-result))
23 (defclass test-failure ()
24 ((failed-test :initarg :failed-test :reader failed-test)
25 (thrown-condition :initarg :thrown-condition
26 :reader thrown-condition))
27 (:documentation "Stored failures/errors in test-result slots"))
29 (defun make-test-failure (test condition)
30 (make-instance 'test-failure :failed-test test
31 :thrown-condition condition))
33 (defmethod is-failure ((failure test-failure))
34 "Returns T if a failure was a test-failure condition"
35 (typep (thrown-condition failure) 'test-failure-condition))
37 (defmethod print-object ((obj test-failure) stream)
38 (print-unreadable-object (obj stream :type t :identity nil)
39 (format stream "~A: " (failed-test obj))
40 (apply #'format stream
41 (simple-condition-format-control (thrown-condition obj))
42 (simple-condition-format-arguments (thrown-condition obj)))))
44 (defmethod was-successful ((result test-result))
45 "Returns T if a result has no failures or errors"
46 (and (null (test-failures result)) (null (test-errors result))))