printer.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; ID:      $Id$
   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 ((obj textui-test-runner) result seconds)
  18   (print-header obj result seconds)
  19   (print-defects obj (errors result) "error")
  20   (print-defects obj (failures result) "failure")
  21   (print-footer obj result)
  22   (values))
  23
  24 (defmethod print-header ((obj textui-test-runner) result seconds)
  25   (declare (ignore result))
  26   (format (ostream obj) "~&Time: ~D~%~%" (coerce seconds 'float)))
  27
  28 (defmethod print-defects ((obj textui-test-runner) defects title)
  29   (when defects
  30     (let ((count (length defects)))
  31       (if (= 1 count)
  32           (format (ostream obj) "~%There was 1 ~A:~%" title)
  33         (format (ostream obj) "~%There were ~D ~A:~%"
  34                 count title))
  35       (dotimes (i count)
  36         (let* ((defect (nth i defects))
  37                (condition (thrown-condition defect)))
  38           (format (ostream obj) "~A) ~A: "
  39                   (1+ i) (name (failed-test defect)))
  40           (typecase condition
  41             (assertion-failed
  42              (apply #'format (ostream obj)
  43                     (simple-condition-format-control condition)
  44                     (simple-condition-format-arguments condition))
  45              (format (ostream obj) "~%")
  46              (when (message condition)
  47                (let ((spaces (+ 2 (length (format nil "~D" count)))))
  48                  (dotimes (i spaces)
  49                    (write-char #\space (ostream obj))))
  50                (format (ostream obj) "~A~%" (message condition))))
  51             (t
  52              (format (ostream obj) "~A~%" condition))))))))
  53
  54
  55 (defmethod print-footer ((obj textui-test-runner) result)
  56   (let ((failures (failures result))
  57         (errors (errors result))
  58         (run-tests (run-tests result)))
  59     (cond ((and (null failures) (null errors))
  60            (format (ostream obj) "~%OK (~a tests)~%" run-tests))
  61           (t
  62            (format (ostream obj) "~%~%FAILURES!!!~%")
  63            (format (ostream obj) "Run: ~a   Failures: ~a   Errors: ~a~%"
  64                    run-tests (length failures) (length errors))))))
  65
  66 (defgeneric summary (result))
  67 (defmethod summary ((result test-results))
  68   (format nil "~D run, ~D erred, ~D failed"
  69           (run-tests result) (error-count result) (failure-count result)))