-;; -*- lisp -*-
+;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
-(in-package :it.bese.FiveAM)
+(in-package :it.bese.fiveam)
;;;; ** Random (QuickCheck-ish) testing
;;;; 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.")
returning true. This second run limit prevents that.")
(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 test BODY *num-trials* times.
+
+BINDINGS is 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. NB: Generator forms, unlike guard forms, can not contain
+references to the boud variables.
+
+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)))
+
+ (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
(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)))
;;;; We provide a set of built-in generators.
(defun gen-integer (&key (max (1+ most-positive-fixnum))
- (min (1- most-negative-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 ()
(double-float most-positive-double-float)
(long-float most-positive-long-float)))
(bound (or bound (max most-positive (- most-negative)))))
- (coerce
+ (coerce
(ecase (random 2)
(0 ;; generate a positive number
(random (min most-positive bound)))
(- (random (min (- most-negative) bound)))))
type))))
-(defun gen-character (&key (code (gen-integer :min 0 :max (1- char-code-limit)))
+(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.
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)))))
+ (loop
+ 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))
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-buffer (&key (length (gen-integer :min 0 :max 50))
+ (element-type '(unsigned-byte 8))
+ (elements (gen-integer :min 0 :max (1- (expt 2 8)))))
+ (lambda ()
+ (let ((buffer (make-array (funcall length) :element-type element-type)))
+ (map-into buffer elements))))
+
+(defun gen-one-element (&rest elements)
+ (lambda ()
+ (nth (random (length elements)) elements)))
+
;;;; The trivial always-produce-the-same-thing generator is done using
;;;; cl:constantly.
projects / fiveam.git / blobdiff