X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Frandom.lisp;h=615e9ea8e4abae9b25189c6328b82dc798488c2d;hb=1b24abf09e9fbb2a23c25a9583e5547514482f1b;hp=1052f3527a95614e56015ed411b60f0f546a5bab;hpb=3074223314aa4655a09fb0654c83563782e6e7d2;p=fiveam.git diff --git a/src/random.lisp b/src/random.lisp index 1052f35..615e9ea 100644 --- a/src/random.lisp +++ b/src/random.lisp @@ -77,7 +77,7 @@ Examples: (throw 'run-once (list :guard-conditions-failed)))))))) -;;;; *** Implementation +;;;; *** Implementation ;;;; We could just make FOR-ALL a monster macro, but having FOR-ALL be ;;;; a preproccessor for the perform-random-testing function is @@ -183,7 +183,7 @@ BOUND)." (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))) @@ -200,16 +200,16 @@ 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))))) + (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)) @@ -242,7 +242,7 @@ 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 (- depth current-depth))))) + (let ((key (random (+ 3 (- size current-depth))))) (cond ((> key 2) (list (rec (+ current-depth 1)) (rec (+ current-depth 1))))