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

add PLTUSERHOME

Browse Source 
The new `PLTUSERHOME` environment variable redirects all of the
user-specific paths reported by `find-system-path`.

Also, improve the tests for `raco exe` (particularly the bug
fixed in 6cb6f3fbf1) using `PLTUSERHOME`.

original commit: e4ce0d0331
This commit is contained in:
Matthew Flatt 2014-02-25 14:54:40 -07:00
parent 6aec40ebfb
commit ec06cc8428
1 changed files with 23 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/test.rkt
View File

@ -53,28 +53,30 @@
(let ([plthome (getenv "PLTHOME")] (let ([plthome (getenv "PLTHOME")]
[collects (getenv "PLTCOLLECTS")] [collects (getenv "PLTCOLLECTS")]
[out (open-output-string)]) [out (open-output-string)])
(define temp-home-dir (make-temporary-file "racket-tmp-home~a" 'directory))
;; Try to hide usual collections: ;; Try to hide usual collections:
(when plthome (parameterize ([current-environment-variables
(putenv "PLTHOME" (path->string (build-path (find-system-path 'temp-dir) "NOPE")))) (environment-variables-copy
(when collects (current-environment-variables))])
(putenv "PLTCOLLECTS" (path->string (build-path (find-system-path 'temp-dir) "NOPE")))) (putenv "PLTUSERHOME" (path->string temp-home-dir))
;; Execute: (when plthome
(parameterize ([current-directory (find-system-path 'temp-dir)]) (putenv "PLTHOME" (path->string (build-path (find-system-path 'temp-dir) "NOPE"))))
(when (file-exists? "stdout") (when collects
(delete-file "stdout")) (putenv "PLTCOLLECTS" (path->string (build-path (find-system-path 'temp-dir) "NOPE"))))
(let ([path (if (and mred? (eq? 'macosx (system-type))) ;; Execute:
(let-values ([(base name dir?) (split-path exe)]) (parameterize ([current-directory (find-system-path 'temp-dir)])
(build-path exe "Contents" "MacOS" (when (file-exists? "stdout")
(path-replace-suffix name #""))) (delete-file "stdout"))
exe)]) (let ([path (if (and mred? (eq? 'macosx (system-type)))
(test #t (let-values ([(base name dir?) (split-path exe)])
path (build-path exe "Contents" "MacOS"
(parameterize ([current-output-port out]) (path-replace-suffix name #"")))
(system* path))))) exe)])
(when plthome (test #t
(putenv "PLTHOME" plthome)) path
(when collects (parameterize ([current-output-port out])
(putenv "PLTCOLLECTS" collects)) (system* path))))))
(delete-directory/files temp-home-dir)
(let ([stdout-file (build-path (find-system-path 'temp-dir) "stdout")]) (let ([stdout-file (build-path (find-system-path 'temp-dir) "stdout")])
(if (file-exists? stdout-file) (if (file-exists? stdout-file)
(test expect with-input-from-file stdout-file (test expect with-input-from-file stdout-file