(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.
+(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)
`(perform-random-testing
(list ,@(mapcar #'second bindings))
(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
(:method ((object for-all-test-failed)) t)
(:method ((object t)) nil))
+(defmethod reason ((result for-all-test-failed))
+ (format nil "Falsafiable 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)))
-
-(defgenerator gen-integer (&key (max (1+ most-positive-fixnum))
- (min (1+ most-negative-fixnum)))
- (+ min (random (1+ (- max min)))))
-
-(defgenerator gen-character (&key (code (gen-integer :min 0 :max (1- char-code-limit))))
- (code-char (funcall code)))
+(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-string (&key
- (length (gen-integer :min 0 :max 80))
- (elements (gen-character))
- (element-type 'character))
+(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 (gen-integer :min 0 :max (1- char-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 ()
+ (if alphanumericp
+ (code-char (funcall code))
+ (loop
+ for char = (code-char (funcall code))
+ until (alphanumericp char)
+ 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)
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)))
+(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)