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

This commit is contained in:
Matthew Flatt 2021-02-21 17:52:36 -07:00
parent 6099ec80b3
commit 63aa90c748

View File

@ -336,7 +336,16 @@
"compiled"
(car (use-compiled-file-paths)))]
[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-zo (strpath tmp compiled "sandbox-test_rkt.zo")]
[test2-lib (strpath tmp "sandbox-test2.rkt")]
@ -480,7 +489,7 @@
(cp ,list-lib ,test-lib) (cp ,list-zo ,test-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
(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
(load/use-compiled ,test2-lib)
(require 'list) => (void))