srfi-27.test 3.6 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192
  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. (define-module (test-srfi-27)
  29. #:use-module (test-suite lib)
  30. #:use-module (srfi srfi-27))
  31. (with-test-prefix "large integers"
  32. (pass-if "in range"
  33. (let loop ((k 0) (n 1))
  34. (cond ((> k 1024)
  35. #t)
  36. ((<= 0 (random-integer n) (- n 1))
  37. (loop (+ k 1) (* n 2)))
  38. (else
  39. #f)))))
  40. (with-test-prefix "reals"
  41. (pass-if "in range"
  42. (let loop ((k 0) (n 1))
  43. (if (> k 1000)
  44. #t
  45. (let ((x (random-real)))
  46. (if (< 0 x 1)
  47. (loop (+ k 1) (* n 2))
  48. #f))))))
  49. (with-test-prefix "get/set state"
  50. (let* ((state1 (random-source-state-ref default-random-source))
  51. (x1 (random-integer (expt 2 32)))
  52. (state2 (random-source-state-ref default-random-source))
  53. (x2 (random-integer (expt 2 32))))
  54. (random-source-state-set! default-random-source state1)
  55. (pass-if "state1"
  56. (= x1 (random-integer (expt 2 32))))
  57. (random-source-state-set! default-random-source state2)
  58. (pass-if "state2"
  59. (= x2 (random-integer (expt 2 32))))))
  60. ;; These tests throw 'unresolved instead of failing since it /could/
  61. ;; happen that `random-source-randomize!' (or
  62. ;; `random-source-pseudo-randomize!') puts the RNG into a state where
  63. ;; it generates the same number as before. They should have a very high
  64. ;; chance of passing, though.
  65. (with-test-prefix "randomize!"
  66. (let* ((state1 (random-source-state-ref default-random-source))
  67. (x1 (random-integer (expt 2 32))))
  68. (random-source-state-set! default-random-source state1)
  69. (random-source-randomize! default-random-source)
  70. (if (= x1 (random-integer (expt 2 32)))
  71. (throw 'unresolved))))
  72. (with-test-prefix "pseudo-randomize!"
  73. (let* ((state1 (random-source-state-ref default-random-source))
  74. (x1 (random-integer (expt 2 32))))
  75. (random-source-state-set! default-random-source state1)
  76. (random-source-pseudo-randomize! default-random-source 0 1)
  77. (let ((y1 (random-integer (expt 2 32))))
  78. (if (= x1 y1)
  79. (throw 'unresolved)))
  80. (random-source-state-set! default-random-source state1)
  81. (random-source-pseudo-randomize! default-random-source 1 0)
  82. (let ((y1 (random-integer (expt 2 32))))
  83. (if (= x1 y1)
  84. (throw 'unresolved)))))