Each file gets its own tmp dir

collects/meta/drdr/plt-build.rkt

@@ -91,7 +91,10 @@
 (define-syntax-rule (with-temporary-directory e)
   (call-with-temporary-directory (lambda () e)))
 
-(define (call-with-temporary-planet-directory thunk)
+(define-syntax-rule
+  (define-with-temporary-planet-directory with-temporary-planet-directory env-str)
+  (begin
+    (define (call-with-temporary-planet-directory thunk)
       (define tempdir
         (build-path (current-directory)
                     (symbol->string (gensym 'planetdir))))
@@ -99,12 +102,14 @@
           (lambda ()
             (make-directory* tempdir))
           (lambda ()
-     (with-env (["PLTPLANETDIR" (path->string tempdir)])
+            (with-env ([env-str (path->string tempdir)])
                       (thunk)))
           (lambda ()
             (delete-directory/files tempdir))))
-(define-syntax-rule (with-temporary-planet-directory e)
-  (call-with-temporary-planet-directory (lambda () e)))
+    (define-syntax-rule (with-temporary-planet-directory e)
+      (call-with-temporary-planet-directory (lambda () e)))))
+(define-with-temporary-planet-directory with-temporary-planet-directory "PLTPLANETDIR")
+(define-with-temporary-planet-directory with-temporary-tmp-directory "TMPDIR")
 
 (define (call-with-temporary-home-directory thunk)
   (define new-dir
@@ -141,7 +146,7 @@
                  #f
                  (current-error-port)
                  new-command new-args)))
-        ; Die if this program does
+      ;; Die if this program does
       (define parent
         (current-thread))
       (define waiter
@@ -151,22 +156,22 @@
            (printf "Killing parent because wrapper is dead...\n")
            (kill-thread parent))))
 
-        ; Run without stdin
+      ;; Run without stdin
       (close-output-port stdin)
 
       (dynamic-wind
           void
-         ; Run the thunk
+          ;; Run the thunk
           thunk
           (λ ()
-           ; Close the output ports
+            ;; Close the output ports
             #;(close-input-port stdout)
             #;(close-input-port stderr)
 
-           ; Kill the guard
+            ;; Kill the guard
             (kill-thread waiter)
 
-           ; Kill the process
+            ;; Kill the process
             (subprocess-kill the-process #f)
             (sleep)
             (subprocess-kill the-process #t))))
@@ -188,14 +193,14 @@
     (path->string (build-path trunk-dir "bin" "racket")))
   (define raco-path
     (path->string (build-path trunk-dir "bin" "raco")))
-  ; XXX Remove
+  ;; XXX Remove
   (define mzc-path
     (path->string (build-path trunk-dir "bin" "mzc")))
   (define gracket-path
     (path->string (build-path trunk-dir "bin" "gracket")))
   (define collects-pth
     (build-path trunk-dir "collects"))
-  ; XXX Use a single GUI thread so that other non-GUI apps can run in parallel
+  ;; XXX Use a single GUI thread so that other non-GUI apps can run in parallel
   (define gui-lock (make-semaphore 1))
   (define test-workers (make-job-queue (number-of-cpus)))
   (define (test-directory dir-pth upper-sema)
@@ -276,6 +281,7 @@
                                  (format ":~a"
                                          (cpu->child
                                           (current-worker)))])
+                               (with-temporary-tmp-directory
                                 (with-temporary-planet-directory
                                  (with-temporary-home-directory
                                   (with-temporary-directory
@@ -284,7 +290,7 @@
                                     #:timeout pth-timeout
                                     #:env (current-env)
                                     (first l)
-                                   (rest l)))))))))
+                                    (rest l))))))))))
                          (λ ()
                            (semaphore-post dir-sema)))))]
                  [else
@@ -296,14 +302,14 @@
           (notify! "Done with dir: ~a" dir-pth)
           (write-cache! dir-log (current-seconds))
           (semaphore-post upper-sema)))]))
-  ; Some setup
+  ;; Some setup
   (for ([pp (in-list (planet-packages))])
     (match pp
       [`(,auth ,pkg ,majn ,minn ,ver)
        (define maj (number->string majn))
        (define min (number->string minn))
        (run/collect/wait/log
-        ; XXX Give it its own timeout
+        ;; XXX Give it its own timeout
         #:timeout (current-make-install-timeout-seconds)
         #:env (current-env)
         (build-path log-dir "planet" auth pkg maj min)
@@ -317,7 +323,7 @@
    (list "-t"
          (path->string*
           (build-path (drdr-directory) "set-browser.rkt"))))
-  ; And go
+  ;; And go
   (define top-sema (make-semaphore 0))
   (notify! "Starting testing")
   (when (directory-exists? collects-pth)
@@ -367,7 +373,7 @@
      (make-directory* planet-dir)
      (make-directory* home-dir)
      (make-directory* tmp-dir)
-     ; We are running inside of a test directory so that random files are stored there
+     ;; We are running inside of a test directory so that random files are stored there
      (parameterize ([current-directory test-dir]
                     [current-temporary-directory tmp-dir]
                     [current-rev rev])
@@ -409,7 +415,7 @@
                     (sleep 2)
                     (notify! "Starting test of rev ~a" rev)
                     (test-revision rev)))))
-     ; Remove the test directory
+     ;; Remove the test directory
      (safely-delete-directory test-dir))))
 
 (provide/contract