1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
;;; -*- mode: scheme; coding: utf-8; -*-
;;;
;;; Copyright (C) 2010 Free Software Foundation, Inc.
;;; Copyright (C) 2002 Sebastian Egner
;;;
;;; This code is based on the file conftest.scm in the reference
;;; implementation of SRFI-27, provided under the following license:
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining
;;; a copy of this software and associated documentation files (the
;;; "Software"), to deal in the Software without restriction, including
;;; without limitation the rights to use, copy, modify, merge, publish,
;;; distribute, sublicense, and/or sell copies of the Software, and to
;;; permit persons to whom the Software is furnished to do so, subject to
;;; the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be
;;; included in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
;;; BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
;;; ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
;;; CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;;; SOFTWARE.
(define-module (test-srfi-27)
#:use-module (test-suite lib)
#:use-module (srfi srfi-27))
(with-test-prefix "large integers"
(pass-if "in range"
(let loop ((k 0) (n 1))
(cond ((> k 1024)
#t)
((<= 0 (random-integer n) (- n 1))
(loop (+ k 1) (* n 2)))
(else
#f)))))
(with-test-prefix "reals"
(pass-if "in range"
(let loop ((k 0) (n 1))
(if (> k 1000)
#t
(let ((x (random-real)))
(if (< 0 x 1)
(loop (+ k 1) (* n 2))
#f))))))
(with-test-prefix "get/set state"
(let* ((state1 (random-source-state-ref default-random-source))
(x1 (random-integer (expt 2 32)))
(state2 (random-source-state-ref default-random-source))
(x2 (random-integer (expt 2 32))))
(random-source-state-set! default-random-source state1)
(pass-if "state1"
(= x1 (random-integer (expt 2 32))))
(random-source-state-set! default-random-source state2)
(pass-if "state2"
(= x2 (random-integer (expt 2 32))))))
;; These tests throw 'unresolved instead of failing since it /could/
;; happen that `random-source-randomize!' (or
;; `random-source-pseudo-randomize!') puts the RNG into a state where
;; it generates the same number as before. They should have a very high
;; chance of passing, though.
(with-test-prefix "randomize!"
(let* ((state1 (random-source-state-ref default-random-source))
(x1 (random-integer (expt 2 32))))
(random-source-state-set! default-random-source state1)
(random-source-randomize! default-random-source)
(if (= x1 (random-integer (expt 2 32)))
(throw 'unresolved))))
(with-test-prefix "pseudo-randomize!"
(let* ((state1 (random-source-state-ref default-random-source))
(x1 (random-integer (expt 2 32))))
(random-source-state-set! default-random-source state1)
(random-source-pseudo-randomize! default-random-source 0 1)
(let ((y1 (random-integer (expt 2 32))))
(if (= x1 y1)
(throw 'unresolved)))
(random-source-state-set! default-random-source state1)
(random-source-pseudo-randomize! default-random-source 1 0)
(let ((y1 (random-integer (expt 2 32))))
(if (= x1 y1)
(throw 'unresolved)))))
|
