src/explain.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2
   3 (in-package :it.bese.fiveam)
   4
   5 ;;;; * Analyzing the results
   6
   7 (defparameter *verbose-failures* nil
   8   "T if we should print the expression failing, NIL otherwise.")
   9
  10 ;;;; Just as important as defining and runnig the tests is
  11 ;;;; understanding the results. FiveAM provides the function EXPLAIN
  12 ;;;; which prints a human readable summary (number passed, number
  13 ;;;; failed, what failed and why, etc.) of a list of test results.
  14
  15 (defgeneric explain (explainer results &optional stream recursive-depth))
  16
  17 (defmethod explain ((exp detailed-text-explainer) results
  18                     &optional (stream *test-dribble*) (recursive-depth 0))
  19   #| "Given a list of test results report write to stream detailed
  20   human readable statistics regarding the results." |#
  21   (multiple-value-bind (num-checks passed num-passed passed%
  22                                    skipped num-skipped skipped%
  23                                    failed num-failed failed%
  24                                    unknown num-unknown unknown%)
  25       (partition-results results)
  26     (declare (ignore passed))
  27     (flet ((output (&rest format-args)
  28              (format stream "~&~vT" recursive-depth)
  29              (apply #'format stream format-args)))
  30
  31       (when (zerop num-checks)
  32         (output "Didn't run anything...huh?")
  33         (return-from explain nil))
  34       (output "Did ~D check~P.~%" num-checks num-checks)
  35       (output "   Pass: ~D (~2D%)~%" num-passed passed%)
  36       (output "   Skip: ~D (~2D%)~%" num-skipped skipped%)
  37       (output "   Fail: ~D (~2D%)~%" num-failed failed%)
  38       (when unknown
  39         (output "   UNKNOWN RESULTS: ~D (~2D)~%" num-unknown unknown%))
  40       (terpri stream)
  41       (when failed
  42         (output "Failure Details:~%")
  43         (dolist (f (reverse failed))
  44           (output "--------------------------------~%")
  45           (output "~A ~@{[~A]~}: ~%"
  46                   (name (test-case f))
  47                   (description (test-case f)))
  48           (output "     ~A.~%" (reason f))
  49           (when (for-all-test-failed-p f)
  50             (output "Results collected with failure data:~%")
  51             (explain exp (slot-value f 'result-list)
  52                      stream (+ 4 recursive-depth)))
  53           (when (and *verbose-failures* (test-expr f))
  54             (output "    ~S~%" (test-expr f)))
  55           (output "--------------------------------~%"))
  56         (terpri stream))
  57       (when skipped
  58         (output "Skip Details:~%")
  59         (dolist (f skipped)
  60           (output "~A ~@{[~A]~}: ~%"
  61                   (name (test-case f))
  62                   (description (test-case f)))
  63           (output "    ~A.~%" (reason f)))
  64         (terpri *test-dribble*)))))
  65
  66 (defmethod explain ((exp simple-text-explainer) results
  67                     &optional (stream *test-dribble*) (recursive-depth 0))
  68   (multiple-value-bind (num-checks passed num-passed passed%
  69                                    skipped num-skipped skipped%
  70                                    failed num-failed failed%
  71                                    unknown num-unknown unknown%)
  72       (partition-results results)
  73     (declare (ignore passed passed% skipped skipped% failed failed% unknown unknown%))
  74     (format stream "~&~vTRan ~D checks, ~D passed" recursive-depth num-checks num-passed)
  75     (when (plusp num-skipped)
  76       (format stream ", ~D skipped " num-skipped))
  77     (format stream " and ~D failed.~%" num-failed)
  78     (when (plusp num-unknown)
  79       (format stream "~vT~D UNKNOWN RESULTS.~%" recursive-depth num-unknown))))
  80
  81 (defun partition-results (results-list)
  82   (let ((num-checks (length results-list)))
  83     (destructuring-bind (passed skipped failed unknown)
  84         (partitionx results-list
  85                     (lambda (res)
  86                       (typep res 'test-passed))
  87                     (lambda (res)
  88                       (typep res 'test-skipped))
  89                     (lambda (res)
  90                       (typep res 'test-failure))
  91                     t)
  92       (if (zerop num-checks)
  93           (values 0
  94                   nil 0 0
  95                   nil 0 0
  96                   nil 0 0
  97                   nil 0 0)
  98           (values
  99            num-checks
 100            passed (length passed) (floor (* 100 (/ (length passed) num-checks)))
 101            skipped (length skipped) (floor (* 100 (/ (length skipped) num-checks)))
 102            failed (length failed) (floor (* 100 (/ (length failed) num-checks)))
 103            unknown (length unknown) (floor (* 100 (/ (length failed) num-checks))))))))
 104
 105 ;; Copyright (c) 2002-2003, Edward Marco Baringer
 106 ;; All rights reserved.
 107 ;;
 108 ;; Redistribution and use in source and binary forms, with or without
 109 ;; modification, are permitted provided that the following conditions are
 110 ;; met:
 111 ;;
 112 ;;  - Redistributions of source code must retain the above copyright
 113 ;;    notice, this list of conditions and the following disclaimer.
 114 ;;
 115 ;;  - Redistributions in binary form must reproduce the above copyright
 116 ;;    notice, this list of conditions and the following disclaimer in the
 117 ;;    documentation and/or other materials provided with the distribution.
 118 ;;
 119 ;;  - Neither the name of Edward Marco Baringer, nor BESE, nor the names
 120 ;;    of its contributors may be used to endorse or promote products
 121 ;;    derived from this software without specific prior written permission.
 122 ;;
 123 ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 124 ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 125 ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 126 ;; A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
 127 ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 128 ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 129 ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 130 ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 131 ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 132 ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 133 ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE