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 which
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-float (&key bound (type 'short-float))
124 (let* ((most-negative (ecase type
125 (short-float most-negative-short-float)
126 (single-float most-negative-single-float)
127 (double-float most-negative-double-float)
128 (long-float most-negative-long-float)))
129 (most-positive (ecase type
130 (short-float most-positive-short-float)
131 (single-float most-positive-single-float)
132 (double-float most-positive-double-float)
133 (long-float most-positive-long-float)))
134 (bound (or bound (max most-positive (- most-negative)))))
137 (0 ;; generate a positive number
138 (random (min most-positive bound)))
139 (1 ;; generate a negative number
140 (- (random (min (- most-negative) bound)))))
143 (defgenerator gen-character (&key (code (gen-integer :min 0 :max (1- char-code-limit)))
146 (code-char (funcall code))
148 for char = (code-char (funcall code))
149 until (alphanumericp char)
150 finally (return char))))
152 (defgenerator gen-string (&key (length (gen-integer :min 0 :max 80))
153 (elements (gen-character))
154 (element-type 'character))
156 with length = (funcall length)
157 with string = (make-string length :element-type element-type)
158 for index below length
159 do (setf (aref string index) (funcall elements))
160 finally (return string)))
162 (defgenerator gen-list (&key (length (gen-integer :min 0 :max 10))
163 (elements (gen-integer :min -10 :max 10)))
165 repeat (funcall length)
166 collect (funcall elements)))
168 ;;;; The trivial always-produce-the-same-thing generator is done using