Added gen-float

[fiveam.git] / src / random.lisp

diff --git a/src/random.lisp b/src/random.lisp
index 0f66f84..1a1392c 100644 (file)
--- 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
@@ -104,10 +104,10 @@ returning true. This second run limit prevents that.")
 (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.
@@ -117,31 +117,53 @@ returning true. This second run limit prevents that.")
      (lambda () ,@body)))
 
 (defgenerator gen-integer (&key (max (1+ most-positive-fixnum))
-                                (min (1+ most-negative-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-string (&key
-                   (length (gen-integer :min 0 :max 80))
-                   (elements (gen-character))
-                   (element-type 'character))
-  (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)))
-  (lambda ()
-    (loop
-       repeat (funcall length)
-       collect (funcall elements))))
+(defgenerator gen-float (&key bound (type 'short-float))
+  (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)))
+
+(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))))
+
+(defgenerator gen-string (&key (length (gen-integer :min 0 :max 80))
+                               (elements (gen-character))
+                               (element-type 'character))
+  (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)))
+
+(defgenerator gen-list (&key (length (gen-integer :min 0 :max 10))
+                             (elements (gen-integer :min -10 :max 10)))
+  (loop
+     repeat (funcall length)
+     collect (funcall elements)))
 
 ;;;; The trivial always-produce-the-same-thing generator is done using
 ;;;; cl:constantly.