[functional-tests] start a (generators) library
This commit is contained in:
parent
0730016cc2
commit
a7d0e687e8
18
functional-tests/generators.scm
Normal file
18
functional-tests/generators.scm
Normal file
@ -0,0 +1,18 @@
|
|||||||
|
(library
|
||||||
|
(generators)
|
||||||
|
|
||||||
|
(export make-const-generator
|
||||||
|
make-uniform-generator)
|
||||||
|
|
||||||
|
(import (rnrs)
|
||||||
|
(srfi s27 random-bits))
|
||||||
|
|
||||||
|
(define (make-const-generator n)
|
||||||
|
(lambda () n))
|
||||||
|
|
||||||
|
(define (make-uniform-generator low hi)
|
||||||
|
(assert (<= low hi))
|
||||||
|
|
||||||
|
(let ((range (- hi low)))
|
||||||
|
(lambda ()
|
||||||
|
(+ low (random-integer range))))))
|
@ -3,23 +3,12 @@
|
|||||||
(export generate-xml)
|
(export generate-xml)
|
||||||
(import (rnrs)
|
(import (rnrs)
|
||||||
(list-utils)
|
(list-utils)
|
||||||
|
(generators)
|
||||||
(xml)
|
(xml)
|
||||||
(fmt fmt)
|
(fmt fmt)
|
||||||
(only (srfi s1 lists) iota)
|
(only (srfi s1 lists) iota)
|
||||||
(srfi s27 random-bits))
|
(srfi s27 random-bits))
|
||||||
|
|
||||||
;;;----------------------------------------
|
|
||||||
|
|
||||||
(define (make-const-generator n)
|
|
||||||
(lambda () n))
|
|
||||||
|
|
||||||
(define (make-uniform-generator low hi)
|
|
||||||
(assert (<= low hi))
|
|
||||||
|
|
||||||
(let ((range (- hi low)))
|
|
||||||
(lambda ()
|
|
||||||
(+ low (random-integer range)))))
|
|
||||||
|
|
||||||
(define (div-down n d)
|
(define (div-down n d)
|
||||||
(floor (/ n d)))
|
(floor (/ n d)))
|
||||||
|
|
||||||
@ -30,9 +19,9 @@
|
|||||||
(creation-time . 0)
|
(creation-time . 0)
|
||||||
(snap-time . 0))
|
(snap-time . 0))
|
||||||
(tag 'range_mapping `((origin-begin . 0)
|
(tag 'range_mapping `((origin-begin . 0)
|
||||||
(data-begin . ,data-offset)
|
(data-begin . ,data-offset)
|
||||||
(length . ,nr-mappings)
|
(length . ,nr-mappings)
|
||||||
(time . 1)))))
|
(time . 1)))))
|
||||||
|
|
||||||
(define (generate-xml max-thins max-mappings)
|
(define (generate-xml max-thins max-mappings)
|
||||||
(let ((nr-thins ((make-uniform-generator 1 max-thins)))
|
(let ((nr-thins ((make-uniform-generator 1 max-thins)))
|
||||||
|
Loading…
Reference in New Issue
Block a user