[functional-tests] give all temporary files sensible names.

This makes it much easier when debugging a test.
This commit is contained in:
Joe Thornber 2017-08-29 14:46:59 +01:00
parent 13cee36804
commit 33f0c23ca1
4 changed files with 52 additions and 46 deletions

View File

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

View File

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

View File

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

View File

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