(defmethod explain ((exp detailed-text-explainer) results
                    &optional (stream *test-dribble*) (recursive-depth 0))
  #| "Given a list of test results report write to stream detailed
  human readable statistics regarding the results." |# 
  (multiple-value-bind (num-checks passed num-passed passed%
				   skipped num-skipped skipped%
				   failed num-failed failed%
				   unknown num-unknown unknown%)
      (partition-results results)
    (declare (ignore passed))
    (flet ((output (&rest format-args)
             (format stream "~&~vT" recursive-depth)
             (apply #'format stream format-args)))
      (when (zerop num-checks)
        (output "Didn't run anything...huh?")
        (return-from explain nil))
      (output "Did ~D check~P.~%" num-checks num-checks)
      (output "   Pass: ~D (~2D%)~%" num-passed passed%)
      (output "   Skip: ~D (~2D%)~%" num-skipped skipped%)
      (output "   Fail: ~D (~2D%)~%" num-failed failed%)
      (when unknown
        (output "   UNKNOWN RESULTS: ~D (~2D)~%" num-unknown unknown%))
      (terpri stream)
      (when failed
        (output "Failure Details:~%")
        (dolist (f failed)
          (output "--------------------------------~%")
          (output "~A ~@{[~A]~}: ~%" 
                  (name (test-case f))
                  (description (test-case f)))
          (output "     ~A.~%" (reason f))
          (when (for-all-test-failed-p f)
            (output "Results collected with failure data:~%")
            (explain exp (slot-value f 'result-list)
                     stream (+ 4 recursive-depth)))
          (when (and *verbose-failures* (test-expr f))
            (output "    ~S~%" (test-expr f)))
          (output "--------------------------------~%"))
        (terpri stream))
      (when skipped
        (output "Skip Details:~%")
        (dolist (f skipped)
          (output "~A ~@{[~A]~}: ~%" 
                  (name (test-case f))
                  (description (test-case f)))
          (output "    ~A.~%" (reason f)))
        (terpri *test-dribble*)))))
Source Context