3 (in-package :it.bese.FiveAM)
5 ;;;; * Random (QuickCheck-ish) testing
7 ;;;; FiveAM provides the ability to automatically generate a
8 ;;;; collection of random input data for a specific test and run a
9 ;;;; test multiple times.
11 ;;;; Specification testing is done through the FOR-ALL macro. This
12 ;;;; macro will bind variables to random data and run a test body a
13 ;;;; certain number of times. Should the test body ever signal a
14 ;;;; failure we stop running and report what values of the variables
15 ;;;; caused the code to fail.
17 (defparameter *num-trials* 100
18 "Number of times we attempt to run the body of the FOR-ALL test.")
20 (defparameter *max-trials* 10000
21 "Number of total times we attempt to run the body of the
22 FOR-ALL test including when the body is skipped due to failed
25 Since we have guard conditions we may get into infinite loops
26 where the test code is never run due to the guards never
27 returning true. This second run limit prevents that.")
29 (defmacro for-all (bindings &body body)
30 `(perform-random-testing
31 (list ,@(mapcar #'second bindings))
32 (lambda ,(mapcar #'first bindings)
33 (if (and ,@(delete-if #'null (mapcar #'third bindings)))
36 (list :guard-conditions-failed))))))
38 (defun perform-random-testing (generators body)
40 with random-state = *random-state*
41 with total-counter = *max-trials*
42 with counter = *num-trials*
43 with run-at-least-once = nil
44 until (or (zerop total-counter)
46 do (let ((result (perform-random-testing/run-once generators body)))
51 (setf run-at-least-once t))
53 (add-result 'for-all-test-no-tests
55 :random-state random-state)
56 (return-from perform-random-testing nil))
57 (:guard-conditions-failed
60 (add-result 'for-all-test-failed
61 :reason "Found failing test data"
62 :random-state random-state
63 :failure-values (second result)
64 :result-list (third result))
65 (return-from perform-random-testing nil))))
66 finally (if run-at-least-once
67 (add-result 'for-all-test-passed)
68 (add-result 'for-all-test-never-run
69 :reason "Guard conditions never passed"))))
71 (defun perform-random-testing/run-once (generators body)
73 (bind-run-state ((result-list '()))
74 (let ((values (mapcar #'funcall generators)))
78 (throw 'run-once (list :no-tests)))
79 ((every #'test-passed-p result-list)
80 (throw 'run-once (list :pass)))
81 ((notevery #'test-passed-p result-list)
82 (throw 'run-once (list :fail values result-list))))))))
84 (defclass for-all-test-result ()
85 ((random-state :initarg :random-state)))
87 (defclass for-all-test-passed (test-passed for-all-test-result)
90 (defclass for-all-test-failed (test-failure for-all-test-result)
91 ((failure-values :initarg :failure-values)
92 (result-list :initarg :result-list)))
94 (defgeneric for-all-test-failed-p (object)
95 (:method ((object for-all-test-failed)) t)
96 (:method ((object t)) nil))
98 (defmethod reason ((result for-all-test-failed))
99 (format nil "Falsafiable with ~S" (slot-value result 'failure-values)))
101 (defclass for-all-test-no-tests (test-failure for-all-test-result)
104 (defclass for-all-test-never-run (test-failure for-all-test-result)
109 ;;;; Since this is random testing we need some way of creating random
110 ;;;; data to feed to our code. Generators are regular functions whcih
111 ;;;; create this random data.
113 ;;;; We provide a set of built-in generators.
115 (defmacro defgenerator (name arguments &body body)
116 `(defun ,name ,arguments
119 (defgenerator gen-integer (&key (max (1+ most-positive-fixnum))
120 (min (1+ most-negative-fixnum)))
121 (+ min (random (1+ (- max min)))))
123 (defgenerator gen-character (&key (code (gen-integer :min 0 :max (1- char-code-limit)))
126 (code-char (funcall code))
128 for char = (code-char (funcall code))
129 until (alphanumericp char)
130 finally (return char))))
132 (defun gen-string (&key
133 (length (gen-integer :min 0 :max 80))
134 (elements (gen-character))
135 (element-type 'character))
138 with length = (funcall length)
139 with string = (make-string length :element-type element-type)
140 for index below length
141 do (setf (aref string index) (funcall elements))
142 finally (return string))))
144 (defun gen-list (&key
145 (length (gen-integer :min 0 :max 10))
146 (elements (gen-integer :min -10 :max 10)))
149 repeat (funcall length)
150 collect (funcall elements))))
152 ;;;; The trivial always-produce-the-same-thing generator is done using