[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 (define-syntax with-cache-xml
(syntax-rules () (syntax-rules ()
((_ (v) b1 b2 ...) ((_ (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 ...)))) b1 b2 ...))))
(define-syntax with-valid-metadata (define-syntax with-valid-metadata
(syntax-rules () (syntax-rules ()
((_ (md) b1 b2 ...) ((_ (md) b1 b2 ...)
(with-temp-file-sized ((md (meg 4))) (with-temp-file-sized ((md "cache.bin" (meg 4)))
(with-cache-xml (xml) (with-cache-xml (xml)
(cache-restore "-i" xml "-o" md) (cache-restore "-i" xml "-o" md)
b1 b2 ...))))) b1 b2 ...)))))
@ -34,13 +34,13 @@
(define-syntax with-corrupt-metadata (define-syntax with-corrupt-metadata
(syntax-rules () (syntax-rules ()
((_ (md) b1 b2 ...) ((_ (md) b1 b2 ...)
(with-temp-file-sized ((md (meg 4))) (with-temp-file-sized ((md "cache.bin" (meg 4)))
b1 b2 ...)))) b1 b2 ...))))
(define-syntax with-empty-metadata (define-syntax with-empty-metadata
(syntax-rules () (syntax-rules ()
((_ (md) b1 b2 ...) ((_ (md) b1 b2 ...)
(with-temp-file-sized ((md (meg 4))) (with-temp-file-sized ((md "cache.bin" (meg 4)))
b1 b2 ...)))) b1 b2 ...))))
;; We have to export something that forces all the initialisation expressions ;; We have to export something that forces all the initialisation expressions
@ -177,7 +177,7 @@
(define-scenario (cache-restore tiny-output-file) (define-scenario (cache-restore tiny-output-file)
"Fails if the output file is too small." "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) (with-cache-xml (xml)
(receive (_ stderr) (run-fail "cache_restore" "-i" xml "-o" md) (receive (_ stderr) (run-fail "cache_restore" "-i" xml "-o" md)
(assert-starts-with cache-restore-outfile-too-small-text stderr))))) (assert-starts-with cache-restore-outfile-too-small-text stderr)))))
@ -250,7 +250,7 @@
"cache_dump followed by cache_restore is a noop." "cache_dump followed by cache_restore is a noop."
(with-valid-metadata (md) (with-valid-metadata (md)
(receive (d1-stdout _) (cache-dump 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) (cache-restore "-i" xml "-o" md)
(receive (d2-stdout _) (cache-dump md) (receive (d2-stdout _) (cache-dump md)
(assert-equal d1-stdout d2-stdout)))))) (assert-equal d1-stdout d2-stdout))))))

View File

