[functional-tests] move some functions from (thin-functional-tests)

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)))))
+
+
+  )
 

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))
 

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:
   <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")
 
+  ;;;-----------------------------------------------------------
+  ;;; thin_check scenarios
+  ;;;-----------------------------------------------------------
+
   (define-scenario (thin-check v)
                    "thin_check -V"
                    (receive (stdout _) (thin-check "-V")