diff --git a/functional-tests/cache-functional-tests.scm b/functional-tests/cache-functional-tests.scm index 35c2c02..8627abf 100644 --- a/functional-tests/cache-functional-tests.scm +++ b/functional-tests/cache-functional-tests.scm @@ -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)))) ) diff --git a/functional-tests/functional-tests.scm b/functional-tests/functional-tests.scm index 196d3c9..c0c8fb8 100644 --- a/functional-tests/functional-tests.scm +++ b/functional-tests/functional-tests.scm @@ -79,20 +79,21 @@ (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))) - (let ((cmd (fmt #f - (dsp (build-command-line cmd-and-args)) - (dsp " > ") - (dsp stdout-file) - (dsp " 2> ") - (dsp stderr-file)))) - (info (dsp "cmd: ") (dsp cmd)) - (let ((exit-code (system cmd))) - (values exit-code - (slurp-file stdout-file) - (slurp-file stderr-file)))))) + (with-temp-file (stdout-file stderr-file) + (let ((cmd (fmt #f + (dsp (build-command-line cmd-and-args)) + (dsp " > ") + (dsp stdout-file) + (dsp " 2> ") + (dsp stderr-file)))) + (info (dsp "cmd: ") (dsp cmd)) + (let ((exit-code (system cmd))) + (values exit-code + (slurp-file stdout-file) + (slurp-file stderr-file)))))) (define (run-with-exit-code pred cmd-and-args) (receive (exit-code stdout stderr) (apply run cmd-and-args) @@ -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 - (make-scenario desc - (lambda () - body ...)))))) + (lambda (x) + (syntax-case x () + ((k keys desc b1 b2 ...) + #'(add-scenario 'keys + (make-scenario desc + (lambda () + (with-dir (test-dir "." 'keys) + b1 b2 ...)))))))) (define (fail msg) (raise (condition diff --git a/functional-tests/run-tests b/functional-tests/run-tests index b0c100e..2de693a 100755 --- a/functional-tests/run-tests +++ b/functional-tests/run-tests @@ -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 - (parse-m (<- c (neg-charset "- \t")) - (<- cs (many* (neg-charset " \t"))) - (pure (list->string (cons c cs))))) + (whitespace-delim + (parse-m (<- c (neg-charset "- \t")) + (<- cs (many* (neg-charset " \t"))) + (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))) diff --git a/functional-tests/temp-file.scm b/functional-tests/temp-file.scm index f78def1..c313180 100644 --- a/functional-tests/temp-file.scm +++ b/functional-tests/temp-file.scm @@ -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 - (let ((counter 0)) - (lambda () - (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)))))) + ;; FIXME: global var! Not thread safe. + (define working-dir "/tmp") - ;; 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 (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 working-dir) (dsp "/tmp-") + (pad-char #\0 (pad/left 4 (num counter))))))) + (set! counter (+ counter 1)) + (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 (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)))) + ) diff --git a/functional-tests/thin-functional-tests.scm b/functional-tests/thin-functional-tests.scm index 3aa8801..95adbcd 100644 --- a/functional-tests/thin-functional-tests.scm +++ b/functional-tests/thin-functional-tests.scm @@ -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) @@ -86,167 +92,171 @@ Where: ;;;----------------------------------------------------------- (define-scenario (thin-check v) - "thin_check -V" - (receive (stdout _) (thin-check "-V") - (assert-equal tools-version stdout))) + "thin_check -V" + (receive (stdout _) (thin-check "-V") + (assert-equal tools-version stdout))) - (define-scenario (thin-check version) - "thin_check --version" - (receive (stdout _) (thin-check "--version") - (assert-equal tools-version stdout))) + (define-scenario (thin-check version) + "thin_check --version" + (receive (stdout _) (thin-check "--version") + (assert-equal tools-version stdout))) - (define-scenario (thin-check h) - "print help (-h)" - (receive (stdout _) (thin-check "-h") - (assert-equal thin-check-help stdout))) + (define-scenario (thin-check h) + "print help (-h)" + (receive (stdout _) (thin-check "-h") + (assert-equal thin-check-help stdout))) - (define-scenario (thin-check help) - "print help (--help)" - (receive (stdout _) (thin-check "--help") - (assert-equal thin-check-help stdout))) + (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) - "Unrecognised option should cause failure" - (run-fail "thin_check --hedgehogs-only")) + (define-scenario (thin-check bad-option) + "Unrecognised option should cause failure" + (run-fail "thin_check --hedgehogs-only")) - (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-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) - "--super-block-only check fails with corrupt metadata" - (with-corrupt-metadata - (run-fail "thin_check --super-block-only" (current-metadata)))) + (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) - "--skip-mappings check passes on valid metadata" - (with-valid-metadata - (thin-check "--skip-mappings" (current-metadata)))) + (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) - "--ignore-non-fatal-errors check passes on valid metadata" - (with-valid-metadata - (thin-check "--ignore-non-fatal-errors" (current-metadata)))) + (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) - "--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 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) - "Accepts --clear-needs-check-flag" - (with-valid-metadata - (thin-check "--clear-needs-check-flag" (current-metadata)))) + (define-scenario (thin-check clear-needs-check-flag) + "Accepts --clear-needs-check-flag" + (with-valid-metadata + (thin-check "--clear-needs-check-flag" (current-metadata)))) - ;;;----------------------------------------------------------- - ;;; thin_restore scenarios - ;;;----------------------------------------------------------- + ;;;----------------------------------------------------------- + ;;; thin_restore scenarios + ;;;----------------------------------------------------------- - (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-v) + "print help (-V)" + (receive (stdout _) (thin-restore "-V") + (assert-equal tools-version stdout))) - (define-scenario (thin-restore print-version-long) - "print help (--version)" - (receive (stdout _) (thin-restore "--version") - (assert-equal tools-version stdout))) + (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) - "print help (-h)" - (receive (stdout _) (thin-restore "-h") - (assert-equal thin-restore-help stdout))) + (define-scenario (thin-restore h) + "print help (-h)" + (receive (stdout _) (thin-restore "-h") + (assert-equal thin-restore-help stdout))) - (define-scenario (thin-restore help) - "print help (-h)" - (receive (stdout _) (thin-restore "--help") - (assert-equal thin-restore-help stdout))) + (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) - "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 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) - "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-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) - "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) + "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) - "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 tiny-output-file) + "Fails if the output file is too small." + (with-temp-file (outfile) + (run-ok "dd if=/dev/zero" (fmt #f (dsp "of=") (dsp outfile)) "bs=4k count=1") + (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))) + (define-scenario (thin-restore q) + "thin_restore accepts -q" + (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))) + (define-scenario (thin-restore quiet) + "thin_restore accepts --quiet" + (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)) - (receive (d2-stdout _) (thin-dump (current-metadata)) - (assert-equal d1-stdout d2-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)) + (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)))))) - ;;;----------------------------------------------------------- - ;;; thin_rmap scenarios - ;;;----------------------------------------------------------- + ;;;----------------------------------------------------------- + ;;; thin_rmap scenarios + ;;;----------------------------------------------------------- - (define-scenario (thin-rmap v) - "thin_rmap accepts -V" - (receive (stdout _) (thin-rmap "-V") - (assert-equal tools-version stdout))) + (define-scenario (thin-rmap v) + "thin_rmap accepts -V" + (receive (stdout _) (thin-rmap "-V") + (assert-equal tools-version stdout))) - (define-scenario (thin-rmap version) - "thin_rmap accepts --version" - (receive (stdout _) (thin-rmap "--version") - (assert-equal tools-version stdout))) + (define-scenario (thin-rmap version) + "thin_rmap accepts --version" + (receive (stdout _) (thin-rmap "--version") + (assert-equal tools-version stdout))) - (define-scenario (thin-rmap h) - "thin_rmap accepts -h" - (receive (stdout _) (thin-rmap "-h") - (assert-equal thin-rmap-help stdout))) + (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) - "thin_rmap accepts --help" - (receive (stdout _) (thin-rmap "--help") - (assert-equal thin-rmap-help stdout))) + (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) - "thin_rmap complains with bad flags." - (run-fail "thin_rmap --unleash-the-hedgehogs")) + (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) - "thin_rmap with a valid region format should pass." - (with-valid-metadata - (thin-rmap "--region 23..7890" (current-metadata)))) + (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) - "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 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) - "thin_rmap should handle multiple regions." - (with-valid-metadata - (thin-rmap "--region 1..23 --region 45..78" (current-metadata))))) + (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)))))