@ -28,7 +28,8 @@
(apply fmt #f (map dsp (intersperse " " cmd-and-args)))) (apply fmt #f (map dsp (intersperse " " cmd-and-args))))
(define (run . 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)) (let* ((short-cmd (build-command-line cmd-and-args))
(cmd (fmt #f (dsp (build-command-line cmd-and-args)) (cmd (fmt #f (dsp (build-command-line cmd-and-args))
(dsp " > ") (dsp " > ")

View File

@ -14,7 +14,9 @@
disable-unlink) disable-unlink)
(import (chezscheme) (import (chezscheme)
(fmt fmt)) (fmt fmt)
(srfi s8 receive)
(only (srfi s1 lists) span))
;; FIXME: global var! Not thread safe. ;; FIXME: global var! Not thread safe.
(define working-dir "/tmp") (define working-dir "/tmp")
@ -40,38 +42,41 @@
(auto-unlink-file path (auto-unlink-file path
(thunk))))) (thunk)))))
(define temp-filename (define temp-filename
(let ((counter 0)) (lambda (filename)
(lambda () (let ((counter 0))
(let loop () (let loop ()
(let ((path (fmt #f (cat (dsp working-dir) (dsp "/tmp-") (let ((path (fmt #f (cat (dsp working-dir)
(pad-char #\0 (pad/left 4 (num counter))))))) (dsp "/")
(set! counter (+ counter 1)) (pad-char #\0 (pad/left 4 (num counter)))
(if (file-exists? path) (dsp "-")
(loop) (dsp filename)))))
path)))))) (set! counter (+ counter 1))
(if (file-exists? path)
(loop)
path))))))
;; fn takes the path ;; fn takes the path
(define (with-temp-file-thunk fn) (define (with-temp-file-thunk filename fn)
(let ((path (temp-filename))) (let ((path (temp-filename filename)))
(auto-unlink-file path (auto-unlink-file path
(lambda () (fn path))))) (lambda () (fn path)))))
(define-syntax with-temp-file (define-syntax with-temp-file
(syntax-rules () (syntax-rules ()
((_ (v) b1 b2 ...) ((_ ((v f)) b1 b2 ...)
(with-temp-file-thunk (with-temp-file-thunk f
(lambda (v) (lambda (v)
b1 b2 ...))) b1 b2 ...)))
((_ (v1 v2 ...) b1 b2 ...) ((_ ((v1 f1) v2 ...) b1 b2 ...)
(with-temp-file-thunk (with-temp-file-thunk f1
(lambda (v1) (lambda (v1)
(with-temp-file (v2 ...) b1 b2 ...)))))) (with-temp-file (v2 ...) b1 b2 ...))))))
;; Creates a temporary file with the specified contents. ;; Creates a temporary file with the specified contents.
(define (with-temp-file-containing-thunk contents fn) (define (with-temp-file-containing-thunk filename contents fn)
(with-temp-file-thunk (with-temp-file-thunk filename
(lambda (path) (lambda (path)
(with-output-to-file path (lambda () (with-output-to-file path (lambda ()
(put-string (current-output-port) contents))) (put-string (current-output-port) contents)))
@ -79,18 +84,18 @@
(define-syntax with-temp-file-containing (define-syntax with-temp-file-containing
(syntax-rules () (syntax-rules ()
((_ ((v txt)) b1 b2 ...) ((_ ((v f txt)) b1 b2 ...)
(with-temp-file-containing-thunk (with-temp-file-containing-thunk f
txt (lambda (v) b1 b2 ...))) txt (lambda (v) b1 b2 ...)))
((_ ((v txt) rest ...) b1 b2 ...) ((_ ((v f txt) rest ...) b1 b2 ...)
(with-temp-file-containing-thunk (with-temp-file-containing-thunk f
txt (lambda (v txt) txt (lambda (v)
(with-temp-file-containing (rest ...) (with-temp-file-containing (rest ...)
b1 b2 ...)))))) b1 b2 ...))))))
(define (with-temp-file-sized-thunk size fn) (define (with-temp-file-sized-thunk filename size fn)
(with-temp-file-thunk (with-temp-file-thunk filename
(lambda (path) (lambda (path)
(let ((cmd (fmt #f (dsp "fallocate -l ") (wrt size) (dsp " ") (dsp path)))) (let ((cmd (fmt #f (dsp "fallocate -l ") (wrt size) (dsp " ") (dsp path))))
(system cmd) (system cmd)
@ -98,14 +103,14 @@
(define-syntax with-temp-file-sized (define-syntax with-temp-file-sized
(syntax-rules () (syntax-rules ()
((_ ((v size)) b1 b2 ...) ((_ ((v f size)) b1 b2 ...)
(with-temp-file-sized-thunk (with-temp-file-sized-thunk f
size size
(lambda (v) (lambda (v)
b1 b2 ...))) b1 b2 ...)))
((_ ((v size) rest ...) b1 b2 ...) ((_ ((v f size) rest ...) b1 b2 ...)
(with-temp-file-sized-thunk (with-temp-file-sized-thunk f
size (lambda (v) size (lambda (v)
(with-temp-file-sized (rest ...) b1 b2 ...)))))) (with-temp-file-sized (rest ...) b1 b2 ...))))))

View File

@ -24,13 +24,13 @@
(define-syntax with-thin-xml (define-syntax with-thin-xml
(syntax-rules () (syntax-rules ()
((_ (v) b1 b2 ...) ((_ (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 ...)))) b1 b2 ...))))
(define-syntax with-valid-metadata (define-syntax with-valid-metadata
(syntax-rules () (syntax-rules ()
((_ (md) b1 b2 ...) ((_ (md) b1 b2 ...)
(with-temp-file-sized ((md (meg 4))) (with-temp-file-sized ((md "thin.bin" (meg 4)))
(with-thin-xml (xml) (with-thin-xml (xml)
(thin-restore "-i" xml "-o" md) (thin-restore "-i" xml "-o" md)
b1 b2 ...))))) b1 b2 ...)))))
@ -39,7 +39,7 @@
(define-syntax with-corrupt-metadata (define-syntax with-corrupt-metadata
(syntax-rules () (syntax-rules ()
((_ (md) b1 b2 ...) ((_ (md) b1 b2 ...)
(with-temp-file-sized ((md (meg 4))) (with-temp-file-sized ((md "thin.bin" (meg 4)))
b1 b2 ...)))) b1 b2 ...))))
;; We have to export something that forces all the initialisation expressions ;; We have to export something that forces all the initialisation expressions
@ -132,13 +132,13 @@
(define-scenario (thin-restore no-input-file) (define-scenario (thin-restore no-input-file)
"forget to specify an 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) (receive (_ stderr) (run-fail "thin_restore" "-o" md)
(assert-starts-with "No input file provided." stderr)))) (assert-starts-with "No input file provided." stderr))))
(define-scenario (thin-restore missing-input-file) (define-scenario (thin-restore missing-input-file)
"the input file can't be found" "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) (receive (_ stderr) (run-fail "thin_restore -i no-such-file -o" md)
(assert-starts-with "Couldn't stat file" stderr)))) (assert-starts-with "Couldn't stat file" stderr))))
@ -150,21 +150,21 @@
(define-scenario (thin-restore tiny-output-file) (define-scenario (thin-restore tiny-output-file)
"Fails if the output file is too small." "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) (with-thin-xml (xml)
(receive (_ stderr) (run-fail "thin_restore" "-i" xml "-o" md) (receive (_ stderr) (run-fail "thin_restore" "-i" xml "-o" md)
(assert-starts-with thin-restore-outfile-too-small-text stderr))))) (assert-starts-with thin-restore-outfile-too-small-text stderr)))))
(define-scenario (thin-restore q) (define-scenario (thin-restore q)
"thin_restore accepts -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) (with-thin-xml (xml)
(receive (stdout _) (thin-restore "-i" xml "-o" md "-q") (receive (stdout _) (thin-restore "-i" xml "-o" md "-q")
(assert-eof stdout))))) (assert-eof stdout)))))
(define-scenario (thin-restore quiet) (define-scenario (thin-restore quiet)
"thin_restore accepts --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) (with-thin-xml (xml)
(receive (stdout _) (thin-restore "-i" xml "-o" md "--quiet") (receive (stdout _) (thin-restore "-i" xml "-o" md "--quiet")
(assert-eof stdout))))) (assert-eof stdout)))))
@ -173,7 +173,7 @@
"thin_dump followed by thin_restore is a noop." "thin_dump followed by thin_restore is a noop."
(with-valid-metadata (md) (with-valid-metadata (md)
(receive (d1-stdout _) (thin-dump 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) (thin-restore "-i" xml "-o" md)
(receive (d2-stdout _) (thin-dump md) (receive (d2-stdout _) (thin-dump md)
(assert-equal d1-stdout d2-stdout)))))) (assert-equal d1-stdout d2-stdout))))))