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

racket/sandbox: treat linked collections like others

Browse Source
This commit is contained in:
Matthew Flatt 2012-05-14 09:35:06 -06:00
parent ea8a6a1076
commit 29a401b692
2 changed files with 27 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/racket/sandbox.rkt
View File

@ -7,7 +7,8 @@
syntax/moddep
racket/gui/dynamic
planet/config
setup/dirs)
setup/dirs
setup/link)
(provide gui?
sandbox-gui-available
@ -897,7 +898,12 @@
(current-library-collection-paths)))]
[sandbox-path-permissions
`(,@(map (lambda (p) `(read-bytecode ,p))
(current-library-collection-paths))
(append
(current-library-collection-paths)
(links #:root? #t #:user? #f)
(links #:root? #t #:user? #t)
(map cdr (links #:user? #f #:with-path? #t))
(map cdr (links #:user? #t #:with-path? #t))))
(read-bytecode ,(PLANET-BASE-DIR))
(exists ,(find-system-path 'addon-dir))
(read ,(find-system-path 'links-file))

20
collects/tests/racket/link.rkt
View File

@ -1,6 +1,7 @@
#lang racket
(require setup/link
compiler/find-exe)
compiler/find-exe
racket/sandbox)
(define-syntax-rule (test expect expr)
(do-test expect expr 'expr))
@ -223,6 +224,23 @@
(run-setup "c1/s2")
(test #t (file-exists? (build-path c1/s2-dir "compiled" "n2_rkt.zo")))
;; ----------------------------------------
;; sandbox:
(test-racket "#f" '("-l" "racket/base" "-l" "racket/sandbox" "-e" "(void? (make-evaluator 'racket/base))"))
(test-racket "'mz1" '("-l" "racket/base" "-l" "racket/sandbox"
"-e" "(sandbox-output current-output-port)"
"-e" "(define e (make-evaluator 'racket/base))"
"-e" "(e '(require mzlib/m1))"))
(test-racket "'m2" '("-l" "racket/base" "-l" "racket/sandbox"
"-e" "(sandbox-output current-output-port)"
"-e" "(define e (make-evaluator 'racket/base))"
"-e" "(e '(require c1/m2))"))
(test-racket "'n1" '("-l" "racket/base" "-l" "racket/sandbox"
"-e" "(sandbox-output current-output-port)"
"-e" "(define e (make-evaluator 'racket/base))"
"-e" "(e '(require c1/s1/n1))"))
;; ----------------------------------------
;; docs in a linked collection: