;;;; random.test --- tests guile's uniform arrays -*- scheme -*- ;;;; ;;;; Copyright 2013 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public ;;;; License as published by the Free Software Foundation; either ;;;; version 3 of the License, or (at your option) any later version. ;;;; ;;;; This library is distributed in the hope that it will be useful, ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;;;; Lesser General Public License for more details. ;;;; ;;;; You should have received a copy of the GNU Lesser General Public ;;;; License along with this library; if not, write to the Free Software ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA (define-module (test-suite test-random) #:use-module ((system base compile) #:select (compile)) #:use-module (test-suite lib) #:use-module (srfi srfi-4) #:use-module (srfi srfi-4 gnu)) ; see strings.test, arrays.test. (define exception:wrong-type-arg (cons #t "Wrong type")) ;;; ;;; random:normal-vector! ;;; (with-test-prefix "random:normal-vector!" ;; FIXME need proper function test. (pass-if "non uniform" (let ((a (make-vector 4 0)) (b (make-vector 4 0)) (c (make-shared-array (make-vector 8 0) (lambda (i) (list (+ 1 (* 2 i)))) 4))) (begin (random:normal-vector! b (random-state-from-platform)) (random:normal-vector! c (random-state-from-platform)) (and (not (equal? a b)) (not (equal? a c)))))) (pass-if "uniform (f64)" (let ((a (make-f64vector 4 0)) (b (make-f64vector 4 0)) (c (make-shared-array (make-f64vector 8 0) (lambda (i) (list (+ 1 (* 2 i)))) 4))) (begin (random:normal-vector! b (random-state-from-platform)) (random:normal-vector! c (random-state-from-platform)) (and (not (equal? a b)) (not (equal? a c)))))))