mirror of
git://git.code.sf.net/p/sbcl/sbcl
synced 2026-09-10 07:26:40 -04:00
fd71558d0d
Also: - Put a comment and assertion back the way I meant it (Messed it up due to merge conflict) - Skip/ignore some unimportant tests
191 lines
8.8 KiB
Common Lisp
191 lines
8.8 KiB
Common Lisp
;;;; various RANDOM tests without side effects
|
|
|
|
;;;; This software is part of the SBCL system. See the README file for
|
|
;;;; more information.
|
|
;;;;
|
|
;;;; While most of SBCL is derived from the CMU CL system, the test
|
|
;;;; files (like this one) were written from scratch after the fork
|
|
;;;; from CMU CL.
|
|
;;;;
|
|
;;;; This software is in the public domain and is provided with
|
|
;;;; absolutely no warranty. See the COPYING and CREDITS files for
|
|
;;;; more information.
|
|
|
|
(enable-test-parallelism)
|
|
|
|
;;; Tests in this file that rely on properties of the distribution of
|
|
;;; the random numbers are designed to be fast and have a very low
|
|
;;; probability of false positives, generally of the order of (expt 10 -60).
|
|
;;; These tests are not intended to assure the statistical qualities of the
|
|
;;; pseudo random number generator but to help find bugs in its and RANDOM's
|
|
;;; implementation.
|
|
|
|
;; When the type of the argument of RANDOM is a set of integers, a
|
|
;; DEFTRANSFORM triggered that simply generated (REM (RANDOM-CHUNK) NUM),
|
|
;; which has two severe problems: The resulting distribution is very uneven
|
|
;; for most arguments of RANDOM near the size of a random chunk and the
|
|
;; RANDOM-CHUNK used was always 32 bits, even under 64 bit wordsize which
|
|
;; yields even more disastrous distributions.
|
|
(with-test (:name (random integer :set-of-integers :distribution))
|
|
(let* ((high (floor (expt 2 33) 3))
|
|
(mid (floor high 2))
|
|
(fun (checked-compile `(lambda (x)
|
|
(random (if x ,high 10)))))
|
|
(n1 0)
|
|
(n 10000))
|
|
(dotimes (i n)
|
|
(when (>= (funcall fun t) mid)
|
|
(incf n1)))
|
|
;; Half of the values of (RANDOM HIGH) should be >= MID, so we expect
|
|
;; N1 to be binomially distributed such that this distribution can be
|
|
;; approximated by a normal distribution with mean (/ N 2) and standard
|
|
;; deviation (* (sqrt N) 1/2). The broken RANDOM we are testing here for
|
|
;; yields (/ N 3) and (* (sqrt N) (sqrt 2/9)), respectively. We test if
|
|
;; N1 is below the average of (/ N 3) and (/ N 2). With a value of N of
|
|
;; 10000 this is more than 16 standard deviations away from the expected
|
|
;; mean, which has a probability of occurring by chance of below
|
|
;; (expt 10 -60).
|
|
(when (< n1 (* n 5/12))
|
|
(error "bad RANDOM distribution: expected ~d, got ~d" (/ n 2) n1))))
|
|
|
|
(with-test (:name (random integer :set-of-integers :chunk-size))
|
|
(let* ((high (expt 2 64))
|
|
(fun (checked-compile `(lambda (x)
|
|
(random (if x ,high 10)))))
|
|
(n 200)
|
|
(x 0))
|
|
(dotimes (i n)
|
|
(setf x (logior x (funcall fun t))))
|
|
;; If RANDOM works correctly, x should be #b111...111 (64 ones)
|
|
;; with a probability of 1 minus approximately (expt 2 -194).
|
|
(unless (= x (1- high))
|
|
(error "bad RANDOM distribution: ~16,16,'0r" x))))
|
|
|
|
;;; Some tests for basic integer RANDOM functionality.
|
|
|
|
(with-test (:name (random integer :error-if-invalid-random-state))
|
|
(map-optimize-declarations
|
|
(lambda (optimize)
|
|
(dolist (expr `((lambda (x state)
|
|
(declare (optimize ,@optimize))
|
|
(random x state))
|
|
(lambda (x state)
|
|
(declare (optimize ,@optimize))
|
|
(declare (type integer x))
|
|
(random x state))
|
|
(lambda (x state)
|
|
(declare (optimize ,@optimize))
|
|
(declare (type (integer 100 200) x))
|
|
(random x state))
|
|
(lambda (x state)
|
|
(declare (optimize ,@optimize))
|
|
(random (if x 10 20) state))))
|
|
(let ((fun (checked-compile expr)))
|
|
(assert-error (funcall fun 150 nil) type-error))))
|
|
:speed '(0 3) :safety nil :space '(nil 0) :compilation-speed '(0 3)))
|
|
|
|
(with-test (:name (random integer :distribution))
|
|
(let ((generic-random (checked-compile '(lambda (x)
|
|
(random x)))))
|
|
;; Check powers of two: Every bit in the output should be sometimes
|
|
;; 0, sometimes 1.
|
|
(dotimes (e 200)
|
|
(let* ((number (expt 2 e))
|
|
(foo (lambda ()
|
|
(funcall generic-random number)))
|
|
(bar (checked-compile `(lambda ()
|
|
(declare (optimize speed))
|
|
(random ,number)))))
|
|
(flet ((test (fun)
|
|
(let ((x-and (funcall fun))
|
|
(x-ior (funcall fun)))
|
|
(dotimes (i 199)
|
|
(setf x-and (logand x-and (funcall fun))
|
|
x-ior (logior x-ior (funcall fun))))
|
|
(assert (= x-and 0))
|
|
(assert (= x-ior (1- number))))))
|
|
(test foo)
|
|
(test bar))))
|
|
;; Test a collection of fixnums and bignums, powers of two and
|
|
;; numbers just below and above powers of two, numbers needing one,
|
|
;; two or more random chunks etc.
|
|
(dolist (number (remove-duplicates
|
|
`(,@(loop for i from 2 to 11 collect i)
|
|
,@(loop for i in '(29 30 31 32 33 60 61 62 63 64 65)
|
|
nconc (list (1- (expt 2 i))
|
|
(expt 2 i)
|
|
(1+ (expt 2 i))))
|
|
,@(loop for i from (1- sb-kernel::n-random-chunk-bits)
|
|
to (* sb-kernel::n-random-chunk-bits 4)
|
|
collect (* 3 (expt 2 i)))
|
|
,@(loop for i from 2 to sb-vm:n-word-bits
|
|
for n = (expt 16 i)
|
|
for r = (+ n (random n))
|
|
collect r))))
|
|
(let ((foo (lambda ()
|
|
(funcall generic-random number)))
|
|
(bar (checked-compile `(lambda ()
|
|
(declare (optimize speed))
|
|
(random ,number)))))
|
|
(flet ((test (fun)
|
|
(let* ((min (funcall fun))
|
|
(max min))
|
|
(dotimes (i 9999)
|
|
(let ((r (funcall fun)))
|
|
(when (< r min)
|
|
(setf min r))
|
|
(when (> r max)
|
|
(setf max r))))
|
|
;; With 10000 trials and an argument of RANDOM below
|
|
;; 70 the probability of the minimum not being 0 is
|
|
;; less than (expt 10 -60), so we can test for that;
|
|
;; correspondingly with the maximum. For larger
|
|
;; arguments we can only test that all results are
|
|
;; in range.
|
|
(if (< number 70)
|
|
(progn
|
|
(assert (= min 0))
|
|
(assert (= max (1- number))))
|
|
(progn
|
|
(assert (>= min 0))
|
|
(assert (< max number)))))))
|
|
(test foo)
|
|
(test bar))))))
|
|
|
|
;;; RANDOM with a float argument used to produce that argument as a
|
|
;;; return value with a probability depending on the magnitude of the
|
|
;;; argument. That behavior was wrong since the argument is an
|
|
;;; /exclusive/ upper bound for the range of produced values. The
|
|
;;; cases below increase the failure possibility as much as possible:
|
|
;;; an exclusive upper bound of LEAST-POSITIVE-*-FLOAT means that the
|
|
;;; respective 0 is the only valid return value and that the old code
|
|
;;; produced a wrong answer with probably 0.5 (assuming proper
|
|
;;; distribution of the produced values).
|
|
(with-test (:name (random float :upper-bound-exclusive))
|
|
;; SINGLE-FLOAT, possibly inlined
|
|
(let ((values (loop :repeat 10000
|
|
:collect (random least-positive-single-float))))
|
|
(assert (not (find 0.0f0 values :test-not #'=))))
|
|
;; DOUBLE-FLOAT, possibly inlined
|
|
(let ((values (loop :repeat 10000
|
|
:collect (random least-positive-double-float))))
|
|
(assert (not (find 0.0d0 values :test-not #'=))))
|
|
(locally (declare (notinline random))
|
|
;; SINGLE-FLOAT, not inlined
|
|
(let ((values (loop :repeat 10000
|
|
:collect (random least-positive-single-float))))
|
|
(assert (not (find 0.0f0 values :test-not #'=))))
|
|
;; DOUBLE-FLOAT, not inlined
|
|
(let ((values (loop :repeat 10000
|
|
:collect (random least-positive-double-float))))
|
|
(assert (not (find 0.0d0 values :test-not #'=))))))
|
|
|
|
(with-test (:name :float-no-consing
|
|
:fails-on (or :mips :ppc)
|
|
:skipped-on :interpreter)
|
|
(let ((fun (checked-compile `(lambda ()
|
|
(declare (optimize speed))
|
|
(> (random 40d0) 1d0))
|
|
:allow-notes nil)))
|
|
(ctu:assert-no-consing (funcall fun))))
|