/usr/share/common-lisp/source/fiveam/src/random.lisp is in cl-fiveam 1.2-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 | ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
(in-package :it.bese.fiveam)
;;;; ** Random (QuickCheck-ish) testing
;;;; FiveAM provides the ability to automatically generate a
;;;; collection of random input data for a specific test and run a
;;;; test multiple times.
;;;; Specification testing is done through the FOR-ALL macro. This
;;;; macro will bind variables to random data and run a test body a
;;;; certain number of times. Should the test body ever signal a
;;;; failure we stop running and report what values of the variables
;;;; caused the code to fail.
;;;; The generation of the random data is done using "generator
;;;; functions" (see below for details). A generator function is a
;;;; function which creates, based on user supplied parameters, a
;;;; function which returns random data. In order to facilitate
;;;; generating good random data the FOR-ALL macro also supports guard
;;;; conditions and creating one random input based on the values of
;;;; another (see the FOR-ALL macro for details).
;;;; *** Public Interface to the Random Tester
(defparameter *num-trials* 100
"Number of times we attempt to run the body of the FOR-ALL test.")
(defparameter *max-trials* 10000
"Number of total times we attempt to run the body of the
FOR-ALL test including when the body is skipped due to failed
guard conditions.
Since we have guard conditions we may get into infinite loops
where the test code is never run due to the guards never
returning true. This second run limit prevents that.")
(defmacro for-all (bindings &body body)
"Bind BINDINGS to random variables and test BODY *num-trials* times.
BINDINGS is a list of binding forms, each element is a list
of (BINDING VALUE &optional GUARD). Value, which is evaluated
once when the for-all is evaluated, must return a generator which
be called each time BODY is evaluated. BINDING is either a symbol
or a list which will be passed to destructuring-bind. GUARD is a
form which, if present, stops BODY from executing when IT returns
NIL. The GUARDS are evaluated after all the random data has been
generated and they can refer to the current value of any
binding. NB: Generator forms, unlike guard forms, can not contain
references to the boud variables.
Examples:
(for-all ((a (gen-integer)))
(is (integerp a)))
(for-all ((a (gen-integer) (plusp a)))
(is (integerp a))
(is (plusp a)))
(for-all ((less (gen-integer))
(more (gen-integer) (< less more)))
(is (<= less more)))
(for-all (((a b) (gen-two-integers)))
(is (integerp a))
(is (integerp b)))"
(with-gensyms (test-lambda-args)
`(perform-random-testing
(list ,@(mapcar #'second bindings))
(lambda (,test-lambda-args)
(destructuring-bind ,(mapcar #'first bindings)
,test-lambda-args
(if (and ,@(delete-if #'null (mapcar #'third bindings)))
(progn ,@body)
(throw 'run-once
(list :guard-conditions-failed))))))))
;;;; *** Implementation
;;;; We could just make FOR-ALL a monster macro, but having FOR-ALL be
;;;; a preproccessor for the perform-random-testing function is
;;;; actually much easier.
(defun perform-random-testing (generators body)
(loop
with random-state = *random-state*
with total-counter = *max-trials*
with counter = *num-trials*
with run-at-least-once = nil
until (or (zerop total-counter)
(zerop counter))
do (let ((result (perform-random-testing/run-once generators body)))
(ecase (first result)
(:pass
(decf counter)
(decf total-counter)
(setf run-at-least-once t))
(:no-tests
(add-result 'for-all-test-no-tests
:reason "No tests"
:random-state random-state)
(return-from perform-random-testing nil))
(:guard-conditions-failed
(decf total-counter))
(:fail
(add-result 'for-all-test-failed
:reason "Found failing test data"
:random-state random-state
:failure-values (second result)
:result-list (third result))
(return-from perform-random-testing nil))))
finally (if run-at-least-once
(add-result 'for-all-test-passed)
(add-result 'for-all-test-never-run
:reason "Guard conditions never passed"))))
(defun perform-random-testing/run-once (generators body)
(catch 'run-once
(bind-run-state ((result-list '()))
(let ((values (mapcar #'funcall generators)))
(funcall body values)
(cond
((null result-list)
(throw 'run-once (list :no-tests)))
((every #'test-passed-p result-list)
(throw 'run-once (list :pass)))
((notevery #'test-passed-p result-list)
(throw 'run-once (list :fail values result-list))))))))
(defclass for-all-test-result ()
((random-state :initarg :random-state)))
(defclass for-all-test-passed (test-passed for-all-test-result)
())
(defclass for-all-test-failed (test-failure for-all-test-result)
((failure-values :initarg :failure-values)
(result-list :initarg :result-list)))
(defgeneric for-all-test-failed-p (object)
(:method ((object for-all-test-failed)) t)
(:method ((object t)) nil))
(defmethod reason ((result for-all-test-failed))
(format nil "Falsifiable with ~S" (slot-value result 'failure-values)))
(defclass for-all-test-no-tests (test-failure for-all-test-result)
())
(defclass for-all-test-never-run (test-failure for-all-test-result)
())
;;;; *** Generators
;;;; Since this is random testing we need some way of creating random
;;;; data to feed to our code. Generators are regular functions which
;;;; create this random data.
;;;; We provide a set of built-in generators.
(defun gen-integer (&key (max (1+ most-positive-fixnum))
(min (1- most-negative-fixnum)))
"Returns a generator which produces random integers greater
than or equal to MIN and less than or equal to MIN."
(lambda ()
(+ min (random (1+ (- max min))))))
(defun gen-float (&key bound (type 'short-float))
"Returns a generator which producs floats of type TYPE. BOUND,
if specified, constrains the ruselts to be in the range (-BOUND,
BOUND)."
(lambda ()
(let* ((most-negative (ecase type
(short-float most-negative-short-float)
(single-float most-negative-single-float)
(double-float most-negative-double-float)
(long-float most-negative-long-float)))
(most-positive (ecase type
(short-float most-positive-short-float)
(single-float most-positive-single-float)
(double-float most-positive-double-float)
(long-float most-positive-long-float)))
(bound (or bound (max most-positive (- most-negative)))))
(coerce
(ecase (random 2)
(0 ;; generate a positive number
(random (min most-positive bound)))
(1 ;; generate a negative number
(- (random (min (- most-negative) bound)))))
type))))
(defun gen-character (&key (code-limit char-code-limit)
(code (gen-integer :min 0 :max (1- code-limit)))
(alphanumericp nil))
"Returns a generator of characters.
CODE must be a generator of random integers. ALPHANUMERICP, if
non-NIL, limits the returned chars to those which pass
alphanumericp."
(lambda ()
(loop
for count upfrom 0
for char = (code-char (funcall code))
until (and char
(or (not alphanumericp)
(alphanumericp char)))
when (= 1000 count)
do (error "After 1000 iterations ~S has still not generated ~:[a valid~;an alphanumeric~] character :(."
code alphanumericp)
finally (return char))))
(defun gen-string (&key (length (gen-integer :min 0 :max 80))
(elements (gen-character))
(element-type 'character))
"Returns a generator which producs random strings. LENGTH must
be a generator which producs integers, ELEMENTS must be a
generator which produces characters of type ELEMENT-TYPE."
(lambda ()
(loop
with length = (funcall length)
with string = (make-string length :element-type element-type)
for index below length
do (setf (aref string index) (funcall elements))
finally (return string))))
(defun gen-list (&key (length (gen-integer :min 0 :max 10))
(elements (gen-integer :min -10 :max 10)))
"Returns a generator which producs random lists. LENGTH must be
an integer generator and ELEMENTS must be a generator which
producs objects."
(lambda ()
(loop
repeat (funcall length)
collect (funcall elements))))
(defun gen-tree (&key (size 20)
(elements (gen-integer :min -10 :max 10)))
"Returns a generator which producs random trees. SIZE control
the approximate size of the tree, but don't try anything above
30, you have been warned. ELEMENTS must be a generator which
will produce the elements."
(labels ((rec (&optional (current-depth 0))
(let ((key (random (+ 3 (- size current-depth)))))
(cond ((> key 2)
(list (rec (+ current-depth 1))
(rec (+ current-depth 1))))
(t (funcall elements))))))
(lambda ()
(rec))))
(defun gen-buffer (&key (length (gen-integer :min 0 :max 50))
(element-type '(unsigned-byte 8))
(elements (gen-integer :min 0 :max (1- (expt 2 8)))))
(lambda ()
(let ((buffer (make-array (funcall length) :element-type element-type)))
(map-into buffer elements))))
(defun gen-one-element (&rest elements)
(lambda ()
(nth (random (length elements)) elements)))
;;;; The trivial always-produce-the-same-thing generator is done using
;;;; cl:constantly.
|