[functional-tests] Tests are now identified by a list of symbols.
Improved formatting too.
This commit is contained in:
Joe Thornber
parent
08ebf0aa8a
commit
66647ae549
@ -27,21 +27,13 @@
|
||||
(import
|
||||
(chezscheme)
|
||||
(fmt fmt)
|
||||
(list-utils)
|
||||
(thin-xml)
|
||||
(srfi s8 receive)
|
||||
(only (srfi s1 lists) drop-while))
|
||||
|
||||
;;;--------------------------------------------------------------------
|
||||
|
||||
;;; FIXME: there must be an equivalent of this in srfi 1
|
||||
(define (intersperse sep xs)
|
||||
(cond
|
||||
((null? xs) '())
|
||||
((null? (cdr xs)) xs)
|
||||
(else (cons (car xs)
|
||||
(cons sep
|
||||
(intersperse sep (cdr xs)))))))
|
||||
|
||||
(define (vector-sort-by cmp key-fn v)
|
||||
(define (compare x y)
|
||||
(cmp (key-fn x) (key-fn y)))
|
||||
@ -137,28 +129,59 @@
|
||||
|
||||
(define-record-type scenario (fields desc thunk))
|
||||
|
||||
(define scenarios (make-eq-hashtable))
|
||||
(define scenarios
|
||||
(make-hashtable equal-hash equal?))
|
||||
|
||||
(define (add-scenario sym s)
|
||||
(hashtable-set! scenarios sym s))
|
||||
(define (add-scenario syms s)
|
||||
(hashtable-set! scenarios syms s))
|
||||
|
||||
(define (fmt-keys prev-keys keys)
|
||||
(define (fmt-keys% n keys)
|
||||
(if (null? keys)
|
||||
fmt-null
|
||||
(cat (space-to n) (dsp (car keys)) (if (null? (cdr keys)) fmt-null nl)
|
||||
(fmt-keys% (+ n 2) (cdr keys)))))
|
||||
|
||||
(let loop ((n 0)
|
||||
(keys keys)
|
||||
(prev-keys prev-keys))
|
||||
(if (and (not (null? keys))
|
||||
(not (null? prev-keys))
|
||||
(eq? (car keys) (car prev-keys)))
|
||||
(loop (+ n 2) (cdr keys) (cdr prev-keys))
|
||||
(begin
|
||||
(if (zero? n)
|
||||
(cat nl (fmt-keys% n keys))
|
||||
(fmt-keys% n keys))))))
|
||||
|
||||
(define (list-scenarios)
|
||||
(define (fmt-keys ks)
|
||||
(fmt #f (dsp ks)))
|
||||
|
||||
(vector->list
|
||||
(vector-sort-by string<? symbol->string (hashtable-keys scenarios))))
|
||||
(vector-sort-by string<? fmt-keys (hashtable-keys scenarios))))
|
||||
|
||||
(define (describe-scenarios ss)
|
||||
(define (describe sym)
|
||||
(define (fmt-scenarios keys fn)
|
||||
(define (describe prev-keys keys)
|
||||
(fmt #t
|
||||
(columnar (dsp sym)
|
||||
(justify (scenario-desc (hashtable-ref scenarios sym #f))))
|
||||
nl))
|
||||
(cat (fmt-keys prev-keys keys)
|
||||
(pad-char #\.
|
||||
(space-to 40)
|
||||
(fn keys))
|
||||
nl)))
|
||||
|
||||
(for-each describe ss))
|
||||
(for-each describe (cons '() (reverse (cdr (reverse keys)))) keys))
|
||||
|
||||
(define (describe-scenarios keys)
|
||||
(fmt-scenarios keys
|
||||
(lambda (keys)
|
||||
(scenario-desc
|
||||
(hashtable-ref scenarios keys #f)))))
|
||||
|
||||
(define-syntax define-scenario
|
||||
(syntax-rules ()
|
||||
((_ sym desc body ...)
|
||||
(add-scenario 'sym
|
||||
((_ syms desc body ...)
|
||||
(add-scenario 'syms
|
||||
(make-scenario desc
|
||||
(lambda ()
|
||||
body ...))))))
|
||||
@ -168,14 +191,18 @@
|
||||
(make-error)
|
||||
(make-message-condition msg))))
|
||||
|
||||
(define (run-scenario sym)
|
||||
(let ((s (hashtable-ref scenarios sym #f)))
|
||||
(display sym)
|
||||
(define (run-scenario syms)
|
||||
(let ((s (hashtable-ref scenarios syms #f)))
|
||||
(display syms)
|
||||
(display " ... ")
|
||||
((scenario-thunk s))
|
||||
(display "pass")
|
||||
(newline)))
|
||||
|
||||
(define (run-scenarios ss)
|
||||
(for-each run-scenario ss)))
|
||||
(fmt-scenarios ss
|
||||
(lambda (keys)
|
||||
(let ((s (hashtable-ref scenarios keys #f)))
|
||||
((scenario-thunk s))
|
||||
(dsp "pass"))))))
|
||||
|
||||
|
||||
@ -1,7 +1,15 @@
|
||||
(library
|
||||
(list-utils)
|
||||
(export tails intersperse iterate accumulate)
|
||||
(import (rnrs))
|
||||
|
||||
(export tails
|
||||
intersperse
|
||||
iterate
|
||||
comparing
|
||||
list-group-by
|
||||
accumulate)
|
||||
|
||||
(import (rnrs)
|
||||
(srfi s8 receive))
|
||||
|
||||
(define (tails xs)
|
||||
(if (null? xs)
|
||||
@ -22,6 +30,19 @@
|
||||
'()
|
||||
(cons (fn) (loop (- count 1))))))
|
||||
|
||||
(define (comparing cmp key)
|
||||
(lambda (x y)
|
||||
(cmp (key x) (key y))))
|
||||
|
||||
;; Assumes the list is already sorted
|
||||
(define (list-group-by pred xs)
|
||||
(if (null? xs)
|
||||
'()
|
||||
(let ((fst (car xs)))
|
||||
(receive (g1 gs) (partition (lambda (x) (pred fst x)) (cdr xs))
|
||||
(cons (cons fst g1)
|
||||
(list-group-by pred gs))))))
|
||||
|
||||
;; calculates a running total for a list. Returns a list.
|
||||
(define (accumulate xs)
|
||||
(let loop ((xs xs) (total 0))
|
||||
|
||||
@ -119,58 +119,58 @@ Where:
|
||||
<block range> is of the form <begin>..<one-past-the-end>
|
||||
for example 5..45 denotes blocks 5 to 44 inclusive, but not block 45")
|
||||
|
||||
(define-scenario thin-check-v
|
||||
(define-scenario (thin-check v)
|
||||
"thin_check -V"
|
||||
(receive (stdout _) (thin-check "-V")
|
||||
(assert-equal tools-version stdout)))
|
||||
|
||||
(define-scenario thin-check-version
|
||||
(define-scenario (thin-check version)
|
||||
"thin_check --version"
|
||||
(receive (stdout _) (thin-check "--version")
|
||||
(assert-equal tools-version stdout)))
|
||||
|
||||
(define-scenario thin-check-h
|
||||
(define-scenario (thin-check h)
|
||||
"print help (-h)"
|
||||
(receive (stdout _) (thin-check "-h")
|
||||
(assert-equal thin-check-help stdout)))
|
||||
|
||||
(define-scenario thin-check-help
|
||||
(define-scenario (thin-check help)
|
||||
"print help (--help)"
|
||||
(receive (stdout _) (thin-check "--help")
|
||||
(assert-equal thin-check-help stdout)))
|
||||
|
||||
(define-scenario thin-check-bad-option
|
||||
(define-scenario (thin-check bad-option)
|
||||
"Unrecognised option should cause failure"
|
||||
(run-fail "thin_check --hedgehogs-only"))
|
||||
|
||||
(define-scenario thin-check-superblock-only-valid
|
||||
(define-scenario (thin-check superblock-only-valid)
|
||||
"--super-block-only check passes on valid metadata"
|
||||
(with-valid-metadata
|
||||
(thin-check "--super-block-only" (current-metadata))))
|
||||
|
||||
(define-scenario thin-check-superblock-only-invalid
|
||||
(define-scenario (thin-check superblock-only-invalid)
|
||||
"--super-block-only check fails with corrupt metadata"
|
||||
(with-corrupt-metadata
|
||||
(run-fail "thin_check --super-block-only" (current-metadata))))
|
||||
|
||||
(define-scenario thin-check-skip-mappings-valid
|
||||
(define-scenario (thin-check skip-mappings-valid)
|
||||
"--skip-mappings check passes on valid metadata"
|
||||
(with-valid-metadata
|
||||
(thin-check "--skip-mappings" (current-metadata))))
|
||||
|
||||
(define-scenario thin-check-ignore-non-fatal-errors
|
||||
(define-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))))
|
||||
|
||||
(define-scenario thin-check-quiet
|
||||
(define-scenario (thin-check quiet)
|
||||
"--quiet should give no output"
|
||||
(with-valid-metadata
|
||||
(receive (stdout stderr) (thin-check "--quiet" (current-metadata))
|
||||
(assert-eof stdout)
|
||||
(assert-eof stderr))))
|
||||
|
||||
(define-scenario thin-check-clear-needs-check-flag
|
||||
(define-scenario (thin-check clear-needs-check-flag)
|
||||
"Accepts --clear-needs-check-flag"
|
||||
(with-valid-metadata
|
||||
(thin-check "--clear-needs-check-flag" (current-metadata))))
|
||||
@ -179,59 +179,59 @@ Where:
|
||||
;;; thin_restore scenarios
|
||||
;;;-----------------------------------------------------------
|
||||
|
||||
(define-scenario thin-restore-print-version-v
|
||||
(define-scenario (thin-restore print-version-v)
|
||||
"print help (-V)"
|
||||
(receive (stdout _) (thin-restore "-V")
|
||||
(assert-equal tools-version stdout)))
|
||||
|
||||
(define-scenario thin-restore-print-version-long
|
||||
(define-scenario (thin-restore print-version-long)
|
||||
"print help (--version)"
|
||||
(receive (stdout _) (thin-restore "--version")
|
||||
(assert-equal tools-version stdout)))
|
||||
|
||||
(define-scenario thin-restore-h
|
||||
(define-scenario (thin-restore h)
|
||||
"print help (-h)"
|
||||
(receive (stdout _) (thin-restore "-h")
|
||||
(assert-equal thin-restore-help stdout)))
|
||||
|
||||
(define-scenario thin-restore-help
|
||||
(define-scenario (thin-restore help)
|
||||
"print help (-h)"
|
||||
(receive (stdout _) (thin-restore "--help")
|
||||
(assert-equal thin-restore-help stdout)))
|
||||
|
||||
(define-scenario thin-restore-no-input-file
|
||||
(define-scenario (thin-restore no-input-file)
|
||||
"forget to specify an input file"
|
||||
(receive (_ stderr) (run-fail "thin_restore" "-o" (current-metadata))
|
||||
(assert-starts-with "No input file provided." stderr)))
|
||||
|
||||
(define-scenario thin-restore-missing-input-file
|
||||
(define-scenario (thin-restore missing-input-file)
|
||||
"the input file can't be found"
|
||||
(receive (_ stderr) (run-fail "thin_restore -i no-such-file -o" (current-metadata))
|
||||
(assert-starts-with "Couldn't stat file" stderr)))
|
||||
|
||||
(define-scenario thin-restore-missing-output-file
|
||||
(define-scenario (thin-restore missing-output-file)
|
||||
"the input file can't be found"
|
||||
(receive (_ stderr) (run-fail "thin_restore -i no-such-file -o" (current-metadata))
|
||||
(assert-starts-with "Couldn't stat file" stderr)))
|
||||
|
||||
(define-scenario thin-restore-tiny-output-file
|
||||
(define-scenario (thin-restore tiny-output-file)
|
||||
"Fails if the output file is too small."
|
||||
(let ((outfile (temp-file)))
|
||||
(run-ok "dd if=/dev/zero" (fmt #f (dsp "of=") (dsp outfile)) "bs=4k count=1")
|
||||
(receive (_ stderr) (run-fail "thin_restore" "-i" (temp-thin-xml) "-o" outfile)
|
||||
(assert-starts-with thin-restore-outfile-too-small-text stderr))))
|
||||
|
||||
(define-scenario thin-restore-q
|
||||
(define-scenario (thin-restore q)
|
||||
"thin_restore accepts -q"
|
||||
(receive (stdout _) (thin-restore "-i" (temp-thin-xml) "-o" (current-metadata) "-q")
|
||||
(assert-eof stdout)))
|
||||
|
||||
(define-scenario thin-restore-quiet
|
||||
(define-scenario (thin-restore quiet)
|
||||
"thin_restore accepts --quiet"
|
||||
(receive (stdout _) (thin-restore "-i" (temp-thin-xml) "-o" (current-metadata) "--quiet")
|
||||
(assert-eof stdout)))
|
||||
|
||||
(define-scenario thin-dump-restore-is-noop
|
||||
(define-scenario (thin-dump restore-is-noop)
|
||||
"thin_dump followed by thin_restore is a noop."
|
||||
(with-valid-metadata
|
||||
(receive (d1-stdout _) (thin-dump (current-metadata))
|
||||
@ -243,43 +243,43 @@ Where:
|
||||
;;; thin_rmap scenarios
|
||||
;;;-----------------------------------------------------------
|
||||
|
||||
(define-scenario thin-rmap-v
|
||||
(define-scenario (thin-rmap v)
|
||||
"thin_rmap accepts -V"
|
||||
(receive (stdout _) (thin-rmap "-V")
|
||||
(assert-equal tools-version stdout)))
|
||||
|
||||
(define-scenario thin-rmap-version
|
||||
(define-scenario (thin-rmap version)
|
||||
"thin_rmap accepts --version"
|
||||
(receive (stdout _) (thin-rmap "--version")
|
||||
(assert-equal tools-version stdout)))
|
||||
|
||||
(define-scenario thin-rmap-h
|
||||
(define-scenario (thin-rmap h)
|
||||
"thin_rmap accepts -h"
|
||||
(receive (stdout _) (thin-rmap "-h")
|
||||
(assert-equal thin-rmap-help stdout)))
|
||||
|
||||
(define-scenario thin-rmap-help
|
||||
(define-scenario (thin-rmap help)
|
||||
"thin_rmap accepts --help"
|
||||
(receive (stdout _) (thin-rmap "--help")
|
||||
(assert-equal thin-rmap-help stdout)))
|
||||
|
||||
(define-scenario thin-rmap-unrecognised-flag
|
||||
(define-scenario (thin-rmap unrecognised-flag)
|
||||
"thin_rmap complains with bad flags."
|
||||
(run-fail "thin_rmap --unleash-the-hedgehogs"))
|
||||
|
||||
(define-scenario thin-rmap-valid-region-format-should-pass
|
||||
(define-scenario (thin-rmap valid-region-format-should-pass)
|
||||
"thin_rmap with a valid region format should pass."
|
||||
(with-valid-metadata
|
||||
(thin-rmap "--region 23..7890" (current-metadata))))
|
||||
|
||||
(define-scenario thin-rmap-invalid-region-should-fail
|
||||
(define-scenario (thin-rmap invalid-region-should-fail)
|
||||
"thin_rmap with an invalid region format should fail."
|
||||
(for-each (lambda (pattern)
|
||||
(with-valid-metadata
|
||||
(run-fail "thin_rmap --region" pattern (current-metadata))))
|
||||
'("23,7890" "23..six" "found..7890" "89..88" "89..89" "89.." "" "89...99")))
|
||||
|
||||
(define-scenario thin-rmap-multiple-regions-should-pass
|
||||
(define-scenario (thin-rmap multiple-regions-should-pass)
|
||||
"thin_rmap should handle multiple regions."
|
||||
(with-valid-metadata
|
||||
(thin-rmap "--region 1..23 --region 45..78" (current-metadata)))))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user