[functional-tests] give all temporary files sensible names.
This makes it much easier when debugging a test.
This commit is contained in:
parent
13cee36804
commit
33f0c23ca1
@ -19,13 +19,13 @@
|
||||
(define-syntax with-cache-xml
|
||||
(syntax-rules ()
|
||||
((_ (v) b1 b2 ...)
|
||||
(with-temp-file-containing ((v (fmt #f (generate-xml 512 1024 128))))
|
||||
(with-temp-file-containing ((v "cache.xml" (fmt #f (generate-xml 512 1024 128))))
|
||||
b1 b2 ...))))
|
||||
|
||||
(define-syntax with-valid-metadata
|
||||
(syntax-rules ()
|
||||
((_ (md) b1 b2 ...)
|
||||
(with-temp-file-sized ((md (meg 4)))
|
||||
(with-temp-file-sized ((md "cache.bin" (meg 4)))
|
||||
(with-cache-xml (xml)
|
||||
(cache-restore "-i" xml "-o" md)
|
||||
b1 b2 ...)))))
|
||||
@ -34,13 +34,13 @@
|
||||
(define-syntax with-corrupt-metadata
|
||||
(syntax-rules ()
|
||||
((_ (md) b1 b2 ...)
|
||||
(with-temp-file-sized ((md (meg 4)))
|
||||
(with-temp-file-sized ((md "cache.bin" (meg 4)))
|
||||
b1 b2 ...))))
|
||||
|
||||
(define-syntax with-empty-metadata
|
||||
(syntax-rules ()
|
||||
((_ (md) b1 b2 ...)
|
||||
(with-temp-file-sized ((md (meg 4)))
|
||||
(with-temp-file-sized ((md "cache.bin" (meg 4)))
|
||||
b1 b2 ...))))
|
||||
|
||||
;; We have to export something that forces all the initialisation expressions
|
||||
@ -177,7 +177,7 @@
|
||||
|
||||
(define-scenario (cache-restore tiny-output-file)
|
||||
"Fails if the output file is too small."
|
||||
(with-temp-file-sized ((md (* 1024 4)))
|
||||
(with-temp-file-sized ((md "cache.bin" (* 1024 4)))
|
||||
(with-cache-xml (xml)
|
||||
(receive (_ stderr) (run-fail "cache_restore" "-i" xml "-o" md)
|
||||
(assert-starts-with cache-restore-outfile-too-small-text stderr)))))
|
||||
@ -250,7 +250,7 @@
|
||||
"cache_dump followed by cache_restore is a noop."
|
||||
(with-valid-metadata (md)
|
||||
(receive (d1-stdout _) (cache-dump md)
|
||||
(with-temp-file-containing ((xml d1-stdout))
|
||||
(with-temp-file-containing ((xml "cache.xml" d1-stdout))
|
||||
(cache-restore "-i" xml "-o" md)
|
||||
(receive (d2-stdout _) (cache-dump md)
|
||||
(assert-equal d1-stdout d2-stdout))))))
|
||||
|
@ -28,7 +28,8 @@
|
||||
(apply fmt #f (map dsp (intersperse " " cmd-and-args))))
|
||||
|
||||
(define (run . cmd-and-args)
|
||||
(with-temp-file (stdout-file stderr-file)
|
||||
(with-temp-file ((stdout-file "stdout")
|
||||
(stderr-file "stderr"))
|
||||
(let* ((short-cmd (build-command-line cmd-and-args))
|
||||
(cmd (fmt #f (dsp (build-command-line cmd-and-args))
|
||||
(dsp " > ")
|
||||
|
@ -14,7 +14,9 @@
|
||||
disable-unlink)
|
||||
|
||||
(import (chezscheme)
|
||||
(fmt fmt))
|
||||
(fmt fmt)
|
||||
(srfi s8 receive)
|
||||
(only (srfi s1 lists) span))
|
||||
|
||||
;; FIXME: global var! Not thread safe.
|
||||
(define working-dir "/tmp")
|
||||
@ -40,38 +42,41 @@
|
||||
(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))))))
|
||||
(define temp-filename
|
||||
(lambda (filename)
|
||||
(let ((counter 0))
|
||||
(let loop ()
|
||||
(let ((path (fmt #f (cat (dsp working-dir)
|
||||
(dsp "/")
|
||||
(pad-char #\0 (pad/left 4 (num counter)))
|
||||
(dsp "-")
|
||||
(dsp filename)))))
|
||||
(set! counter (+ counter 1))
|
||||
(if (file-exists? path)
|
||||
(loop)
|
||||
path))))))
|
||||
|
||||
;; fn takes the path
|
||||
(define (with-temp-file-thunk fn)
|
||||
(let ((path (temp-filename)))
|
||||
(define (with-temp-file-thunk filename fn)
|
||||
(let ((path (temp-filename filename)))
|
||||
(auto-unlink-file path
|
||||
(lambda () (fn path)))))
|
||||
|
||||
(define-syntax with-temp-file
|
||||
(syntax-rules ()
|
||||
((_ (v) b1 b2 ...)
|
||||
(with-temp-file-thunk
|
||||
((_ ((v f)) b1 b2 ...)
|
||||
(with-temp-file-thunk f
|
||||
(lambda (v)
|
||||
b1 b2 ...)))
|
||||
|
||||
((_ (v1 v2 ...) b1 b2 ...)
|
||||
(with-temp-file-thunk
|
||||
((_ ((v1 f1) v2 ...) b1 b2 ...)
|
||||
(with-temp-file-thunk f1
|
||||
(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
|
||||
(define (with-temp-file-containing-thunk filename contents fn)
|
||||
(with-temp-file-thunk filename
|
||||
(lambda (path)
|
||||
(with-output-to-file path (lambda ()
|
||||
(put-string (current-output-port) contents)))
|
||||
@ -79,18 +84,18 @@
|
||||
|
||||
(define-syntax with-temp-file-containing
|
||||
(syntax-rules ()
|
||||
((_ ((v txt)) b1 b2 ...)
|
||||
(with-temp-file-containing-thunk
|
||||
((_ ((v f txt)) b1 b2 ...)
|
||||
(with-temp-file-containing-thunk f
|
||||
txt (lambda (v) b1 b2 ...)))
|
||||
|
||||
((_ ((v txt) rest ...) b1 b2 ...)
|
||||
(with-temp-file-containing-thunk
|
||||
txt (lambda (v txt)
|
||||
((_ ((v f txt) rest ...) b1 b2 ...)
|
||||
(with-temp-file-containing-thunk f
|
||||
txt (lambda (v)
|
||||
(with-temp-file-containing (rest ...)
|
||||
b1 b2 ...))))))
|
||||
|
||||
(define (with-temp-file-sized-thunk size fn)
|
||||
(with-temp-file-thunk
|
||||
(define (with-temp-file-sized-thunk filename size fn)
|
||||
(with-temp-file-thunk filename
|
||||
(lambda (path)
|
||||
(let ((cmd (fmt #f (dsp "fallocate -l ") (wrt size) (dsp " ") (dsp path))))
|
||||
(system cmd)
|
||||
@ -98,14 +103,14 @@
|
||||
|
||||
(define-syntax with-temp-file-sized
|
||||
(syntax-rules ()
|
||||
((_ ((v size)) b1 b2 ...)
|
||||
(with-temp-file-sized-thunk
|
||||
((_ ((v f size)) b1 b2 ...)
|
||||
(with-temp-file-sized-thunk f
|
||||
size
|
||||
(lambda (v)
|
||||
b1 b2 ...)))
|
||||
|
||||
((_ ((v size) rest ...) b1 b2 ...)
|
||||
(with-temp-file-sized-thunk
|
||||
((_ ((v f size) rest ...) b1 b2 ...)
|
||||
(with-temp-file-sized-thunk f
|
||||
size (lambda (v)
|
||||
(with-temp-file-sized (rest ...) b1 b2 ...))))))
|
||||
|
||||
|
@ -24,13 +24,13 @@
|
||||
(define-syntax with-thin-xml
|
||||
(syntax-rules ()
|
||||
((_ (v) b1 b2 ...)
|
||||
(with-temp-file-containing ((v (fmt #f (generate-xml 10 1000))))
|
||||
(with-temp-file-containing ((v "thin.xml" (fmt #f (generate-xml 10 1000))))
|
||||
b1 b2 ...))))
|
||||
|
||||
(define-syntax with-valid-metadata
|
||||
(syntax-rules ()
|
||||
((_ (md) b1 b2 ...)
|
||||
(with-temp-file-sized ((md (meg 4)))
|
||||
(with-temp-file-sized ((md "thin.bin" (meg 4)))
|
||||
(with-thin-xml (xml)
|
||||
(thin-restore "-i" xml "-o" md)
|
||||
b1 b2 ...)))))
|
||||
@ -39,7 +39,7 @@
|
||||
(define-syntax with-corrupt-metadata
|
||||
(syntax-rules ()
|
||||
((_ (md) b1 b2 ...)
|
||||
(with-temp-file-sized ((md (meg 4)))
|
||||
(with-temp-file-sized ((md "thin.bin" (meg 4)))
|
||||
b1 b2 ...))))
|
||||
|
||||
;; We have to export something that forces all the initialisation expressions
|
||||
@ -132,13 +132,13 @@
|
||||
|
||||
(define-scenario (thin-restore no-input-file)
|
||||
"forget to specify an input file"
|
||||
(with-temp-file-sized ((md (meg 4)))
|
||||
(with-temp-file-sized ((md "thin.bin" (meg 4)))
|
||||
(receive (_ stderr) (run-fail "thin_restore" "-o" md)
|
||||
(assert-starts-with "No input file provided." stderr))))
|
||||
|
||||
(define-scenario (thin-restore missing-input-file)
|
||||
"the input file can't be found"
|
||||
(with-temp-file-sized ((md (meg 4)))
|
||||
(with-temp-file-sized ((md "thin.bin" (meg 4)))
|
||||
(receive (_ stderr) (run-fail "thin_restore -i no-such-file -o" md)
|
||||
(assert-starts-with "Couldn't stat file" stderr))))
|
||||
|
||||
@ -150,21 +150,21 @@
|
||||
|
||||
(define-scenario (thin-restore tiny-output-file)
|
||||
"Fails if the output file is too small."
|
||||
(with-temp-file-sized ((md (* 1024 4)))
|
||||
(with-temp-file-sized ((md "thin.bin" (* 1024 4)))
|
||||
(with-thin-xml (xml)
|
||||
(receive (_ stderr) (run-fail "thin_restore" "-i" xml "-o" md)
|
||||
(assert-starts-with thin-restore-outfile-too-small-text stderr)))))
|
||||
|
||||
(define-scenario (thin-restore q)
|
||||
"thin_restore accepts -q"
|
||||
(with-temp-file-sized ((md (meg 4)))
|
||||
(with-temp-file-sized ((md "thin.bin" (meg 4)))
|
||||
(with-thin-xml (xml)
|
||||
(receive (stdout _) (thin-restore "-i" xml "-o" md "-q")
|
||||
(assert-eof stdout)))))
|
||||
|
||||
(define-scenario (thin-restore quiet)
|
||||
"thin_restore accepts --quiet"
|
||||
(with-temp-file-sized ((md (meg 4)))
|
||||
(with-temp-file-sized ((md "thin.bin" (meg 4)))
|
||||
(with-thin-xml (xml)
|
||||
(receive (stdout _) (thin-restore "-i" xml "-o" md "--quiet")
|
||||
(assert-eof stdout)))))
|
||||
@ -173,7 +173,7 @@
|
||||
"thin_dump followed by thin_restore is a noop."
|
||||
(with-valid-metadata (md)
|
||||
(receive (d1-stdout _) (thin-dump md)
|
||||
(with-temp-file-containing ((xml d1-stdout))
|
||||
(with-temp-file-containing ((xml "thin.xml" d1-stdout))
|
||||
(thin-restore "-i" xml "-o" md)
|
||||
(receive (d2-stdout _) (thin-dump md)
|
||||
(assert-equal d1-stdout d2-stdout))))))
|
||||
|
Loading…
Reference in New Issue
Block a user