-(defmethod setup-testsuite-named (name)
- (declare (ignore name))
- t)
-
-(defmethod teardown-testsuite-named (name)
- (declare (ignore name))
- t)
-
-(defmethod run-test ((suite test-suite) &key (handle-errors t))
- (let ((start-time (get-internal-real-time)))
- (setup-testsuite-named (slot-value suite 'name))
- (let ((res (mapcar (lambda (test) (run-test test
- :handle-errors handle-errors))
- (tests suite))))
- (teardown-testsuite-named (slot-value suite 'name))
- (make-instance 'suite-results
- :suite suite
- :test-results res
- :start-time start-time
- :stop-time (get-internal-real-time)))))
-
-
-(defclass test-result ()
- ((test :initarg :test :reader result-test)
- (failures :initarg :failures :reader test-failures :initform nil)
- (errors :initarg :errors :reader test-errors :initform nil))
- (:documentation "The result of applying a test"))
-
-(defclass suite-results ()
- ((suite :initarg :suite :reader suite)
- (start-time :initarg :start-time :reader start-time)
- (stop-time :initarg :stop-time :reader stop-time)
- (test-results :initarg :test-results :reader test-results))
- (:documentation "Results of running a suite"))
-
-
-(defmethod report-result ((result test-result) &key (stream t)
- (verbose nil))
- "Print out a test-result object for a report to STREAM, default to
-standard-output. If VERBOSE is non-nil then will produce a lengthy
-and informative report, otherwise just prints wether the test passed
-or failed or errored out."
- (when (or verbose (test-failures result) (test-errors result))
- (when verbose
- (format stream
- "------------------------------------------------------~%"))
- (format stream "~A~A"
- (test-name (result-test result))
- (cond
- ((test-failures result) ":")
- ((test-errors result) ":")
- (t ": Passed")))
- (when (test-failures result)
- (format stream " Failures: ~{~A~^; ~}" (test-failures result)))
- (when (test-errors result)
- (format stream " Errors: ~{~A~^; ~}" (test-errors result)))
- (fresh-line stream)
- (when verbose
- (when (description (result-test result))
- (format stream "Description: ~A~%"
- (description (result-test result)))))))
-
-(defmethod report-result ((results suite-results) &key (stream t)
- (verbose nil))
- (format stream "~&.............~%")
- (format stream "~&Time: ~D~%"
- (float
- (/ (- (stop-time results) (start-time results))
- internal-time-units-per-second)))
- (if (some (lambda (res) (or (test-failures res) (test-errors res)))
- (test-results results))
- (dolist (foo (test-results results))
- (report-result foo :stream stream :verbose verbose))
- (format stream "~&OK (~D tests)~%" (length (test-results results)))))
-
+(defmethod was-successful ((result test-result))
+ (and (null (test-failures result))
+ (null (test-errors result))))
+
+(defmethod text-testrunner ((suite test-suite) &key (stream t)
+ (handle-errors t))
+ (let ((result (make-instance 'test-result))
+ (start-time (get-internal-real-time)))
+ (run-test suite result :handle-errors handle-errors)
+ (let ((seconds (/ (- (get-internal-real-time) start-time)
+ internal-time-units-per-second)))
+ (result-printer result seconds stream))))
+
+(defun result-printer (result seconds stream)
+ (format stream "~&Time: ~D~%~%" (coerce seconds 'float))
+ (print-defects (test-errors result) "error" stream)
+ (print-defects (test-failures result) "failure" stream)
+ (if (was-successful result)
+ (format stream "OK (~D tests)~%" (test-count result))
+ (progn
+ (format stream "~%FAILURES!!!~%")
+ (format stream "Tests run: ~D, Failures: ~D, Errors: ~D~%"
+ (test-count result) (length (test-failures result))
+ (length (test-errors result))))))
+
+(defun print-defects (defects type stream)
+ (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))
+ (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))))))
+
+(defmethod summary ((result test-result))
+ (format nil "~D run, ~D errored, ~D failed"
+ (test-count result) (length (test-errors result))
+ (length (test-failures result))))