src/explain.lisp

   1 ;; -*- lisp -*-
   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 (defmethod explain ((exp detailed-text-explainer) results &optional (stream *test-dribble*))
  16   "Given a list of test results report write to stream detailed
  17   human readable statistics regarding the results."
  18   (multiple-value-bind (num-checks passed num-passed passed%
  19                                    skipped num-skipped skipped%
  20                                    failed num-failed failed%
  21                                    unknown num-unknown unknown%)
  22       (partition-results results)
  23     (declare (ignore passed))
  24     (when (zerop num-checks)
  25       (format stream "~%Didn't run anything...huh?")
  26       (return-from explain nil))
  27     (format stream "~%Did ~D check~P.~%"
  28             num-checks num-checks)
  29     (format stream "   Pass: ~D (~2D%)~%" num-passed passed%)
  30     (format stream "   Skip: ~D (~2D%)~%" num-skipped skipped%)
  31     (format stream "   Fail: ~D (~2D%)~%" num-failed failed%)
  32     (when unknown
  33       (format stream "   UNKNOWN RESULTS: ~D (~2D)~%" num-unknown unknown%))
  34     (terpri stream)
  35     (when failed
  36       (format stream "Failure Details:~%")
  37       (dolist (f failed)
  38         (format stream "~A ~@{[~A]~}: ~%"
  39                 (name (test-case f))
  40                 (description (test-case f)))
  41         (when (and *verbose-failures* (test-expr f))
  42           (format stream "    ~S~%" (test-expr f)))
  43         (format stream "    ~A.~%" (reason f)))
  44       (terpri stream))
  45     (when skipped
  46       (format stream "Skip Details:~%")
  47       (dolist (f skipped)
  48         (format stream "~A ~@{[~A]~}: ~%"
  49                 (name (test-case f))
  50                 (description (test-case f)))
  51         (format stream "    ~A.~%" (reason f)))
  52       (terpri *test-dribble*))))
  53
  54 (defmethod explain ((exp simple-text-explainer) results &optional (stream *test-dribble*))
  55   (multiple-value-bind (num-checks passed num-passed passed%
  56                                    skipped num-skipped skipped%
  57                                    failed num-failed failed%
  58                                    unknown num-unknown unknown%)
  59       (partition-results results)
  60     (declare (ignore passed passed% skipped skipped% failed failed% unknown unknown%))
  61     (format stream "~&Ran ~D checks, ~D passed" num-checks num-passed)
  62     (when (plusp num-skipped)
  63       (format stream ", ~D skipped " num-skipped))
  64     (format stream " and ~D failed.~%" num-failed)
  65     (when (plusp num-unknown)
  66       (format stream "~D UNKNOWN RESULTS.~%" num-unknown))))
  67
  68 (defun partition-results (results-list)
  69   (let ((num-checks (length results-list)))
  70     (destructuring-bind (passed skipped failed unknown)
  71         (partitionx results-list
  72                     (lambda (res)
  73                       (typep res 'test-passed))
  74                     (lambda (res)
  75                       (typep res 'test-skipped))
  76                     (lambda (res)
  77                       (typep res 'test-failure))
  78                     t)
  79       (if (zerop num-checks)
  80           (values 0
  81                   nil 0 0
  82                   nil 0 0
  83                   nil 0 0
  84                   nil 0 0)
  85           (values
  86            num-checks
  87            passed (length passed) (floor (* 100 (/ (length passed) num-checks)))
  88            skipped (length skipped) (floor (* 100 (/ (length skipped) num-checks)))
  89            failed (length failed) (floor (* 100 (/ (length failed) num-checks)))
  90            unknown (length unknown) (floor (* 100 (/ (length failed) num-checks))))))))
  91
  92 ;; Copyright (c) 2002-2003, Edward Marco Baringer
  93 ;; All rights reserved.
  94 ;;
  95 ;; Redistribution and use in source and binary forms, with or without
  96 ;; modification, are permitted provided that the following conditions are
  97 ;; met:
  98 ;;
  99 ;;  - Redistributions of source code must retain the above copyright
 100 ;;    notice, this list of conditions and the following disclaimer.
 101 ;;
 102 ;;  - Redistributions in binary form must reproduce the above copyright
 103 ;;    notice, this list of conditions and the following disclaimer in the
 104 ;;    documentation and/or other materials provided with the distribution.
 105 ;;
 106 ;;  - Neither the name of Edward Marco Baringer, nor BESE, nor the names
 107 ;;    of its contributors may be used to endorse or promote products
 108 ;;    derived from this software without specific prior written permission.
 109 ;;
 110 ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 111 ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 112 ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 113 ;; A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
 114 ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 115 ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 116 ;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 117 ;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 118 ;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 119 ;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 120 ;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE