1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
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 ;;;; The generation of the random data is done using "generator
18 ;;;; functions" (see below for details). A generator function is a
19 ;;;; function which creates, based on user supplied parameters, a
20 ;;;; function which returns random data. In order to facilitate
21 ;;;; generating good random data the FOR-ALL macro also supports guard
22 ;;;; conditions and creating one random input based on the values of
23 ;;;; another (see the FOR-ALL macro for details).
25 ;;;; *** Public Interface to the Random Tester
27 (defparameter *num-trials* 100
28 "Number of times we attempt to run the body of the FOR-ALL test.")
30 (defparameter *max-trials* 10000
31 "Number of total times we attempt to run the body of the
32 FOR-ALL test including when the body is skipped due to failed
35 Since we have guard conditions we may get into infinite loops
36 where the test code is never run due to the guards never
37 returning true. This second run limit prevents that.")
39 (defmacro for-all (bindings &body body)
40 "Bind BINDINGS to random variables and test BODY *num-trials* times.
42 BINDINGS is a list of binding forms, each element is a list
43 of (BINDING VALUE &optional GUARD). Value, which is evaluated
44 once when the for-all is evaluated, must return a generator which
45 be called each time BODY is evaluated. BINDING is either a symbol
46 or a list which will be passed to destructuring-bind. GUARD is a
47 form which, if present, stops BODY from executing when IT returns
48 NIL. The GUARDS are evaluated after all the random data has been
49 generated and they can refer to the current value of any
50 binding. NB: Generator forms, unlike guard forms, can not contain
51 references to the boud variables.
55 (for-all ((a (gen-integer)))
58 (for-all ((a (gen-integer) (plusp a)))
62 (for-all ((less (gen-integer))
63 (more (gen-integer) (< less more)))
66 (for-all (((a b) (gen-two-integers)))
69 (with-gensyms (test-lambda-args)
70 `(perform-random-testing
71 (list ,@(mapcar #'second bindings))
72 (lambda (,test-lambda-args)
73 (destructuring-bind ,(mapcar #'first bindings)
75 (if (and ,@(delete-if #'null (mapcar #'third bindings)))
78 (list :guard-conditions-failed))))))))
80 ;;;; *** Implementation
82 ;;;; We could just make FOR-ALL a monster macro, but having FOR-ALL be
83 ;;;; a preproccessor for the perform-random-testing function is
84 ;;;; actually much easier.
86 (defun perform-random-testing (generators body)
88 with random-state = *random-state*
89 with total-counter = *max-trials*
90 with counter = *num-trials*
91 with run-at-least-once = nil
92 until (or (zerop total-counter)
94 do (let ((result (perform-random-testing/run-once generators body)))
99 (setf run-at-least-once t))
101 (add-result 'for-all-test-no-tests
103 :random-state random-state)
104 (return-from perform-random-testing nil))
105 (:guard-conditions-failed
106 (decf total-counter))
108 (add-result 'for-all-test-failed
109 :reason "Found failing test data"
110 :random-state random-state
111 :failure-values (second result)
112 :result-list (third result))
113 (return-from perform-random-testing nil))))
114 finally (if run-at-least-once
115 (add-result 'for-all-test-passed)
116 (add-result 'for-all-test-never-run
117 :reason "Guard conditions never passed"))))
119 (defun perform-random-testing/run-once (generators body)
121 (bind-run-state ((result-list '()))
122 (let ((values (mapcar #'funcall generators)))
123 (funcall body values)
126 (throw 'run-once (list :no-tests)))
127 ((every #'test-passed-p result-list)
128 (throw 'run-once (list :pass)))
129 ((notevery #'test-passed-p result-list)
130 (throw 'run-once (list :fail values result-list))))))))
132 (defclass for-all-test-result ()
133 ((random-state :initarg :random-state)))
135 (defclass for-all-test-passed (test-passed for-all-test-result)
138 (defclass for-all-test-failed (test-failure for-all-test-result)
139 ((failure-values :initarg :failure-values)
140 (result-list :initarg :result-list)))
142 (defgeneric for-all-test-failed-p (object)
143 (:method ((object for-all-test-failed)) t)
144 (:method ((object t)) nil))
146 (defmethod reason ((result for-all-test-failed))
147 (format nil "Falsifiable with ~S" (slot-value result 'failure-values)))
149 (defclass for-all-test-no-tests (test-failure for-all-test-result)
152 (defclass for-all-test-never-run (test-failure for-all-test-result)
157 ;;;; Since this is random testing we need some way of creating random
158 ;;;; data to feed to our code. Generators are regular functions which
159 ;;;; create this random data.
161 ;;;; We provide a set of built-in generators.
163 (defun gen-integer (&key (max (1+ most-positive-fixnum))
164 (min (1- most-negative-fixnum)))
165 "Returns a generator which produces random integers greater
166 than or equal to MIN and less than or equal to MIN."
168 (+ min (random (1+ (- max min))))))
170 (defun type-most-negative (floating-point-type)
171 (ecase floating-point-type
172 (short-float most-negative-short-float)
173 (single-float most-negative-single-float)
174 (double-float most-negative-double-float)
175 (long-float most-negative-long-float)))
177 (defun type-most-positive (floating-point-type)
178 (ecase floating-point-type
179 (short-float most-positive-short-float)
180 (single-float most-positive-single-float)
181 (double-float most-positive-double-float)
182 (long-float most-positive-long-float)) )
184 (defun gen-float (&key bound (type 'short-float) min max)
185 "Returns a generator which producs floats of type TYPE.
187 BOUND, which defaults to the most-positive value of TYPE, constrains
188 the results to be in the range (-BOUND, BOUND).
190 MIN and MAX, if supplied, cause the returned float to be within the
191 floating point interval (MIN, MAX). It is the caller's responsibility
192 to ensure that the range between MIN and MAX is less than the
193 requested type's maximum interval. MIN defaults to 0.0 (when only MAX
194 is supplied), MAX defaults to MOST-POSITIVE-<TYPE> (when only MIN is
195 supplied). This peculiar calling convention is designed for the common
196 case of generating positive values below a known limit.
198 NOTE: Since GEN-FLOAT is built on CL:RANDOM the distribution of
199 returned values will be continuous, not discrete. In other words: the
200 values will be evenly distributed across the specified numeric range,
201 the distribution of possible floating point values, when seen as a
202 sequence of bits, will not be even."
204 (flet ((rand (limit) (random (coerce limit type))))
205 (when (and bound (or min max))
206 (error "GET-FLOAT does not support specifying :BOUND and :MAX/:MIN."))
208 (handler-bind ((arithmetic-error (lambda (c)
209 (error "ERROR ~S occured when attempting to generate a random value between ~S and ~S." c min max))))
211 max (or max (type-most-positive type)))
212 (+ min (rand (- max min))))
213 (let ((min (if bound bound (- (type-most-negative type))))
214 (max (if bound bound (type-most-positive type))))
216 (0 ;; generate a positive number
218 (1 ;; generate a negative number NB: min is actually
219 ;; positive. see the if statement above.
220 (- (rand min)))))))))
222 (defun gen-character (&key (code-limit char-code-limit)
223 (code (gen-integer :min 0 :max (1- code-limit)))
225 "Returns a generator of characters.
227 CODE must be a generator of random integers. ALPHANUMERICP, if
228 non-NIL, limits the returned chars to those which pass
233 for char = (code-char (funcall code))
235 (or (not alphanumericp)
236 (alphanumericp char)))
238 do (error "After 1000 iterations ~S has still not generated ~:[a valid~;an alphanumeric~] character :(."
240 finally (return char))))
242 (defun gen-string (&key (length (gen-integer :min 0 :max 80))
243 (elements (gen-character))
244 (element-type 'character))
245 "Returns a generator which producs random strings. LENGTH must
246 be a generator which producs integers, ELEMENTS must be a
247 generator which produces characters of type ELEMENT-TYPE."
250 with length = (funcall length)
251 with string = (make-string length :element-type element-type)
252 for index below length
253 do (setf (aref string index) (funcall elements))
254 finally (return string))))
256 (defun gen-list (&key (length (gen-integer :min 0 :max 10))
257 (elements (gen-integer :min -10 :max 10)))
258 "Returns a generator which producs random lists. LENGTH must be
259 an integer generator and ELEMENTS must be a generator which
263 repeat (funcall length)
264 collect (funcall elements))))
266 (defun gen-tree (&key (size 20)
267 (elements (gen-integer :min -10 :max 10)))
268 "Returns a generator which producs random trees. SIZE control
269 the approximate size of the tree, but don't try anything above
270 30, you have been warned. ELEMENTS must be a generator which
271 will produce the elements."
272 (labels ((rec (&optional (current-depth 0))
273 (let ((key (random (+ 3 (- size current-depth)))))
275 (list (rec (+ current-depth 1))
276 (rec (+ current-depth 1))))
277 (t (funcall elements))))))
281 (defun gen-buffer (&key (length (gen-integer :min 0 :max 50))
282 (element-type '(unsigned-byte 8))
283 (elements (gen-integer :min 0 :max (1- (expt 2 8)))))
285 (let ((buffer (make-array (funcall length) :element-type element-type)))
286 (map-into buffer elements))))
288 (defun gen-one-element (&rest elements)
290 (nth (random (length elements)) elements)))
292 ;;;; The trivial always-produce-the-same-thing generator is done using