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 (defmacro for-all (bindings &body body)
  18   `(perform-random-testing
  19     (list ,@(mapcar #'second bindings))
  20     (lambda ,(mapcar #'first bindings)
  21       (if (and ,@(delete-if #'null (mapcar #'third bindings)))
  22           (progn ,@body)
  23           (throw 'run-once
  24             (list :guard-conditions-failed))))))
  25
  26 (defun perform-random-testing (generators body)
  27   (loop
  28      with random-state = *random-state*
  29      with total-counter = 1000
  30      with counter = 100
  31      until (zerop counter)
  32      do (let ((result (perform-random-testing/run-once generators body)))
  33           (ecase (first result)
  34             (:pass
  35              (decf counter)
  36              (decf total-counter))
  37             (:no-tests
  38              (add-result 'for-all-test-no-tests
  39                          :reason "No tests"
  40                          :random-state random-state)
  41              (return-from perform-random-testing nil))
  42             (:guard-conditions-failed
  43              (decf total-counter))
  44             (:fail
  45              (add-result 'for-all-test-failed
  46                          :reason "Found failing test data"
  47                          :random-state random-state
  48                          :failure-values (second result)
  49                          :result-list (third result))
  50              (return-from perform-random-testing nil))))
  51      finally (add-result 'for-all-test-passed)))
  52
  53 (defun perform-random-testing/run-once (generators body)
  54   (catch 'run-once
  55     (bind-run-state ((result-list '()))
  56       (let ((values (mapcar #'funcall generators)))
  57         (apply body values)
  58         (cond
  59           ((null result-list)
  60            (throw 'run-once (list :no-tests)))
  61           ((every #'test-passed-p result-list)
  62            (throw 'run-once (list :pass)))
  63           ((notevery #'test-passed-p result-list)
  64            (throw 'run-once (list :fail values result-list))))))))
  65
  66 (defclass for-all-test-result ()
  67   ((random-state :initarg :random-state)))
  68
  69 (defclass for-all-test-passed (test-passed for-all-test-result)
  70   ())
  71
  72 (defclass for-all-test-failed (test-failure for-all-test-result)
  73   ((failure-values :initarg :failure-values)
  74    (result-list :initarg :result-list)))
  75
  76 (defgeneric for-all-test-failed-p (object)
  77   (:method ((object for-all-test-failed)) t)
  78   (:method ((object t)) nil))
  79
  80 (defclass for-all-test-no-tests (test-failure for-all-test-result)
  81   ())
  82
  83 (defmethod reason ((result for-all-test-failed))
  84   (format nil "Falsafiable with ~S" (slot-value result 'failure-values)))
  85
  86 ;;;; ** Generators.
  87
  88 ;;;; Since this is random testing we need some way of creating random
  89 ;;;; data to feed to our code. Generators are regular functions whcih
  90 ;;;; create this random data.
  91
  92 ;;;; We provide a set of built-in generators.
  93
  94 (defmacro defgenerator (name arguments &body body)
  95   `(defun ,name ,arguments
  96      (lambda () ,@body)))
  97
  98 (defgenerator gen-integer (&key (max (1+ most-positive-fixnum))
  99                                 (min (1+ most-negative-fixnum)))
 100   (+ min (random (1+ (- max min)))))
 101
 102 (defgenerator gen-character (&key (code (gen-integer :min 0 :max (1- char-code-limit))))
 103   (code-char (funcall code)))
 104
 105 (defun gen-string (&key
 106                    (length (gen-integer :min 0 :max 80))
 107                    (elements (gen-character))
 108                    (element-type 'character))
 109   (lambda ()
 110     (loop
 111        with length = (funcall length)
 112        with string = (make-string length :element-type element-type)
 113        for index below length
 114        do (setf (aref string index) (funcall elements))
 115        finally (return string))))
 116
 117 (defun gen-list (&key
 118                  (length (gen-integer :min 0 :max 10))
 119                  (elements (gen-integer :min -10 :max 10)))
 120   (lambda ()
 121     (loop
 122        repeat (funcall length)
 123        collect (funcall elements))))
 124
 125 ;;;; The trivial always-produce-the-same-thing generator is done using
 126 ;;;; cl:constantly.