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