[functional-tests] Lexically scoped temp file stuff

This commit is contained in:
Joe Thornber
2017-08-24 14:03:07 +01:00
parent bc765ce89d
commit 02618e39d1
5 changed files with 350 additions and 192 deletions

View File

@@ -79,20 +79,21 @@
(define (build-command-line cmd-and-args)
(apply fmt #f (map dsp (intersperse " " cmd-and-args))))
(define cwd "/tmp")
(define (run . cmd-and-args)
(let ((stdout-file (temp-file))
(stderr-file (temp-file)))
(let ((cmd (fmt #f
(dsp (build-command-line cmd-and-args))
(dsp " > ")
(dsp stdout-file)
(dsp " 2> ")
(dsp stderr-file))))
(info (dsp "cmd: ") (dsp cmd))
(let ((exit-code (system cmd)))
(values exit-code
(slurp-file stdout-file)
(slurp-file stderr-file))))))
(with-temp-file (stdout-file stderr-file)
(let ((cmd (fmt #f
(dsp (build-command-line cmd-and-args))
(dsp " > ")
(dsp stdout-file)
(dsp " 2> ")
(dsp stderr-file))))
(info (dsp "cmd: ") (dsp cmd))
(let ((exit-code (system cmd)))
(values exit-code
(slurp-file stdout-file)
(slurp-file stderr-file))))))
(define (run-with-exit-code pred cmd-and-args)
(receive (exit-code stdout stderr) (apply run cmd-and-args)
@@ -171,13 +172,19 @@
(scenario-desc
(hashtable-ref scenarios keys #f)))))
(define (test-dir cwd keys)
(apply string-append cwd "/"
(intersperse "/" (map symbol->string keys))))
(define-syntax define-scenario
(syntax-rules ()
((_ syms desc body ...)
(add-scenario 'syms
(make-scenario desc
(lambda ()
body ...))))))
(lambda (x)
(syntax-case x ()
((k keys desc b1 b2 ...)
#'(add-scenario 'keys
(make-scenario desc
(lambda ()
(with-dir (test-dir "." 'keys)
b1 b2 ...))))))))
(define (fail msg)
(raise (condition