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

pkgs/compiler-pkgs/compiler-lib/compiler/commands/test.rkt

@@ -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"
@@ -209,6 +239,10 @@
              (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)
                         (exact-positive-integer? (car 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)]

pkgs/racket-pkgs/racket-doc/scribblings/raco/test.scrbl

@@ -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
+       system: ignore non-modules, run tests in separate processes,
-       default timeout to 90 seconds, count stderr output as a test failure,
+       use as many jobs as available processors,
-       quiet program output, and print a table of results.}
+       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"]).}