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

Each tests gets its own planet directory

Browse Source
This commit is contained in:
Jay McCarthy 2011-11-15 07:23:05 -07:00
parent c0f8fef313
commit 34b64f40a9
1 changed files with 23 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
collects/meta/drdr/plt-build.rkt
View File

@ -90,6 +90,21 @@
(define-syntax-rule (with-temporary-directory e) (define-syntax-rule (with-temporary-directory e)
(call-with-temporary-directory (lambda () e))) (call-with-temporary-directory (lambda () e)))
(define (call-with-temporary-planet-directory thunk)
(define tempdir
(build-path (current-directory)
(symbol->string (gensym 'planetdir))))
(dynamic-wind
(lambda ()
(make-directory* tempdir))
(lambda ()
(with-env (["PLTPLANETDIR" (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 (call-with-temporary-home-directory thunk) (define (call-with-temporary-home-directory thunk)
(define new-dir (define new-dir
(make-temporary-file (make-temporary-file
@ -260,14 +275,15 @@
(format ":~a" (format ":~a"
(cpu->child (cpu->child
(current-worker)))]) (current-worker)))])
(with-temporary-home-directory (with-temporary-planet-directory
(with-temporary-home-directory
(with-temporary-directory (with-temporary-directory
(run/collect/wait/log (run/collect/wait/log
log-pth log-pth
#:timeout pth-timeout #:timeout pth-timeout
#:env (current-env) #:env (current-env)
(first l) (first l)
(rest l)))))))) (rest l)))))))))
(λ () (λ ()
(semaphore-post dir-sema)))))] (semaphore-post dir-sema)))))]
[else [else