emo/thin-provisioning-tools
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

[functional-tests] thin_check scenarios now work.

Browse Source
This commit is contained in:
Joe Thornber
2017-08-02 13:42:37 +01:00
parent 9ea1af5f4b
commit 213d9d2075
3 changed files with 206 additions and 39 deletions
Download Patch File Download Diff File Expand all files Collapse all files

25
functional-tests/list-utils.scm Normal file
View File

@@ -0,0 +1,25 @@
(library
(list-utils)
(export intersperse iterate accumulate)
(import (rnrs))
(define (intersperse sep xs)
(cond
((null? xs) '())
((null? (cdr xs)) xs)
(else (cons (car xs)
(cons sep
(intersperse sep (cdr xs)))))))
(define (iterate fn count)
(let loop ((count count))
(if (zero? count)
'()
(cons (fn) (loop (- count 1))))))
;; calculates a running total for a list. Returns a list.
(define (accumulate xs)
(let loop ((xs xs) (total 0))
(if (null? xs)
'()
(cons total (loop (cdr xs) (+ total (car xs))))))))

116
functional-tests/main.scm
View File

@@ -1,4 +1,6 @@
(import (fmt fmt))
(import (fmt fmt)
(thin-xml)
(only (srfi s1 lists) drop-while))
;;;--------------------------------------------------------------------
@@ -30,16 +32,21 @@
info-lines)))
;;;--------------------------------------------------------------------
;;; Run a sub process and capture it's output.
;;; Ideally we'd use open-process-ports, but that loses us the exit code which
;;; we need for testing. So we use system, and redirect stderr and stdout to
;;; temporary files, and subsequently read them in. Messy, but fine for tests.
(define temp-file
(let ((counter 0))
(lambda ()
(let ((path (cat (dsp "/tmp/thinp-functional-tests-") (pad-char #\0 (pad/left 4 (num counter))))))
(set! counter (+ counter 1))
(fmt #f path)))))
(let loop ()
(let ((path (fmt #f (cat (dsp "/tmp/thinp-functional-tests-")
(pad-char #\0 (pad/left 4 (num counter)))))))
(set! counter (+ counter 1))
(if (file-exists? path) (loop) path))))))
;; Creates a temporary file with the specified contents.
(define (temp-file-containing contents)
(let ((path (temp-file)))
(with-output-to-file path (lambda () (put-string (current-output-port) contents)))
path))
(define (slurp-file path)
(define (slurp)
@@ -50,6 +57,12 @@
(with-input-from-file path slurp))
;;;--------------------------------------------------------------------
;;; Run a sub process and capture it's output.
;;; Ideally we'd use open-process-ports, but that loses us the exit code which
;;; we need for testing. So we use system, and redirect stderr and stdout to
;;; temporary files, and subsequently read them in. Messy, but fine for tests.
(define (build-command-line cmd-and-args)
(apply fmt #f (map dsp (intersperse " " cmd-and-args))))
@@ -97,12 +110,14 @@
(hashtable-set! scenarios sym s))
(define (list-scenarios)
(vector->list (vector-sort-by string<? symbol->string (hashtable-keys scenarios))))
(vector->list
(vector-sort-by string<? symbol->string (hashtable-keys scenarios))))
(define (describe-scenarios ss)
(define (describe sym)
(fmt #t
(columnar (dsp sym) (justify (scenario-desc (hashtable-ref scenarios sym #f))))
(columnar (dsp sym)
(justify (scenario-desc (hashtable-ref scenarios sym #f))))
nl))
(for-each describe ss))
@@ -145,16 +160,6 @@
(dsp ", ")
(wrt str2)))))
(scenario thin-check-v
"thin_check -V"
(let-values (((stdout stderr) (thin-check "-V")))
(assert-equal tools-version stdout)))
(scenario thin-check-version
"thin_check --version"
(let-values (((stdout stderr) (thin-check "--version")))
(assert-equal tools-version stdout)))
(define thin-check-help
"Usage: thin_check [options] {device|file}
Options:
@@ -166,26 +171,11 @@ Options:
{--skip-mappings}
{--super-block-only}")
(scenario thin-check-h
"print help (-h)"
(let-values (((stdout stderr) (thin-check "-h")))
(assert-equal thin-check-help stdout)))
(scenario thin-check-help
"print help (--help)"
(let-values (((stdout stderr) (thin-check "--help")))
(assert-equal thin-check-help stdout)))
(scenario thin-bad-option
"Unrecognised option should cause failure"
(run-fail "thin_check --hedgehogs-only"))
(define (current-metadata)
"metadata.bin")
(define (%with-valid-metadata thunk)
(let ((xml-file (temp-file)))
(run-ok "thinp_xml create --nr-thins uniform[4..9] --nr-mappings uniform[1000..10000] > " xml-file)
(let ((xml-file (temp-file-containing (fmt #f (generate-xml 10 1000)))))
(run-ok "thin_restore" "-i" xml-file "-o" (current-metadata))
(thunk)))
@@ -202,15 +192,63 @@ Options:
(syntax-rules ()
((_ body ...) (%with-corrupt-metadata (lambda () body ...)))))
(scenario thin-check-valid
;;;-----------------------------------------------------------
;;; Scenarios
;;;-----------------------------------------------------------
(scenario thin-check-v
"thin_check -V"
(let-values (((stdout stderr) (thin-check "-V")))
(assert-equal tools-version stdout)))
(scenario thin-check-version
"thin_check --version"
(let-values (((stdout stderr) (thin-check "--version")))
(assert-equal tools-version stdout)))
(scenario thin-check-h
"print help (-h)"
(let-values (((stdout stderr) (thin-check "-h")))
(assert-equal thin-check-help stdout)))
(scenario thin-check-help
"print help (--help)"
(let-values (((stdout stderr) (thin-check "--help")))
(assert-equal thin-check-help stdout)))
(scenario thin-bad-option
"Unrecognised option should cause failure"
(run-fail "thin_check --hedgehogs-only"))
(scenario thin-check-superblock-only-valid
"--super-block-only check passes on valid metadata"
(with-valid-metadata
(thin_check "--super-block-only" (current-metadata))))
(thin-check "--super-block-only" (current-metadata))))
(scenario thin-check-invalid
(scenario thin-check-superblock-only-invalid
"--super-block-only check fails with corrupt metadata"
(with-corrupt-metadata
(let-values (((stdout stderr) (run-fail "thin_check" "--super-block-only" (current-metadata))))
#t)))
(scenario thin-check-skip-mappings-valid
"--skip-mappings check passes on valid metadata"
(with-valid-metadata
(thin-check "--skip-mappings" (current-metadata))))
(scenario thin-check-ignore-non-fatal-errors
"--ignore-non-fatal-errors check passes on valid metadata"
(with-valid-metadata
(thin-check "--ignore-non-fatal-errors" (current-metadata))))
(scenario thin-check-quiet
"--quiet should give no output"
(with-invalid-metadata
(run-fail "thin_check" "--quiet" (current-metadata))))
(scenario thin-check-clear-needs-check-flag
"Accepts --clear-needs-check-flag"
(with-valid-metadata
(thin-check "--clear-needs-check-flag" (current-metadata))))
;;;--------------------------------------------------------------------

104
functional-tests/thin-xml.scm Normal file
View File

@@ -0,0 +1,104 @@
(library
(thin-xml)
(export generate-xml to-attribute-name)
(import (rnrs)
(list-utils)
(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 (dquote doc)
(cat (dsp #\") doc (dsp #\")))
(define (to-attribute-name sym)
(define (to-underscore c)
(if (eq? #\- c) #\_ c))
(list->string (map to-underscore (string->list (symbol->string sym)))))
(define (attribute dotted-pair)
(let ((key (to-attribute-name (car dotted-pair)))
(val (cdr dotted-pair)))
(cat (dsp key)
(dsp "=")
(dquote ((if (string? val) dsp wrt) val)))))
(define (%open-tag sym attrs end)
(cat (dsp "<")
(dsp sym)
(dsp " ")
(apply cat (intersperse (dsp " ")
(map attribute attrs)))
(dsp end)))
(define (open-tag sym attrs)
(%open-tag sym attrs ">"))
(define (simple-tag sym attrs)
(%open-tag sym attrs "/>"))
(define (close-tag sym)
(cat (dsp "</")
(dsp sym)
(dsp ">")))
(define (tag sym attrs . body)
(if (null? body)
(simple-tag sym attrs)
(begin
(cat (open-tag sym attrs)
nl
(apply cat body)
nl
(close-tag sym)))))
(define (vcat docs)
(apply cat (intersperse nl docs)))
;;;----------------------------------------
(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))))))))