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

[functional-tests] Lexically scoped temp file stuff

Browse Source
This commit is contained in:
Joe Thornber 2017-08-24 14:03:07 +01:00
parent bc765ce89d
commit 02618e39d1
5 changed files with 350 additions and 192 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
functional-tests/cache-functional-tests.scm
View File

@ -15,12 +15,18 @@
(define (current-metadata) "metadata.bin")
(define (temp-cache-xml)
(temp-file-containing (fmt #f (generate-xml 512 1024 128))))
(define cwd "/tmp")
(define-syntax with-cache-xml
(syntax-rules ()
((_ (v) b1 b2 ...)
(with-temp-file-containing ((v (fmt #f (generate-xml 512 1024 128))))
b1 b2 ...))))
(define (%with-valid-metadata thunk)
(cache-restore "-i" (temp-cache-xml) "-o" (current-metadata))
(thunk))
(with-cache-xml (xml)
(cache-restore "-i" xml "-o" (current-metadata))
(thunk)))
(define-syntax with-valid-metadata
(syntax-rules ()
@ -109,6 +115,7 @@ Options:
(receive (_ stderr) (run-fail "cache_check" (current-metadata))
(assert-starts-with "syscall 'open' failed: Permission denied" stderr))))
|#
(define-scenario (cache-check fails-with-corrupt-metadata)
"Fail with corrupt superblock"
(with-corrupt-metadata
@ -120,4 +127,27 @@ Options:
(receive (stdout stderr) (run-fail "cache_check" "-q" (current-metadata))
(assert-eof stdout)
(assert-eof stderr))))
(define-scenario (cache-check failing-quiet)
"Fail quietly with --quiet"
(with-corrupt-metadata
(receive (stdout stderr) (run-fail "cache_check" "--quiet" (current-metadata))
(assert-eof stdout)
(assert-eof stderr))))
(define-scenario (cache-check valid-metadata-passes)
"A valid metadata area passes"
(with-valid-metadata
(cache-check (current-metadata))))
(define-scenario (cache-check deliberately-fail)
"remove me"
(fail (dsp "bad bad bad")))
(define-scenario (cache-check bad-metadata-version)
"Invalid metadata version fails"
(with-cache-xml (xml)
(cache-restore "-i" xml "-o" (current-metadata)
"--debug-override-metadata-version" "12345")
(run-fail "cache_check" (current-metadata))))
)

19
functional-tests/functional-tests.scm
View File

@ -79,9 +79,10 @@
(define (build-command-line cmd-and-args)
(apply fmt #f (map dsp (intersperse " " cmd-and-args))))
(define cwd "/tmp")
(define (run . cmd-and-args)
(let ((stdout-file (temp-file))
(stderr-file (temp-file)))
(with-temp-file (stdout-file stderr-file)
(let ((cmd (fmt #f
(dsp (build-command-line cmd-and-args))
(dsp " > ")
@ -171,13 +172,19 @@
(scenario-desc
(hashtable-ref scenarios keys #f)))))
(define (test-dir cwd keys)
(apply string-append cwd "/"
(intersperse "/" (map symbol->string keys))))
(define-syntax define-scenario
(syntax-rules ()
((_ syms desc body ...)
(add-scenario 'syms
(lambda (x)
(syntax-case x ()
((k keys desc b1 b2 ...)
#'(add-scenario 'keys
(make-scenario desc
(lambda ()
body ...))))))
(with-dir (test-dir "." 'keys)
b1 b2 ...))))))))
(define (fail msg)
(raise (condition

39
functional-tests/run-tests
View File

@ -9,6 +9,7 @@
(only (srfi s1 lists) break)
(regex)
(srfi s8 receive)
(temp-file)
(thin-functional-tests))
;;------------------------------------------------
@ -85,9 +86,6 @@
;;------------------------------------------------
;; Command line parser
(define (switch str)
(>> (lit "--") (lit str)))
(define whitespace
(many+ (charset " \t\n")))
@ -95,17 +93,34 @@
(>> (opt whitespace)
(<* ma (opt whitespace))))
(define (switch str)
(whitespace-delim (>> (lit "--") (lit str))))
(define not-switch
(whitespace-delim
(parse-m (<- c (neg-charset "- \t"))
(<- cs (many* (neg-charset " \t")))
(pure (list->string (cons c cs)))))
(pure (list->string (cons c cs))))))
(define (maybe ma)
(alt (>> ma (pure #t))
(pure #f)))
(define help-command-line
(>> (switch "help") (pure exec-help)))
(define run-command-line
(parse-m
(switch "run")
(<- dunlink (maybe (switch "disable-unlink")))
(<- args (many* not-switch))
(pure (lambda ()
(if dunlink
(disable-unlink (exec-run args))
(exec-run args))))))
(define command-line-parser
(alt (>> (switch "help") (pure exec-help))
(parse-m (switch "run")
(<- args (many* (whitespace-delim not-switch)))
(pure (lambda ()
(exec-run args))))))
(one-of help-command-line run-command-line))
(define (bad-command-line)
(fmt (current-error-port) (dsp "bad command line\n")))
@ -116,8 +131,7 @@
(receive (v st)
(parse command-line-parser
(apply string-append
(intersperse " "
(cdr (command-line)))))
(intersperse " " (cdr (command-line)))))
(if (success? st)
v
bad-command-line))))
@ -126,5 +140,6 @@
(register-thin-tests)
(register-cache-tests)
((parse-command-line))
(with-dir "test-output"
((parse-command-line)))

116
functional-tests/temp-file.scm
View File

@ -2,25 +2,121 @@
(temp-file)
(export
temp-file
temp-file-containing)
working-directory
with-dir-thunk
with-dir
with-temp-file-thunk
with-temp-file-containing-thunk
with-temp-file
with-temp-file-containing
disable-unlink)
(import (rnrs)
(import (chezscheme)
(fmt fmt))
(define temp-file
;; FIXME: global var! Not thread safe.
(define working-dir "/tmp")
(define (working-directory) working-dir)
(define (mkdir-p)
(system (string-append "mkdir -p " working-dir)))
(define (with-dir-thunk path thunk)
(fluid-let ((working-dir (string-append working-dir "/" path)))
(mkdir-p)
(thunk)))
(define-syntax with-dir
(syntax-rules ()
((_ path b1 b2 ...)
(with-dir-thunk path (lambda () b1 b2 ...)))))
(define (with-temp-dir-thunk path thunk)
(with-dir-thunk path
(lambda ()
(auto-unlink-file path
(thunk)))))
(define temp-filename
(let ((counter 0))
(lambda ()
(let loop ()
(let ((path (fmt #f (cat (dsp "/tmp/thinp-functional-tests-")
(let ((path (fmt #f (cat (dsp working-dir) (dsp "/tmp-")
(pad-char #\0 (pad/left 4 (num counter)))))))
(set! counter (+ counter 1))
(if (file-exists? path) (loop) path))))))
(if (file-exists? path)
(loop)
path))))))
;; fn takes the path
(define (with-temp-file-thunk fn)
(let ((path (temp-filename)))
(auto-unlink-file path
(lambda () (fn path)))))
(define-syntax with-temp-file
(syntax-rules ()
((_ (v) b1 b2 ...)
(with-temp-file-thunk
(lambda (v)
b1 b2 ...)))
((_ (v1 v2 ...) b1 b2 ...)
(with-temp-file-thunk
(lambda (v1)
(with-temp-file (v2 ...) b1 b2 ...))))))
;; 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 (with-temp-file-containing-thunk contents fn)
(with-temp-file-thunk
(lambda (path)
(with-output-to-file path (lambda ()
(put-string (current-output-port) contents)))
(fn path))))
(define-syntax with-temp-file-containing
(syntax-rules ()
((_ ((v txt)) b1 b2 ...)
(with-temp-file-containing-thunk
txt (lambda (v) b1 b2 ...)))
((_ ((v txt) rest ...) b1 b2 ...)
(with-temp-file-containing-thunk
txt (lambda (v txt)
(with-temp-file-containing (rest ...)
b1 b2 ...))))))
;;-------------------------
(define should-unlink #t)
(define (disable-unlink-thunk fn)
(fluid-let ((should-unlink #f))
(fn)))
(define-syntax disable-unlink
(syntax-rules ()
((_ b1 b2 ...)
(disable-unlink-thunk
(lambda () b1 b2 ...)))))
;; FIXME: use 'run' so we get logging
(define (unlink-file path)
(when should-unlink
(system (string-append "rm -f " path))))
(define (unlink-dir path)
(when should-unlink
(system (string-append "rmdir -f " path))))
(define (auto-unlink-file path thunk)
(dynamic-wind (lambda () #t)
thunk
(lambda () (unlink-file path))))
(define (auto-unlink-dir path thunk)
(dynamic-wind (lambda () #t)
thunk
(lambda () (unlink-dir path))))
)

40
functional-tests/thin-functional-tests.scm
View File

@ -18,18 +18,24 @@
(define-tool thin-restore)
(define-tool thin-rmap)
;; FIXME: use a temp file
(define (current-metadata) "metadata.bin")
(define (temp-thin-xml)
(temp-file-containing (fmt #f (generate-xml 10 1000))))
;; FIXME: remove
(define cwd "/tmp")
(define (%with-valid-metadata thunk)
(thin-restore "-i" (temp-thin-xml) "-o" (current-metadata))
(thunk))
(define-syntax with-thin-xml
(syntax-rules ()
((_ (v) b1 b2 ...)
(with-temp-file-containing ((v (fmt #f (generate-xml 10 1000))))
b1 b2 ...))))
(define-syntax with-valid-metadata
(syntax-rules ()
((_ body ...) (%with-valid-metadata (lambda () body ...)))))
((_ b1 b2 ...)
(with-thin-xml (xml)
(thin-restore "-i" xml "-o" (current-metadata))
b1 b2 ...))))
;;; It would be nice if the metadata was at least similar to valid data.
(define (%with-corrupt-metadata thunk)
@ -182,28 +188,32 @@ Where:
(define-scenario (thin-restore tiny-output-file)
"Fails if the output file is too small."
(let ((outfile (temp-file)))
(with-temp-file (outfile)
(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))))
(with-thin-xml (xml)
(receive (_ stderr) (run-fail "thin_restore" "-i" xml "-o" outfile)
(assert-starts-with thin-restore-outfile-too-small-text stderr)))))
(define-scenario (thin-restore q)
"thin_restore accepts -q"
(receive (stdout _) (thin-restore "-i" (temp-thin-xml) "-o" (current-metadata) "-q")
(assert-eof stdout)))
(with-thin-xml (xml)
(receive (stdout _) (thin-restore "-i" xml "-o" (current-metadata) "-q")
(assert-eof stdout))))
(define-scenario (thin-restore quiet)
"thin_restore accepts --quiet"
(receive (stdout _) (thin-restore "-i" (temp-thin-xml) "-o" (current-metadata) "--quiet")
(assert-eof stdout)))
(with-thin-xml (xml)
(receive (stdout _) (thin-restore "-i" xml "-o" (current-metadata) "--quiet")
(assert-eof stdout))))
(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))
(thin-restore "-i" (temp-file-containing d1-stdout) "-o" (current-metadata))
(with-temp-file-containing ((xml d1-stdout))
(thin-restore "-i" xml "-o" (current-metadata))
(receive (d2-stdout _) (thin-dump (current-metadata))
(assert-equal d1-stdout d2-stdout)))))
(assert-equal d1-stdout d2-stdout))))))
;;;-----------------------------------------------------------
;;; thin_rmap scenarios