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 where
36 the test code is never run due to the guards never returning
37 true. This second limit prevents that from happening.")
39 (defmacro for-all (bindings &body body)
40 "Bind BINDINGS to random variables and execute BODY `*num-trials*` times.
44 A a list of binding forms, each element is a list of:
46 (BINDING VALUE &optional GUARD)
48 VALUE, which is evaluated once when the for-all is evaluated, must
49 return a generator which be called each time BODY is
50 evaluated. BINDING is either a symbol or a list which will be passed
51 to destructuring-bind. GUARD is a form which, if present, stops BODY
52 from executing when it returns NIL. The GUARDS are evaluated after all
53 the random data has been generated and they can refer to the current
57 Generator forms, unlike guard forms, can not contain references to the
62 The code to run. Will be run `*NUM-TRIALS*` times (unless the `*MAX-TRIALS*` limit is reached).
66 --------------------------------
67 \(for-all ((a (gen-integer)))
70 \(for-all ((a (gen-integer) (plusp a)))
74 \(for-all ((less (gen-integer))
75 (more (gen-integer) (< less more)))
78 \(defun gen-two-integers ()
80 (list (funcall (gen-integer))
81 (funcall (gen-integer)))))
83 \(for-all (((a b) (gen-two-integers)))
86 --------------------------------
88 (with-gensyms (test-lambda-args)
89 `(perform-random-testing
90 (list ,@(mapcar #'second bindings))
91 (lambda (,test-lambda-args)
92 (destructuring-bind ,(mapcar #'first bindings)
94 (if (and ,@(delete-if #'null (mapcar #'third bindings)))
97 (list :guard-conditions-failed))))))))
99 ;;;; *** Implementation
101 ;;;; We could just make FOR-ALL a monster macro, but having FOR-ALL be
102 ;;;; a preproccessor for the perform-random-testing function is
103 ;;;; actually much easier.
105 (defun perform-random-testing (generators body)
107 with random-state = *random-state*
108 with total-counter = *max-trials*
109 with counter = *num-trials*
110 with run-at-least-once = nil
111 until (or (zerop total-counter)
113 do (let ((result (perform-random-testing/run-once generators body)))
114 (ecase (first result)
118 (setf run-at-least-once t))
120 (add-result 'for-all-test-no-tests
122 :random-state random-state)
123 (return-from perform-random-testing nil))
124 (:guard-conditions-failed
125 (decf total-counter))
127 (add-result 'for-all-test-failed
128 :reason "Found failing test data"
129 :random-state random-state
130 :failure-values (second result)
131 :result-list (third result))
132 (return-from perform-random-testing nil))))
133 finally (if run-at-least-once
134 (add-result 'for-all-test-passed)
135 (add-result 'for-all-test-never-run
136 :reason "Guard conditions never passed"))))
138 (defun perform-random-testing/run-once (generators body)
140 (bind-run-state ((result-list '()))
141 (let ((values (mapcar #'funcall generators)))
142 (funcall body values)
145 (throw 'run-once (list :no-tests)))
146 ((every #'test-passed-p result-list)
147 (throw 'run-once (list :pass)))
148 ((notevery #'test-passed-p result-list)
149 (throw 'run-once (list :fail values result-list))))))))
151 (defclass for-all-test-result ()
152 ((random-state :initarg :random-state)))
154 (defclass for-all-test-passed (test-passed for-all-test-result)
157 (defclass for-all-test-failed (test-failure for-all-test-result)
158 ((failure-values :initarg :failure-values)
159 (result-list :initarg :result-list)))
161 (defgeneric for-all-test-failed-p (object)
162 (:method ((object for-all-test-failed)) t)
163 (:method ((object t)) nil))
165 (defmethod reason ((result for-all-test-failed))
166 (format nil "Falsifiable with ~S" (slot-value result 'failure-values)))
168 (defclass for-all-test-no-tests (test-failure for-all-test-result)
171 (defclass for-all-test-never-run (test-failure for-all-test-result)
176 ;;;; Since this is random testing we need some way of creating random
177 ;;;; data to feed to our code. Generators are regular functions which
178 ;;;; create this random data.
180 ;;;; We provide a set of built-in generators.
182 (defun gen-integer (&key (max (1+ most-positive-fixnum))
183 (min (1- most-negative-fixnum)))
184 "Returns a generator which produces random integers greater
185 than or equal to MIN and less than or equal to MIN."
187 (+ min (random (1+ (- max min))))))
189 (defun type-most-negative (floating-point-type)
190 (ecase floating-point-type
191 (short-float most-negative-short-float)
192 (single-float most-negative-single-float)
193 (double-float most-negative-double-float)
194 (long-float most-negative-long-float)))
196 (defun type-most-positive (floating-point-type)
197 (ecase floating-point-type
198 (short-float most-positive-short-float)
199 (single-float most-positive-single-float)
200 (double-float most-positive-double-float)
201 (long-float most-positive-long-float)) )
203 (defun gen-float (&key bound (type 'short-float) min max)
204 "Returns a generator which producs floats of type TYPE.
208 Constrains the results to be in the range (-BOUND, BOUND). Default
209 value is the most-positive value of TYPE.
213 If supplied, cause the returned float to be within the floating point
214 interval (MIN, MAX). It is the caller's responsibility to ensure that
215 the range between MIN and MAX is less than the requested type's
216 maximum interval. MIN defaults to 0.0 (when only MAX is supplied), MAX
217 defaults to MOST-POSITIVE-<TYPE> (when only MIN is supplied). This
218 peculiar calling convention is designed for the common case of
219 generating positive values below a known limit.
223 The type of the returned float. Defaults to `SHORT-FLOAT`. Effects the
224 default values of BOUND, MIN and MAX.
227 Since GEN-FLOAT is built on CL:RANDOM the distribution of returned
228 values will be continuous, not discrete. In other words: the values
229 will be evenly distributed across the specified numeric range, the
230 distribution of possible floating point values, when seen as a
231 sequence of bits, will not be even."
233 (flet ((rand (limit) (random (coerce limit type))))
234 (when (and bound (or min max))
235 (error "GET-FLOAT does not support specifying :BOUND and :MAX/:MIN."))
237 (handler-bind ((arithmetic-error (lambda (c)
238 (error "ERROR ~S occured when attempting to generate a random value between ~S and ~S." c min max))))
240 max (or max (type-most-positive type)))
241 (+ min (rand (- max min))))
242 (let ((min (if bound bound (- (type-most-negative type))))
243 (max (if bound bound (type-most-positive type))))
245 (0 ;; generate a positive number
247 (1 ;; generate a negative number NB: min is actually
248 ;; positive. see the if statement above.
249 (- (rand min)))))))))
251 (defun gen-character (&key (code-limit char-code-limit)
252 (code (gen-integer :min 0 :max (1- code-limit)))
254 "Returns a generator of characters.
258 A generater for random integers.
262 If set only characters whose code-char is below this value will be
267 Limits the returned chars to those which pass alphanumericp.
272 for char = (code-char (funcall code))
274 (or (not alphanumericp)
275 (alphanumericp char)))
277 do (error "After 1000 iterations ~S has still not generated ~:[a valid~;an alphanumeric~] character :(."
279 finally (return char))))
281 (defun gen-string (&key (length (gen-integer :min 0 :max 80))
282 (elements (gen-character)))
283 "Returns a generator which producs random strings of characters.
287 A random integer generator specifying how long to make the generated string.
291 A random character generator which producs the characters in the
294 (gen-buffer :length length
295 :element-type 'character
298 (defun gen-buffer (&key (length (gen-integer :min 0 :max 50))
299 (element-type '(unsigned-byte 8))
300 (elements (gen-integer :min 0 :max (1- (expt 2 8)))))
301 "Generates a random vector, defaults to a random (unsigned-byte 8)
302 vector with elements between 0 and 255.
306 The length of the buffer to create (a random integer generator)
310 The type of array to create.
314 The random element generator.
317 (let ((buffer (make-array (funcall length) :element-type element-type)))
318 (map-into buffer elements))))
320 (defun gen-list (&key (length (gen-integer :min 0 :max 10))
321 (elements (gen-integer :min -10 :max 10)))
322 "Returns a generator which producs random lists.
326 As with GEN-STRING, a random integer generator specifying the length of the list to create.
330 A random object generator.
334 repeat (funcall length)
335 collect (funcall elements))))
337 (defun gen-tree (&key (size 20)
338 (elements (gen-integer :min -10 :max 10)))
339 "Returns a generator which producs random trees. SIZE control
340 the approximate size of the tree, but don't try anything above
341 30, you have been warned. ELEMENTS must be a generator which
342 will produce the elements."
343 (labels ((rec (&optional (current-depth 0))
344 (let ((key (random (+ 3 (- size current-depth)))))
346 (list (rec (+ current-depth 1))
347 (rec (+ current-depth 1))))
348 (t (funcall elements))))))
352 (defun gen-one-element (&rest elements)
353 "Produces one randomly selected element of ELEMENTS.
357 A list of objects (note: objects, not generators) to choose from."
359 (nth (random (length elements)) elements)))
361 ;;;; The trivial always-produce-the-same-thing generator is done using