src/random.lisp

   1 ;; -*- lisp -*-
   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 (defparameter *num-trials* 100
  18   "Number of times we attempt to run the body of the FOR-ALL test.")
  19
  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
  23   guard conditions.
  24
  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.")
  28
  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)))
  34           (progn ,@body)
  35           (throw 'run-once
  36             (list :guard-conditions-failed))))))
  37
  38 (defun perform-random-testing (generators body)
  39   (loop
  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)
  45                (zerop counter))
  46      do (let ((result (perform-random-testing/run-once generators body)))
  47           (ecase (first result)
  48             (:pass
  49              (decf counter)
  50              (decf total-counter)
  51              (setf run-at-least-once t))
  52             (:no-tests
  53              (add-result 'for-all-test-no-tests
  54                          :reason "No tests"
  55                          :random-state random-state)
  56              (return-from perform-random-testing nil))
  57             (:guard-conditions-failed
  58              (decf total-counter))
  59             (:fail
  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"))))
  70
  71 (defun perform-random-testing/run-once (generators body)
  72   (catch 'run-once
  73     (bind-run-state ((result-list '()))
  74       (let ((values (mapcar #'funcall generators)))
  75         (apply body values)
  76         (cond
  77           ((null result-list)
  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))))))))
  83
  84 (defclass for-all-test-result ()
  85   ((random-state :initarg :random-state)))
  86
  87 (defclass for-all-test-passed (test-passed for-all-test-result)
  88   ())
  89
  90 (defclass for-all-test-failed (test-failure for-all-test-result)
  91   ((failure-values :initarg :failure-values)
  92    (result-list :initarg :result-list)))
  93
  94 (defgeneric for-all-test-failed-p (object)
  95   (:method ((object for-all-test-failed)) t)
  96   (:method ((object t)) nil))
  97
  98 (defmethod reason ((result for-all-test-failed))
  99   (format nil "Falsafiable with ~S" (slot-value result 'failure-values)))
 100
 101 (defclass for-all-test-no-tests (test-failure for-all-test-result)
 102   ())
 103
 104 (defclass for-all-test-never-run (test-failure for-all-test-result)
 105   ())
 106
 107 ;;;; *** Generators
 108
 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.
 112
 113 ;;;; We provide a set of built-in generators.
 114
 115 (defmacro defgenerator (name arguments &body body)
 116   `(defun ,name ,arguments
 117      (lambda () ,@body)))
 118
 119 (defgenerator gen-integer (&key (max (1+ most-positive-fixnum))
 120                                 (min (1- most-negative-fixnum)))
 121   (+ min (random (1+ (- max min)))))
 122
 123 (defgenerator gen-character (&key (code (gen-integer :min 0 :max (1- char-code-limit)))
 124                                   (alphanumericp nil))
 125   (if alphanumericp
 126       (code-char (funcall code))
 127       (loop
 128          for char = (code-char (funcall code))
 129          until (alphanumericp char)
 130          finally (return char))))
 131
 132 (defgenerator gen-string (&key (length (gen-integer :min 0 :max 80))
 133                                (elements (gen-character))
 134                                (element-type 'character))
 135   (loop
 136      with length = (funcall length)
 137      with string = (make-string length :element-type element-type)
 138      for index below length
 139      do (setf (aref string index) (funcall elements))
 140      finally (return string)))
 141
 142 (defgenerator gen-list (&key (length (gen-integer :min 0 :max 10))
 143                              (elements (gen-integer :min -10 :max 10)))
 144   (loop
 145      repeat (funcall length)
 146      collect (funcall elements)))
 147
 148 ;;;; The trivial always-produce-the-same-thing generator is done using
 149 ;;;; cl:constantly.