X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Frandom.lisp;h=a1f16bb0fe929f10840e6459f2ea83db4675f4fc;hb=ff6eb7fc9763ef77df2336250d49c78780ab4676;hp=9f9de08d7ec0ad36710e210416d86657ee5559f9;hpb=9adc37ba6fbe512af2c83863e9f51461479678ed;p=fiveam.git diff --git a/src/random.lisp b/src/random.lisp index 9f9de08..a1f16bb 100644 --- a/src/random.lisp +++ b/src/random.lisp @@ -2,7 +2,7 @@ (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 @@ -14,6 +14,18 @@ ;;;; 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)) @@ -26,14 +38,17 @@ (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" @@ -48,7 +63,10 @@ :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 @@ -77,35 +95,79 @@ (: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 + (loop + for count upfrom 0 + for char = (code-char (funcall code)) + until (alphanumericp char) + when (= 1000 count) + do (error "After 1000 iterations ~S has still not generated an alphanumeric character :(." + code) + finally (return char)) + (code-char (funcall code))))) + +(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) @@ -114,9 +176,11 @@ 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)