suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

raco test: create fresh user directory for each test in DrDr mode

Browse Source
This commit is contained in:
Matthew Flatt 2014-06-03 07:38:37 +01:00
parent 48ac219d6f
commit 2d3b856b71
2 changed files with 65 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
pkgs/compiler-pkgs/compiler-lib/compiler/commands/test.rkt
View File

@ -29,6 +29,8 @@
(define quiet-program? #f)
(define check-stderr? #f)
(define table? #f)
(define fresh-user? #f)
(define empty-input? #f)
(define jobs 0) ; 0 mean "default"
(define task-sema (make-semaphore 1))
@ -47,7 +49,8 @@
;; Stub for running a test in a process:
(module process racket/base
(require rackunit/log)
(require rackunit/log
racket/file)
;; Arguments are a temp file to hold test results, the module
;; path to run, and the `dynamic-require` second argument:
(define argv (current-command-line-arguments))
@ -56,6 +59,12 @@
(define d (read (open-input-string (vector-ref argv 2))))
(define args (list-tail (vector->list argv) 3))
;; In case PLTUSERHOME is set, make sure relevant
;; directories exist:
(define (ready-dir d)
(make-directory* d))
(ready-dir (find-system-path 'doc-dir))
(parameterize ([current-command-line-arguments (list->vector args)])
(dynamic-require test-module d)
((executable-yield-handler) 0))
@ -125,6 +134,9 @@
(if check-stderr?
(tee-output-port (current-error-port) e)
(current-error-port))))
(define stdin (if empty-input?
(open-input-bytes #"")
(current-input-port)))
(unless quiet?
(when responsible
@ -133,7 +145,11 @@
responsible))
(when random?
(fprintf stdout "raco test:~a @(test-random #t)\n"
id)))
id))
(when lock-name
(fprintf stdout "raco test:~a @(lock-name ~s)\n"
id
lock-name)))
(define-values (result-code test-results)
(case mode
@ -143,6 +159,7 @@
(define t
(parameterize ([current-output-port stdout]
[current-error-port stderr]
[current-input-port stdin]
[current-command-line-arguments (list->vector args)])
(thread
(lambda ()
@ -164,7 +181,7 @@
(parameterize ([current-custodian c])
(dynamic-place* '(submod compiler/commands/test place)
'go
#:in (current-input-port)
#:in stdin
#:out stdout
#:err stderr)))
@ -181,14 +198,27 @@
(sync/timeout 0 pl))]
[(process)
(define tmp-file (make-temporary-file))
(define tmp-dir (and fresh-user?
(make-temporary-file "home~a" 'directory)))
(define ps
(parameterize ([current-output-port stdout]
[current-error-port stderr]
[current-subprocess-custodian-mode 'kill]
[current-custodian c])
[current-custodian c]
[current-environment-variables (environment-variables-copy
(current-environment-variables))])
(environment-variables-set! (current-environment-variables)
#"PLTUSERHOME"
(path->bytes tmp-dir))
(environment-variables-set! (current-environment-variables)
#"TMPDIR"
(path->bytes tmp-dir))
(environment-variables-set! (current-environment-variables)
#"PLTADDONDIR"
(path->bytes (find-system-path 'addon-dir)))
(apply process*/ports
stdout
(current-input-port)
stdin
stderr
(find-exe)
"-l"
@ -208,6 +238,10 @@
(define results
(with-handlers ([exn:fail:read? (lambda () #f)])
(call-with-input-file* tmp-file read)))
(delete-file tmp-file)
(when tmp-dir
(delete-directory/files tmp-dir))
(values (proc 'exit-code)
(and (pair? results)
@ -832,12 +866,14 @@
"Configure defaults to imitate DrDr"
(set! check-top-suffix? #t)
(set! first-avail? #t)
(set! empty-input? #t)
(when (zero? jobs)
(set-jobs! (processor-count)))
(unless default-timeout
(set! default-timeout 90))
(set! check-stderr? #t)
(set! quiet-program? #t)
(set! fresh-user? #t)
(set! table? #t)
(unless default-mode
(set! default-mode 'process))]
@ -874,12 +910,18 @@
[("--timeout") seconds
"Set default timeout to <seconds>"
(set! default-timeout (string->number* "timeout" seconds real?))]
[("--fresh-user")
"Fresh PLTUSERHOME, etc., for each test"
(set! fresh-user? #t)]
[("--quiet-program" "-Q")
"Quiet the program"
(set! quiet-program? #t)]
[("--check-stderr" "-e")
"Treat stderr output as a test failure"
(set! check-stderr? #t)]
[("--empty-stdin")
"Call program with an empty stdin"
(set! empty-input? #t)]
[("--quiet" "-q")
"Suppress `raco test: ...' message"
(set! quiet? #t)]

21
pkgs/racket-pkgs/racket-doc/scribblings/raco/test.scrbl
View File

@ -54,9 +54,14 @@ The @exec{raco test} command accepts several flags:
@item{@DFlag{drdr}
--- Configures defaults to imitate the DrDr continuous testing
system: ignore non-modules, use as many jobs as available processors, set the
default timeout to 90 seconds, count stderr output as a test failure,
quiet program output, and print a table of results.}
system: ignore non-modules, run tests in separate processes,
use as many jobs as available processors,
set the default timeout to 90 seconds,
create a fresh @envvar{PLTUSERHOME} and @envvar{TMPDIR} for each test,
count stderr output as a test failure,
quiet program output,
provide program empty input,
and print a table of results.}
@item{@Flag{s} @nonterm{name} or @DFlag{submodule} @nonterm{name}
--- Requires the submodule @nonterm{name} rather than @racket[test].
@ -101,12 +106,22 @@ The @exec{raco test} command accepts several flags:
If any test fails due to a timeout, the exit status of @exec{raco test}
is 2 (as opposed to 1 for only non-timeout failures or 0 for success).}
@item{@DFlag{fresh-user}
--- When running tests in a separate process, creates a fresh
directory and sets @envvar{PLTUSERHOME} and @envvar{TMPDIR}. The
@envvar{PLTADDONDIR} environment variable is also set so that
the add-on directory (which is where packages are installed, for
example), does @emph{not} change for each test process.}
@item{@Flag{Q} or @DFlag{quiet-program}
--- suppresses output from each test program.}
@item{@Flag{e} or @DFlag{check-stderr}
--- count any stderr output as a test failure.}
@item{@DFlag{empty-stdin}
--- provide an empty stdin to each test program.}
@item{@Flag{q} or @DFlag{quiet}
--- suppresses output of progress information, responsible
parties, and varying output (see @secref["test-responsible"]).}