diff --git a/functional-tests/functional-tests.scm b/functional-tests/functional-tests.scm index b257e6b..34a1c48 100644 --- a/functional-tests/functional-tests.scm +++ b/functional-tests/functional-tests.scm @@ -7,7 +7,6 @@ temp-file temp-file-containing slurp-file - temp-thin-xml run run-with-exit-code @@ -22,7 +21,14 @@ define-scenario fail run-scenario - run-scenarios) + run-scenarios + + tools-version + define-tool + + assert-equal + assert-eof + assert-starts-with) (import (chezscheme) @@ -79,9 +85,6 @@ (with-input-from-file path slurp)) - (define (temp-thin-xml) - (temp-file-containing (fmt #f (generate-xml 10 1000)))) - ;;;-------------------------------------------------------------------- ;;; Run a sub process and capture it's output. ;;; Ideally we'd use open-process-ports, but that loses us the exit code which @@ -204,5 +207,47 @@ (lambda (keys) (let ((s (hashtable-ref scenarios keys #f))) ((scenario-thunk s)) - (dsp "pass")))))) + (dsp "pass"))))) + + ;;----------------------------------------------- + + ;; FIXME: don't hard code this + (define tools-version "0.7.0-rc6") + + (define (tool-name sym) + (define (to-underscore c) + (if (eq? #\- c) #\_ c)) + + (list->string (map to-underscore (string->list (symbol->string sym))))) + + (define-syntax define-tool + (syntax-rules () + ((_ tool-sym) (define (tool-sym . flags) + (apply run-ok (tool-name 'tool-sym) flags))))) + + (define (assert-equal str1 str2) + (unless (equal? str1 str2) + (fail (fmt #f (dsp "values differ: ") + (wrt str1) + (dsp ", ") + (wrt str2))))) + + (define (assert-eof obj) + (unless (eof-object? obj) + (fail (fmt #f (dsp "object is not an #!eof: ") (dsp obj))))) + + (define (starts-with prefix str) + (and (>= (string-length str) (string-length prefix)) + (equal? (substring str 0 (string-length prefix)) + prefix))) + + (define (assert-starts-with prefix str) + (unless (starts-with prefix str) + (fail (fmt #f (dsp "string should begin with: ") + (wrt prefix) + (dsp ", ") + (wrt str))))) + + + ) diff --git a/functional-tests/run-functional-tests.scm b/functional-tests/run-functional-tests.scm index 2fb7e36..0306034 100644 --- a/functional-tests/run-functional-tests.scm +++ b/functional-tests/run-functional-tests.scm @@ -1,7 +1,9 @@ (import (chezscheme) (functional-tests) + (cache-functional-tests) (thin-functional-tests)) (register-thin-tests) +(register-cache-tests) (run-scenarios (list-scenarios)) diff --git a/functional-tests/thin-functional-tests.scm b/functional-tests/thin-functional-tests.scm index 7c5b9bc..1e08c52 100644 --- a/functional-tests/thin-functional-tests.scm +++ b/functional-tests/thin-functional-tests.scm @@ -11,53 +11,19 @@ (srfi s8 receive) (only (srfi s1 lists) drop-while)) - ;; FIXME: don't hard code this - (define tools-version "0.7.0-rc6") - - (define (tool-name sym) - (define (to-underscore c) - (if (eq? #\- c) #\_ c)) - - (list->string (map to-underscore (string->list (symbol->string sym))))) - - (define-syntax define-tool - (syntax-rules () - ((_ tool-sym) (define (tool-sym . flags) - (apply run-ok (tool-name 'tool-sym) flags))))) - (define-tool thin-check) (define-tool thin-delta) (define-tool thin-dump) (define-tool thin-restore) (define-tool thin-rmap) - (define (assert-equal str1 str2) - (unless (equal? str1 str2) - (fail (fmt #f (dsp "values differ: ") - (wrt str1) - (dsp ", ") - (wrt str2))))) - - (define (assert-eof obj) - (unless (eof-object? obj) - (fail (fmt #f (dsp "object is not an #!eof: ") (dsp obj))))) - - (define (starts-with prefix str) - (and (>= (string-length str) (string-length prefix)) - (equal? (substring str 0 (string-length prefix)) - prefix))) - - (define (assert-starts-with prefix str) - (unless (starts-with prefix str) - (fail (fmt #f (dsp "string should begin with: ") - (wrt prefix) - (dsp ", ") - (wrt str))))) - (define (current-metadata) "metadata.bin") + (define (temp-thin-xml) + (temp-file-containing (fmt #f (generate-xml 10 1000)))) + (define (%with-valid-metadata thunk) - (run-ok "thin_restore" "-i" (temp-thin-xml) "-o" (current-metadata)) + (thin-restore "-i" (temp-thin-xml) "-o" (current-metadata)) (thunk)) (define-syntax with-valid-metadata @@ -77,10 +43,6 @@ ;; to run. (define (register-thin-tests) #t) - ;;;----------------------------------------------------------- - ;;; thin_check scenarios - ;;;----------------------------------------------------------- - (define thin-check-help "Usage: thin_check [options] {device|file} Options: @@ -118,6 +80,10 @@ Where: is of the form .. for example 5..45 denotes blocks 5 to 44 inclusive, but not block 45") + ;;;----------------------------------------------------------- + ;;; thin_check scenarios + ;;;----------------------------------------------------------- + (define-scenario (thin-check v) "thin_check -V" (receive (stdout _) (thin-check "-V")