X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Frandom.lisp;h=6b2059abdc0424299bb047120dd86cae571b0b42;hb=b76fc6a27dc451c7f2f88eb9a1f028228530af6c;hp=bb4ba9eaadcc21d54ec5330c51b221634202c137;hpb=f7d91555fd68221917e4323a1f4409011a6084f6;p=fiveam.git diff --git a/src/random.lisp b/src/random.lisp index bb4ba9e..6b2059a 100644 --- a/src/random.lisp +++ b/src/random.lisp @@ -1,6 +1,6 @@ -;; -*- lisp -*- +;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*- -(in-package :it.bese.FiveAM) +(in-package :it.bese.fiveam) ;;;; ** Random (QuickCheck-ish) testing @@ -14,6 +14,16 @@ ;;;; 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.") @@ -27,13 +37,51 @@ 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)) - (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 @@ -72,7 +120,7 @@ returning true. This second run limit prevents that.") (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))) @@ -96,7 +144,7 @@ returning true. This second run limit prevents that.") (:method ((object t)) nil)) (defmethod reason ((result for-all-test-failed)) - (format nil "Falsafiable with ~S" (slot-value result 'failure-values))) + (format nil "Falsifiable with ~S" (slot-value result 'failure-values))) (defclass for-all-test-no-tests (test-failure for-all-test-result) ()) @@ -107,32 +155,68 @@ returning true. This second run limit prevents that.") ;;;; *** 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))) - (alphanumericp nil)) - (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)) +(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-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-limit char-code-limit) + (code (gen-integer :min 0 :max (1- 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 () + (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)) + (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) @@ -141,13 +225,41 @@ returning true. This second run limit prevents that.") 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) 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.