result.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; ID:      $Id: result.lisp,v 1.2 2003/08/04 12:16:13 kevin Exp $
   6 ;;;; Purpose:  Result functions for XLUnit
   7 ;;;;
   8 ;;;; *************************************************************************
   9
  10 (in-package #:xlunit)
  11
  12
  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)"))
  19
  20 (defun make-test-result ()
  21   (make-instance 'test-result))
  22
  23 (defclass test-failure ()
  24   ((failed-test :initarg :failed-test :reader failed-test)
  25    (thrown-condition :initarg :thrown-condition
  26                      :reader thrown-condition))
  27   (:documention "Stored failures/errors in test-result slots"))
  28
  29 (defun make-test-failure (test condition)
  30   (make-instance 'test-failure :failed-test test
  31                  :thrown-condition condition))
  32
  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))
  36
  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)))))
  43
  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))))