Update domain name to kpe.io

[xlunit.git] / printer.lisp

diff --git a/printer.lisp b/printer.lisp
index 729e0839e129a8814553a37e70872315f33add25..a590a3b79e32825247605d6e52326d6658d8ec7f 100644 (file)
--- a/printer.lisp
+++ b/printer.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:      $Id: printer.lisp,v 1.3 2003/08/04 16:13:58 kevin Exp $
+;;;; ID:      $Id$
 ;;;; Purpose: Printer functions for XLUnit
 ;;;;
 ;;;; *************************************************************************
@@ -13,83 +13,57 @@
 ;----------------------------------------------------------------------
 ; method print-results
 ;----------------------------------------------------------------------
- 
-(defmethod print-results ((ob textui-test-runner) result seconds)
-  (format (ostream ob) "~&Time: ~D~%~%" (coerce seconds 'float))
-  (print-header ob result)
-  (print-errors ob result)
-  (print-failures ob result)
-  t)
- 
-(defmethod print-header ((ob textui-test-runner) result)
-  (let ((failures (failures result))
-        (errors (errors result))
-        (run-tests (run-tests result)))
-    (cond ((and (null failures) (null errors))
-           (format (ostream ob) "~%OK (~a tests)~%" run-tests))
-          (t
-           (format (ostream ob) "~%~%FAILURES!!!~%")
-           (format (ostream ob) "Run: ~a   Failures: ~a   Errors: ~a~%"
-                   run-tests (length failures) (length errors))))))
-                                                                                 
-(defmethod print-errors ((ob textui-test-runner) result)
-  (let ((errors (errors result)))
-    (when errors
-      (if (eql (length errors) 1)
-        (format (ostream ob) "~%There was 1 error:~%")
-        (format (ostream ob) "~%There were ~a errors:~%" (length errors)))
-      (let ((i 1))
-        (mapc #'(lambda (single-error)
-                  (format (ostream ob) "~a) ~a: ~a~%" i
-                          (name (car single-error)) (cdr single-error))
-                  (incf i))
-              errors)))))
 
-(defmethod print-failures ((ob textui-test-runner) result)
-  (let ((failures (failures result)))
-    (when failures
-      (if (eql (length failures) 1)
-        (format (ostream ob) "~%There was 1 failure:~%")
-        (format (ostream ob) "~%There were ~a failures:~%" (length failures)))
-      (let ((i 1))
-        (mapc #'(lambda (single-failure)
-                  (format (ostream ob) "~a) ~a: ~a~%" i (name (car single-failure))
-                          (or (message (cdr single-failure)) ""))
-                  (incf i))
-              failures)))))
+(defmethod print-results ((obj textui-test-runner) result seconds)
+  (print-header obj result seconds)
+  (print-defects obj (errors result) "error")
+  (print-defects obj (failures result) "failure")
+  (print-footer obj result)
+  (values))
 
-#|
-(defun result-printer (result seconds stream)
-  (format stream "~&Time: ~D~%~%" (coerce seconds 'float))
-  (print-defects (errors result) "error" stream)
-  (print-defects (failures result) "failure" stream)
-  (if (was-successful result)
-      (format stream "OK (~D tests)~%" (run-count result))
-    (progn
-      (format stream "~%FAILURES!!!~%")
-      (format stream "Tests run: ~D, Failures: ~D, Errors: ~D~%"
-             (run-count result) (failure-count result)
-             (error-count result)))))
+(defmethod print-header ((obj textui-test-runner) result seconds)
+  (declare (ignore result))
+  (format (ostream obj) "~&Time: ~D~%~%" (coerce seconds 'float)))
 
-(defun print-defects (defects type stream)
+(defmethod print-defects ((obj textui-test-runner) defects title)
   (when defects
     (let ((count (length defects)))
-      (if (= count 1)
-         (format stream "~&There was ~D ~A:~%" count type)
-       (format stream "~&There were ~D ~As:~%" count type))
+      (if (= 1 count)
+          (format (ostream obj) "~%There was 1 ~A:~%" title)
+        (format (ostream obj) "~%There were ~D ~A:~%"
+                count title))
       (dotimes (i count)
-       (let ((defect (nth i defects)))
-         (format stream "~&~D) ~A " i (class-name
-                                       (class-of (failed-test defect))))
-         (apply #'format stream (simple-condition-format-control 
-                                 (thrown-condition defect))
-                (simple-condition-format-arguments 
-                 (thrown-condition defect)))
-         (fresh-line stream))))))
+        (let* ((defect (nth i defects))
+               (condition (thrown-condition defect)))
+          (format (ostream obj) "~A) ~A: "
+                  (1+ i) (name (failed-test defect)))
+          (typecase condition
+            (assertion-failed
+             (apply #'format (ostream obj)
+                    (simple-condition-format-control condition)
+                    (simple-condition-format-arguments condition))
+             (format (ostream obj) "~%")
+             (when (message condition)
+               (let ((spaces (+ 2 (length (format nil "~D" count)))))
+                 (dotimes (i spaces)
+                   (write-char #\space (ostream obj))))
+               (format (ostream obj) "~A~%" (message condition))))
+            (t
+             (format (ostream obj) "~A~%" condition))))))))
+
 
-|#
+(defmethod print-footer ((obj textui-test-runner) result)
+  (let ((failures (failures result))
+        (errors (errors result))
+        (run-tests (run-tests result)))
+    (cond ((and (null failures) (null errors))
+           (format (ostream obj) "~%OK (~a tests)~%" run-tests))
+          (t
+           (format (ostream obj) "~%~%FAILURES!!!~%")
+           (format (ostream obj) "Run: ~a   Failures: ~a   Errors: ~a~%"
+                   run-tests (length failures) (length errors))))))
 
 (defgeneric summary (result))
-(defmethod summary ((result test-result))
+(defmethod summary ((result test-results))
   (format nil "~D run, ~D erred, ~D failed"
-         (run-count result) (error-count result) (failure-count result)))
+          (run-tests result) (error-count result) (failure-count result)))