[functional-tests] add (cache-xml)
This commit is contained in:
parent
207553dfce
commit
d061caaf2b
47
functional-tests/cache-xml.scm
Normal file
47
functional-tests/cache-xml.scm
Normal file
@ -0,0 +1,47 @@
|
||||
(library
|
||||
(cache-xml)
|
||||
(export generate-xml)
|
||||
(import (rnrs)
|
||||
(list-utils)
|
||||
(loops)
|
||||
(generators)
|
||||
(xml)
|
||||
(fmt fmt)
|
||||
(srfi s27 random-bits)
|
||||
(only (srfi s1 lists) iota))
|
||||
|
||||
(define (make-enum-vector count)
|
||||
(let ((v (make-vector count)))
|
||||
(upto (n count)
|
||||
(vector-set! v n n))
|
||||
v))
|
||||
|
||||
(define (vector-swap! v n m)
|
||||
(let ((tmp (vector-ref v n)))
|
||||
(vector-set! v n (vector-ref v m))
|
||||
(vector-set! v m tmp)))
|
||||
|
||||
(define (rnd b e)
|
||||
(+ b (random-integer (- e b))))
|
||||
|
||||
(define (vector-partial-shuffle! v count)
|
||||
(let ((len (vector-length v)))
|
||||
(upto (n count)
|
||||
(vector-swap! v n (rnd n len)))))
|
||||
|
||||
;;---------------------------------------------------------
|
||||
|
||||
(define (generate-xml block-size nr-origin-blocks nr-cache-blocks)
|
||||
(tag 'superblock `((uuid . "")
|
||||
(block-size . ,block-size)
|
||||
(nr-cache-blocks . ,nr-cache-blocks)
|
||||
(policy . "smq")
|
||||
(hint-width . 4))
|
||||
;; FIXME: what a waste of memory
|
||||
(let ((v (make-enum-vector nr-origin-blocks)))
|
||||
(vector-partial-shuffle! v nr-cache-blocks)
|
||||
(vcat (map (lambda (cblock)
|
||||
(tag 'mapping `((cache-block . ,cblock)
|
||||
(origin-block . ,(vector-ref v cblock))
|
||||
(dirty . "true"))))
|
||||
(iota nr-cache-blocks)))))))
|
Loading…
Reference in New Issue
Block a user