printer.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; ID:      $Id: printer.lisp,v 1.3 2003/08/04 16:13:58 kevin Exp $
   6 ;;;; Purpose: Printer functions for XLUnit
   7 ;;;;
   8 ;;;; *************************************************************************
   9
  10 (in-package #:xlunit)
  11
  12
  13 ;----------------------------------------------------------------------
  14 ; method print-results
  15 ;----------------------------------------------------------------------
  16
  17 (defmethod print-results ((ob textui-test-runner) result seconds)
  18   (format (ostream ob) "~&Time: ~D~%~%" (coerce seconds 'float))
  19   (print-header ob result)
  20   (print-errors ob result)
  21   (print-failures ob result)
  22   t)
  23
  24 (defmethod print-header ((ob textui-test-runner) result)
  25   (let ((failures (failures result))
  26         (errors (errors result))
  27         (run-tests (run-tests result)))
  28     (cond ((and (null failures) (null errors))
  29            (format (ostream ob) "~%OK (~a tests)~%" run-tests))
  30           (t
  31            (format (ostream ob) "~%~%FAILURES!!!~%")
  32            (format (ostream ob) "Run: ~a   Failures: ~a   Errors: ~a~%"
  33                    run-tests (length failures) (length errors))))))
  34
  35 (defmethod print-errors ((ob textui-test-runner) result)
  36   (let ((errors (errors result)))
  37     (when errors
  38       (if (eql (length errors) 1)
  39         (format (ostream ob) "~%There was 1 error:~%")
  40         (format (ostream ob) "~%There were ~a errors:~%" (length errors)))
  41       (let ((i 1))
  42         (mapc #'(lambda (single-error)
  43                   (format (ostream ob) "~a) ~a: ~a~%" i
  44                           (name (car single-error)) (cdr single-error))
  45                   (incf i))
  46               errors)))))
  47
  48 (defmethod print-failures ((ob textui-test-runner) result)
  49   (let ((failures (failures result)))
  50     (when failures
  51       (if (eql (length failures) 1)
  52         (format (ostream ob) "~%There was 1 failure:~%")
  53         (format (ostream ob) "~%There were ~a failures:~%" (length failures)))
  54       (let ((i 1))
  55         (mapc #'(lambda (single-failure)
  56                   (format (ostream ob) "~a) ~a: ~a~%" i (name (car single-failure))
  57                           (or (message (cdr single-failure)) ""))
  58                   (incf i))
  59               failures)))))
  60
  61 #|
  62 (defun result-printer (result seconds stream)
  63   (format stream "~&Time: ~D~%~%" (coerce seconds 'float))
  64   (print-defects (errors result) "error" stream)
  65   (print-defects (failures result) "failure" stream)
  66   (if (was-successful result)
  67       (format stream "OK (~D tests)~%" (run-count result))
  68     (progn
  69       (format stream "~%FAILURES!!!~%")
  70       (format stream "Tests run: ~D, Failures: ~D, Errors: ~D~%"
  71               (run-count result) (failure-count result)
  72               (error-count result)))))
  73
  74 (defun print-defects (defects type stream)
  75   (when defects
  76     (let ((count (length defects)))
  77       (if (= count 1)
  78           (format stream "~&There was ~D ~A:~%" count type)
  79         (format stream "~&There were ~D ~As:~%" count type))
  80       (dotimes (i count)
  81         (let ((defect (nth i defects)))
  82           (format stream "~&~D) ~A " i (class-name
  83                                         (class-of (failed-test defect))))
  84           (apply #'format stream (simple-condition-format-control
  85                                   (thrown-condition defect))
  86                  (simple-condition-format-arguments
  87                   (thrown-condition defect)))
  88           (fresh-line stream))))))
  89
  90 |#
  91
  92 (defgeneric summary (result))
  93 (defmethod summary ((result test-result))
  94   (format nil "~D run, ~D erred, ~D failed"
  95           (run-count result) (error-count result) (failure-count result)))