sandbox test: repair for bytecode directory other than "compiled"

This commit is contained in:
Matthew Flatt 2019-06-29 08:33:17 -06:00
parent 97b2982a1d
commit 4400b70b87

View File

@ -332,12 +332,15 @@
(let* ([tmp (make-temporary-file "sandboxtest~a" 'directory)] (let* ([tmp (make-temporary-file "sandboxtest~a" 'directory)]
[strpath (lambda xs (path->string (apply build-path xs)))] [strpath (lambda xs (path->string (apply build-path xs)))]
[racketlib (strpath (path-only (collection-file-path "main.rkt" "racket")))] [racketlib (strpath (path-only (collection-file-path "main.rkt" "racket")))]
[compiled (if (null? (use-compiled-file-paths))
"compiled"
(car (use-compiled-file-paths)))]
[list-lib (strpath racketlib "list.rkt")] [list-lib (strpath racketlib "list.rkt")]
[list-zo (strpath racketlib "compiled" "list_rkt.zo")] [list-zo (strpath racketlib compiled "list_rkt.zo")]
[test-lib (strpath tmp "sandbox-test.rkt")] [test-lib (strpath tmp "sandbox-test.rkt")]
[test-zo (strpath tmp "compiled" "sandbox-test_rkt.zo")] [test-zo (strpath tmp compiled "sandbox-test_rkt.zo")]
[test2-lib (strpath tmp "sandbox-test2.rkt")] [test2-lib (strpath tmp "sandbox-test2.rkt")]
[test2-zo (strpath tmp "compiled" "sandbox-test2_rkt.zo")] [test2-zo (strpath tmp compiled "sandbox-test2_rkt.zo")]
[test3-file "sandbox-test3.rkt"] [test3-file "sandbox-test3.rkt"]
[test3-lib (strpath tmp test3-file)] [test3-lib (strpath tmp test3-file)]
[make-module-evaluator/rel (lambda (mod [make-module-evaluator/rel (lambda (mod
@ -442,7 +445,7 @@
;; (directory-list tmp) =err> "file access denied" ;; (directory-list tmp) =err> "file access denied"
--top-- --top--
;; explicitly allow access to tmp, and write access to a single file ;; explicitly allow access to tmp, and write access to a single file
(make-directory (build-path tmp "compiled")) (make-directory* (build-path tmp compiled))
(parameterize ([sandbox-path-permissions (parameterize ([sandbox-path-permissions
`((read ,tmp) (write ,test-zo) `((read ,tmp) (write ,test-zo)
,@(sandbox-path-permissions))]) ,@(sandbox-path-permissions))])