[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)
|
||||
(import (rnrs)
|
||||
(list-utils)
|
||||
(generators)
|
||||
(xml)
|
||||
(fmt fmt)
|
||||
(only (srfi s1 lists) iota)
|
||||
(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)
|
||||
(floor (/ n d)))
|
||||
|
||||
@ -30,9 +19,9 @@
|
||||
(creation-time . 0)
|
||||
(snap-time . 0))
|
||||
(tag 'range_mapping `((origin-begin . 0)
|
||||
(data-begin . ,data-offset)
|
||||
(length . ,nr-mappings)
|
||||
(time . 1)))))
|
||||
(data-begin . ,data-offset)
|
||||
(length . ,nr-mappings)
|
||||
(time . 1)))))
|
||||
|
||||
(define (generate-xml max-thins max-mappings)
|
||||
(let ((nr-thins ((make-uniform-generator 1 max-thins)))
|
||||
|
Loading…
Reference in New Issue
Block a user