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

repair sandbox test for compile-file-roots with extra paths

Browse Source
This commit is contained in:
Matthew Flatt 2021-02-21 17:52:36 -07:00
parent 6099ec80b3
commit 63aa90c748
1 changed files with 11 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
pkgs/racket-test-core/tests/racket/sandbox.rktl
View File

@ -336,7 +336,16 @@
"compiled" "compiled"
(car (use-compiled-file-paths)))] (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 (for/or ([root (in-list (current-compiled-file-roots))])
(define file (cond
[(eq? root 'same)
(build-path racketlib compiled "list_rkt.zo")]
[(relative-path? root)
(build-path racketlib root compiled "list_rkt.zo")]
[else
(build-path (reroot-path racketlib root) compiled "list_rkt.zo")]))
(and (file-exists? file)
(path->string file)))]
[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")]
@ -480,7 +489,7 @@
(cp ,list-lib ,test-lib) (cp ,list-zo ,test-zo) (cp ,list-lib ,test-lib) (cp ,list-zo ,test-zo)
(cp ,list-lib ,test2-lib) (cp ,list-zo ,test2-zo) (cp ,list-lib ,test2-lib) (cp ,list-zo ,test2-zo)
;; bytecode from test-lib is bad, even when we can read/write to it ;; bytecode from test-lib is bad, even when we can read/write to it
(load/use-compiled ,test-zo) =err> "cannot use unsafe linklet loaded with non-original code inspector" (load ,test-zo) =err> "cannot use unsafe linklet loaded with non-original code inspector"
;; bytecode from test2-lib is explicitly allowed ;; bytecode from test2-lib is explicitly allowed
(load/use-compiled ,test2-lib) (load/use-compiled ,test2-lib)
(require 'list) => (void)) (require 'list) => (void))