thin-provisioning-tools/functional-tests/thin-xml.scm
2017-08-17 12:13:57 +01:00

43 lines
1.5 KiB
Scheme

(library
(thin-xml)
(export generate-xml)
(import (rnrs)
(list-utils)
(generators)
(xml)
(fmt fmt)
(only (srfi s1 lists) iota)
(srfi s27 random-bits))
(define (div-down n d)
(floor (/ n d)))
(define (generate-dev dev-id nr-mappings data-offset)
(tag 'device `((dev-id . ,dev-id)
(mapped-blocks . ,nr-mappings)
(transaction . 1)
(creation-time . 0)
(snap-time . 0))
(tag 'range_mapping `((origin-begin . 0)
(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)))
(nr-mappings-g (make-uniform-generator (div-down max-mappings 2)
max-mappings)))
(let ((nr-mappings (iterate nr-mappings-g nr-thins)))
(tag 'superblock `((uuid . "")
(time . 1)
(transaction . 1)
(flags . 0)
(version . 2)
(data-block-size . 128)
(nr-data-blocks . ,(apply + nr-mappings)))
(vcat (map generate-dev
(iota nr-thins)
nr-mappings
(accumulate nr-mappings))))))))