1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192 |
- ;;; -*- 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)))))
|