src/random.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2
   3 (in-package :it.bese.fiveam)
   4
   5 ;;;; ** Random (QuickCheck-ish) testing
   6
   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.
  10
  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.
  16
  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).
  24
  25 ;;;; *** Public Interface to the Random Tester
  26
  27 (defparameter *num-trials* 100
  28   "Number of times we attempt to run the body of the FOR-ALL test.")
  29
  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
  33   guard conditions.
  34
  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.")
  38
  39 (defmacro for-all (bindings &body body)
  40   "Bind BINDINGS to random variables and execute BODY `*num-trials*` times.
  41
  42 BINDINGS::
  43
  44 A a list of binding forms, each element is a list of:
  45 +
  46     (BINDING VALUE &optional GUARD)
  47 +
  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
  54 value of any binding.
  55 +
  56 [NOTE]
  57 Generator forms, unlike guard forms, can not contain references to the
  58 bound variables.
  59
  60 BODY::
  61
  62 The code to run. Will be run `*NUM-TRIALS*` times (unless the `*MAX-TRIALS*` limit is reached).
  63
  64 Examples:
  65
  66 --------------------------------
  67 \(for-all ((a (gen-integer)))
  68   (is (integerp a)))
  69
  70 \(for-all ((a (gen-integer) (plusp a)))
  71   (is (integerp a))
  72   (is (plusp a)))
  73
  74 \(for-all ((less (gen-integer))
  75           (more (gen-integer) (< less more)))
  76   (is (<= less more)))
  77
  78 \(defun gen-two-integers ()
  79   (lambda ()
  80     (list (funcall (gen-integer))
  81           (funcall (gen-integer)))))
  82
  83 \(for-all (((a b) (gen-two-integers)))
  84   (is (integerp a))
  85   (is (integerp b)))
  86 --------------------------------
  87 "
  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)
  93             ,test-lambda-args
  94           (if (and ,@(delete-if #'null (mapcar #'third bindings)))
  95               (progn ,@body)
  96               (throw 'run-once
  97                 (list :guard-conditions-failed))))))))
  98
  99 ;;;; *** Implementation
 100
 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.
 104
 105 (defun perform-random-testing (generators body)
 106   (loop
 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)
 112                (zerop counter))
 113      do (let ((result (perform-random-testing/run-once generators body)))
 114           (ecase (first result)
 115             (:pass
 116              (decf counter)
 117              (decf total-counter)
 118              (setf run-at-least-once t))
 119             (:no-tests
 120              (add-result 'for-all-test-no-tests
 121                          :reason "No tests"
 122                          :random-state random-state)
 123              (return-from perform-random-testing nil))
 124             (:guard-conditions-failed
 125              (decf total-counter))
 126             (:fail
 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"))))
 137
 138 (defun perform-random-testing/run-once (generators body)
 139   (catch 'run-once
 140     (bind-run-state ((result-list '()))
 141       (let ((values (mapcar #'funcall generators)))
 142         (funcall body values)
 143         (cond
 144           ((null result-list)
 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))))))))
 150
 151 (defclass for-all-test-result ()
 152   ((random-state :initarg :random-state)))
 153
 154 (defclass for-all-test-passed (test-passed for-all-test-result)
 155   ())
 156
 157 (defclass for-all-test-failed (test-failure for-all-test-result)
 158   ((failure-values :initarg :failure-values)
 159    (result-list :initarg :result-list)))
 160
 161 (defgeneric for-all-test-failed-p (object)
 162   (:method ((object for-all-test-failed)) t)
 163   (:method ((object t)) nil))
 164
 165 (defmethod reason ((result for-all-test-failed))
 166   (format nil "Falsifiable with ~S" (slot-value result 'failure-values)))
 167
 168 (defclass for-all-test-no-tests (test-failure for-all-test-result)
 169   ())
 170
 171 (defclass for-all-test-never-run (test-failure for-all-test-result)
 172   ())
 173
 174 ;;;; *** Generators
 175
 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.
 179
 180 ;;;; We provide a set of built-in generators.
 181
 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."
 186   (lambda ()
 187     (+ min (random (1+ (- max min))))))
 188
 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)))
 195
 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)) )
 202
 203 (defun gen-float (&key bound (type 'short-float) min max)
 204   "Returns a generator which producs floats of type TYPE.
 205
 206 BOUND::
 207
 208 Constrains the results to be in the range (-BOUND, BOUND). Default
 209 value is the most-positive value of TYPE.
 210
 211 MIN and MAX::
 212
 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.
 220
 221 TYPE::
 222
 223 The type of the returned float. Defaults to `SHORT-FLOAT`. Effects the
 224 default values of BOUND, MIN and MAX.
 225
 226 [NOTE]
 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."
 232   (lambda ()
 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."))
 236       (if (or min max)
 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))))
 239             (setf min (or min 0)
 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))))
 244             (ecase (random 2)
 245               (0 ;; generate a positive number
 246                (rand max))
 247               (1 ;; generate a negative number NB: min is actually
 248                ;; positive. see the if statement above.
 249                (- (rand min)))))))))
 250
 251 (defun gen-character (&key (code-limit char-code-limit)
 252                            (code (gen-integer :min 0 :max (1- code-limit)))
 253                            (alphanumericp nil))
 254   "Returns a generator of characters.
 255
 256 CODE::
 257
 258 A generater for random integers.
 259
 260 CODE-LIMIT::
 261
 262 If set only characters whose code-char is below this value will be
 263 returned.
 264
 265 ALPHANUMERICP::
 266
 267 Limits the returned chars to those which pass alphanumericp.
 268 "
 269   (lambda ()
 270     (loop
 271        for count upfrom 0
 272        for char = (code-char (funcall code))
 273        until (and char
 274                   (or (not alphanumericp)
 275                       (alphanumericp char)))
 276        when (= 1000 count)
 277        do (error "After 1000 iterations ~S has still not generated ~:[a valid~;an alphanumeric~] character :(."
 278                  code alphanumericp)
 279        finally (return char))))
 280
 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.
 284
 285 LENGTH::
 286
 287 A random integer generator specifying how long to make the generated string.
 288
 289 ELEMENTS::
 290
 291 A random character generator which producs the characters in the
 292 string.
 293 "
 294   (gen-buffer :length length
 295               :element-type 'character
 296               :elements elements))
 297
 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.
 303
 304 LENGTH::
 305
 306 The length of the buffer to create (a random integer generator)
 307
 308 ELEMENT-TYPE::
 309
 310 The type of array to create.
 311
 312 ELEMENTS::
 313
 314 The random element generator.
 315 "
 316   (lambda ()
 317     (let ((buffer (make-array (funcall length) :element-type element-type)))
 318       (map-into buffer elements))))
 319
 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.
 323
 324 LENGTH::
 325
 326 As with GEN-STRING, a random integer generator specifying the length of the list to create.
 327
 328 ELEMENTS::
 329
 330 A random object generator.
 331 "
 332   (lambda ()
 333     (loop
 334        repeat (funcall length)
 335        collect (funcall elements))))
 336
 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)))))
 345                (cond ((> key 2)
 346                       (list (rec (+ current-depth 1))
 347                             (rec (+ current-depth 1))))
 348                      (t (funcall elements))))))
 349     (lambda ()
 350       (rec))))
 351
 352 (defun gen-one-element (&rest elements)
 353   "Produces one randomly selected element of ELEMENTS.
 354
 355 ELEMENTS::
 356
 357 A list of objects (note: objects, not generators) to choose from."
 358   (lambda ()
 359     (nth (random (length elements)) elements)))
 360
 361 ;;;; The trivial always-produce-the-same-thing generator is done using
 362 ;;;; cl:constantly.