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