diff --git a/lib/srfi/27/rand.c b/lib/srfi/27/rand.c index 9d0f448f..e7125323 100644 --- a/lib/srfi/27/rand.c +++ b/lib/srfi/27/rand.c @@ -55,12 +55,12 @@ typedef unsigned int sexp_random_t; sexp sexp_rs_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp bound) { sexp_gc_var1(res); - int64_t m; + int i; + sexp_uint_t m; sexp_int32_t m2; #if SEXP_USE_BIGNUMS - /* sexp_uint_t mod; */ - sexp_uint32_t *data; - sexp_int32_t hi, len, i; + sexp_uint_t *data; + int hi, j; #endif if (!sexp_random_source_p(self, rs)) return sexp_type_exception(ctx, self, sexp_unbox_fixnum(sexp_opcode_arg1_type(self)), rs); @@ -69,7 +69,7 @@ sexp sexp_rs_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp b res = sexp_xtype_exception(ctx, self, "random bound must be positive", bound); } else { /* ensure we have sufficient bits */ - for (i=m=0; i <= 1<<(CHAR_BIT*sizeof(m))/RAND_MAX; ++i) { + for (i=m=0; i-1 <= 1<<(CHAR_BIT*sizeof(m))/RAND_MAX; ++i) { sexp_call_random(rs, m2); m = m * RAND_MAX + m2; } @@ -79,12 +79,15 @@ sexp sexp_rs_random_integer (sexp ctx, sexp self, sexp_sint_t n, sexp rs, sexp b } else if (sexp_bignump(bound)) { sexp_gc_preserve1(ctx, res); hi = sexp_bignum_hi(bound); - len = hi * (sizeof(sexp_uint_t) / sizeof(sexp_int32_t)); - res = sexp_make_bignum(ctx, hi + 1); - data = (sexp_uint32_t*) sexp_bignum_data(res); - for (i=0; i p alpha))) (define (run-tests) (define (test-random rand n) (test-assert (<= 0 (rand n) (- n 1)))) (test-begin "srfi-27: random") + + ;; sanity checks + (test 0 (random-integer 1)) + (test-assert (<= 0 (random-integer 2) 1)) + (test-error (random-integer 0)) + (test-error (random-integer -1)) + (let ((rs (make-random-source))) ;; chosen by fair dice roll. guaranteed to be random (random-source-pseudo-randomize! rs 4 4) @@ -22,9 +73,42 @@ ;; resetting the state (test-not (= x (rand 1000000))) (random-source-state-set! rs state) - ;; (test x (rand 1000000)) - )) - (test 0 (random-integer 1)) - (test-error (random-integer 0)) - (test-error (random-integer -1))) + ;; (test x (rand 1000000)) ;; actually impl defined + ))) + + ;; Distribution Checks. + ;; Since we fall back on the libc rand, we can't test the exact + ;; result even for a given seed, so we run some conservative + ;; statistical tests. + (test-assert + (histogram-uniform? (random-histogram 2 1000))) ; coin + (test-assert + (histogram-uniform? (random-histogram 6 10000))) ; die + (test-assert + (histogram-uniform? (random-histogram 27 10000 27))) ; small prime + ;; boundaries + (test-assert + (histogram-uniform? (random-histogram (expt 2 31) 10000))) + (test-assert + (histogram-uniform? (random-histogram (expt 2 32) 10000))) + (test-assert + (histogram-uniform? (random-histogram (- (expt 2 62) 1) 10000))) + ;; bignums + (test-assert + (histogram-uniform? (random-histogram (expt 2 62) 10000))) + (test-assert + (histogram-uniform? (random-histogram (expt 2 63) 10000))) + (test-assert + (histogram-uniform? (random-histogram (expt 2 63) 10000 100))) + (test-assert + (histogram-uniform? (random-histogram (- (expt 2 64) 1) 10000))) + (test-assert + (histogram-uniform? (random-histogram (expt 2 64) 10000))) + (test-assert + (histogram-uniform? (random-histogram (+ (expt 2 64) 1) 10000))) + (test-assert + (histogram-uniform? (random-histogram (expt 2 65) 10000))) + (test-assert + (histogram-uniform? (random-histogram (expt 2 164) 10000))) + (test-end))))