-;; -*- lisp -*-
+;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
-(in-package :it.bese.FiveAM)
+(in-package :it.bese.fiveam)
-;;;; * Random (QuickCheck-ish) testing
+;;;; ** Random (QuickCheck-ish) testing
;;;; FiveAM provides the ability to automatically generate a
;;;; collection of random input data for a specific test and run 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 limit prevents that from happening.")
+
(defmacro for-all (bindings &body body)
- `(perform-random-testing
- (list ,@(mapcar #'second bindings))
- (lambda ,(mapcar #'first bindings)
- (if (and ,@(delete-if #'null (mapcar #'third bindings)))
- (progn ,@body)
- (throw 'run-once
- (list :guard-conditions-failed))))))
+ "Bind BINDINGS to random variables and execute BODY `*num-trials*` times.
+
+BINDINGS::
+
+A 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.
++
+\[NOTE]
+Generator forms, unlike guard forms, can not contain references to the
+bound variables.
+
+BODY::
+
+The code to run. Will be run `*NUM-TRIALS*` times (unless the `*MAX-TRIALS*` limit is reached).
+
+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)))
+
+\(defun gen-two-integers ()
+ (lambda ()
+ (list (funcall (gen-integer))
+ (funcall (gen-integer)))))
+
+\(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 = 1000
- with counter = 100
- until (zerop counter)
+ 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))
+ (decf total-counter)
+ (setf run-at-least-once t))
(:no-tests
(add-result 'for-all-test-no-tests
:reason "No tests"
:failure-values (second result)
:result-list (third result))
(return-from perform-random-testing nil))))
- finally (add-result 'for-all-test-passed)))
+ 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)))
- (apply body values)
+ (funcall body values)
(cond
((null result-list)
(throw 'run-once (list :no-tests)))
(: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)
())
-(defmethod reason ((result for-all-test-failed))
- (format nil "Falsafiable with ~S" (slot-value result 'failure-values)))
+(defclass for-all-test-never-run (test-failure for-all-test-result)
+ ())
-;;;; ** Generators.
+;;;; *** Generators
;;;; Since this is random testing we need some way of creating random
-;;;; data to feed to our code. Generators are regular functions whcih
+;;;; data to feed to our code. Generators are regular functions which
;;;; create this random data.
;;;; We provide a set of built-in generators.
-(defmacro defgenerator (name arguments &body body)
- `(defun ,name ,arguments
- (lambda () ,@body)))
+(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 type-most-negative (floating-point-type)
+ (ecase floating-point-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)))
+
+(defun type-most-positive (floating-point-type)
+ (ecase floating-point-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)) )
+
+(defun gen-float (&key bound (type 'short-float) min max)
+ "Returns a generator which producs floats of type TYPE.
+
+BOUND::
+
+Constrains the results to be in the range (-BOUND, BOUND). Default
+value is the most-positive value of TYPE.
+
+MIN and MAX::
+
+If supplied, cause the returned float to be within the floating point
+interval (MIN, MAX). It is the caller's responsibility to ensure that
+the range between MIN and MAX is less than the requested type's
+maximum interval. MIN defaults to 0.0 (when only MAX is supplied), MAX
+defaults to MOST-POSITIVE-<TYPE> (when only MIN is supplied). This
+peculiar calling convention is designed for the common case of
+generating positive values below a known limit.
-(defgenerator gen-integer (&key (max (1+ most-positive-fixnum))
- (min (1+ most-negative-fixnum)))
- (+ min (random (1+ (- max min)))))
+TYPE::
-(defgenerator gen-character (&key (code (gen-integer :min 0 :max (1- char-code-limit))))
- (code-char (funcall code)))
+The type of the returned float. Defaults to `SHORT-FLOAT`. Effects the
+default values of BOUND, MIN and MAX.
-(defun gen-string (&key
- (length (gen-integer :min 0 :max 80))
- (elements (gen-character))
- (element-type 'character))
+\[NOTE]
+Since GEN-FLOAT is built on CL:RANDOM the distribution of returned
+values will be continuous, not discrete. In other words: the values
+will be evenly distributed across the specified numeric range, the
+distribution of possible floating point values, when seen as a
+sequence of bits, will not be even."
+ (lambda ()
+ (flet ((rand (limit) (random (coerce limit type))))
+ (when (and bound (or min max))
+ (error "GET-FLOAT does not support specifying :BOUND and :MAX/:MIN."))
+ (if (or min max)
+ (handler-bind ((arithmetic-error (lambda (c)
+ (error "ERROR ~S occured when attempting to generate a random value between ~S and ~S." c min max))))
+ (setf min (or min 0)
+ max (or max (type-most-positive type)))
+ (+ min (rand (- max min))))
+ (let ((min (if bound bound (- (type-most-negative type))))
+ (max (if bound bound (type-most-positive type))))
+ (ecase (random 2)
+ (0 ;; generate a positive number
+ (rand max))
+ (1 ;; generate a negative number NB: min is actually
+ ;; positive. see the if statement above.
+ (- (rand min)))))))))
+
+(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::
+
+A generater for random integers.
+
+CODE-LIMIT::
+
+If set only characters whose code-char is below this value will be
+returned.
+
+ALPHANUMERICP::
+
+Limits the returned chars to those which pass alphanumericp.
+"
(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)))
+ 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)))
+ "Returns a generator which producs random strings of characters.
+
+LENGTH::
+
+A random integer generator specifying how long to make the generated string.
+
+ELEMENTS::
+
+A random character generator which producs the characters in the
+string.
+"
+ (gen-buffer :length length
+ :element-type 'character
+ :elements elements))
+
+(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)))))
+ "Generates a random vector, defaults to a random (unsigned-byte 8)
+vector with elements between 0 and 255.
+
+LENGTH::
+
+The length of the buffer to create (a random integer generator)
+
+ELEMENT-TYPE::
+
+The type of array to create.
+
+ELEMENTS::
+
+The random element generator.
+"
+ (lambda ()
+ (let ((buffer (make-array (funcall length) :element-type element-type)))
+ (map-into buffer elements))))
+
+(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::
+
+As with GEN-STRING, a random integer generator specifying the length of the list to create.
+
+ELEMENTS::
+
+A random object generator.
+"
(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-one-element (&rest elements)
+ "Produces one randomly selected element of ELEMENTS.
+
+ELEMENTS::
+
+A list of objects (note: objects, not generators) to choose from."
+ (lambda ()
+ (nth (random (length elements)) elements)))
+
;;;; The trivial always-produce-the-same-thing generator is done using
;;;; cl:constantly.