;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; ID: $Id: printer.lisp,v 1.4 2003/08/04 17:04:49 kevin Exp $
+;;;; ID: $Id: printer.lisp,v 1.7 2003/08/10 07:39:33 kevin Exp $
;;;; Purpose: Printer functions for XLUnit
;;;;
;;;; *************************************************************************
; 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-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))
-(defmethod print-header ((ob textui-test-runner) result)
+(defmethod print-header ((obj textui-test-runner) result seconds)
+ (declare (ignore result))
+ (format (ostream obj) "~&Time: ~D~%~%" (coerce seconds 'float)))
+
+(defmethod print-defects ((obj textui-test-runner) defects title)
+ (when defects
+ (let ((count (length defects)))
+ (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))
+ (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 ob) "~%OK (~a tests)~%" run-tests))
+ (format (ostream obj) "~%OK (~a tests)~%" run-tests))
(t
- (format (ostream ob) "~%~%FAILURES!!!~%")
- (format (ostream ob) "Run: ~a Failures: ~a Errors: ~a~%"
+ (format (ostream obj) "~%~%FAILURES!!!~%")
+ (format (ostream obj) "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)))))
(defgeneric summary (result))
(defmethod summary ((result test-results))