printer.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Name:        printer.lisp
   6 ;;;; Purpose:     Printer functions for XLUnit
   7 ;;;; Authors:     Kevin Rosenberg
   8 ;;;;
   9 ;;;; $Id: printer.lisp,v 1.1 2003/08/04 12:01:54 kevin Exp $
  10 ;;;; *************************************************************************
  11
  12 (in-package #:xlunit)
  13
  14
  15 (defun result-printer (result seconds stream)
  16   (format stream "~&Time: ~D~%~%" (coerce seconds 'float))
  17   (print-defects (test-errors result) "error" stream)
  18   (print-defects (test-failures result) "failure" stream)
  19   (if (was-successful result)
  20       (format stream "OK (~D tests)~%" (test-count result))
  21     (progn
  22       (format stream "~%FAILURES!!!~%")
  23       (format stream "Tests run: ~D, Failures: ~D, Errors: ~D~%"
  24               (test-count result) (length (test-failures result))
  25               (length (test-errors result))))))
  26
  27 (defun print-defects (defects type stream)
  28   (when defects
  29     (let ((count (length defects)))
  30       (if (= count 1)
  31           (format stream "~&There was ~D ~A:~%" count type)
  32         (format stream "~&There were ~D ~As:~%" count type))
  33       (dotimes (i count)
  34         (let ((defect (nth i defects)))
  35           (format stream "~&~D) ~A " i (class-name
  36                                         (class-of (failed-test defect))))
  37           (apply #'format stream (simple-condition-format-control
  38                                   (thrown-condition defect))
  39                  (simple-condition-format-arguments
  40                   (thrown-condition defect)))
  41           (fresh-line stream))))))
  42
  43 (defmethod summary ((result test-result))
  44   (format nil "~D run, ~D erred, ~D failed"
  45           (test-count result) (length (test-errors result))
  46           (length (test-failures result))))