about summary refs log tree commit diff
path: root/third_party/lisp/fiveam/src/explain.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/lisp/fiveam/src/explain.lisp')
-rw-r--r--third_party/lisp/fiveam/src/explain.lisp133
1 files changed, 0 insertions, 133 deletions
diff --git a/third_party/lisp/fiveam/src/explain.lisp b/third_party/lisp/fiveam/src/explain.lisp
deleted file mode 100644
index 015cdf45521a..000000000000
--- a/third_party/lisp/fiveam/src/explain.lisp
+++ /dev/null
@@ -1,133 +0,0 @@
-;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
-
-(in-package :it.bese.fiveam)
-
-;;;; * Analyzing the results
-
-(defparameter *verbose-failures* nil
-  "T if we should print the expression failing, NIL otherwise.")
-
-;;;; Just as important as defining and runnig the tests is
-;;;; understanding the results. FiveAM provides the function EXPLAIN
-;;;; which prints a human readable summary (number passed, number
-;;;; failed, what failed and why, etc.) of a list of test results.
-
-(defgeneric explain (explainer results &optional stream recursive-depth)
-  (:documentation "Given a list of test results report write to stream detailed
- human readable statistics regarding the results."))
-
-(defmethod explain ((exp detailed-text-explainer) results
-                    &optional (stream *test-dribble*) (recursive-depth 0))
-  (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 (reverse 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 stream)))))
-
-(defmethod explain ((exp simple-text-explainer) results
-                    &optional (stream *test-dribble*) (recursive-depth 0))
-  (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 passed% skipped skipped% failed failed% unknown unknown%))
-    (format stream "~&~vTRan ~D checks, ~D passed" recursive-depth num-checks num-passed)
-    (when (plusp num-skipped)
-      (format stream ", ~D skipped " num-skipped))
-    (format stream " and ~D failed.~%" num-failed)
-    (when (plusp num-unknown)
-      (format stream "~vT~D UNKNOWN RESULTS.~%" recursive-depth num-unknown))))
-
-(defun partition-results (results-list)
-  (let ((num-checks (length results-list)))
-    (destructuring-bind (passed skipped failed unknown)
-        (partitionx results-list
-                    (lambda (res)
-                      (typep res 'test-passed))
-                    (lambda (res)
-                      (typep res 'test-skipped))
-                    (lambda (res)
-                      (typep res 'test-failure))
-                    t)
-      (if (zerop num-checks)
-          (values 0
-                  nil 0 0
-                  nil 0 0
-                  nil 0 0
-                  nil 0 0)
-          (values
-           num-checks
-           passed (length passed) (floor (* 100 (/ (length passed) num-checks)))
-           skipped (length skipped) (floor (* 100 (/ (length skipped) num-checks)))
-           failed (length failed) (floor (* 100 (/ (length failed) num-checks)))
-           unknown (length unknown) (floor (* 100 (/ (length failed) num-checks))))))))
-
-;; Copyright (c) 2002-2003, Edward Marco Baringer
-;; All rights reserved.
-;;
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions are
-;; met:
-;;
-;;  - Redistributions of source code must retain the above copyright
-;;    notice, this list of conditions and the following disclaimer.
-;;
-;;  - Redistributions in binary form must reproduce the above copyright
-;;    notice, this list of conditions and the following disclaimer in the
-;;    documentation and/or other materials provided with the distribution.
-;;
-;;  - Neither the name of Edward Marco Baringer, nor BESE, nor the names
-;;    of its contributors may be used to endorse or promote products
-;;    derived from this software without specific prior written permission.
-;;
-;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-;; A PARTICULAR PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE COPYRIGHT
-;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-;; LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-;; OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE