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

some filename tweaks for windows

Browse Source 
svn: r5891
This commit is contained in:
Eli Barzilay 2007-04-08 21:39:12 +00:00
parent a2cbbb6371
commit 4cf75fbb65
2 changed files with 17 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/mzlib/sandbox.ss
View File

@ -509,7 +509,11 @@
[reqs (cond [(not requires) '()]
[(not (list? requires))
(error 'make-evaluator "bad requires: ~e" requires)]
[else (map (lambda (r) (if (pair? r) r `(file ,r)))
[else
(map (lambda (r)
(if (or (pair? r) (symbol? r))
r
`(file ,(path->string (simplify-path* r)))))
requires)])])
(make-evaluator* (init-for-language lang)
(require-perms lang reqs)

14
collects/tests/mzscheme/sandbox.ss
View File

@ -165,7 +165,8 @@
(when (directory-exists? "/tmp") ; non-collects place to play with
(let* ([mzlib (path->string (collection-path "mzlib"))]
[list-lib (path->string (build-path mzlib "list.ss"))]
[test-lib "/tmp/sandbox-test.ss"])
[test-lib (path->string (path->complete-path ; <- for windows
"/tmp/sandbox-test.ss"))])
(t --top--
(set! ev (make-evaluator 'mzscheme '()))
--eval--
@ -203,10 +204,15 @@
(directory-list "/tmp") =err> "file access denied"
--top--
;; explicitly allow access to /tmp
(set! ev (parameterize ([sandbox-path-permissions
`((read #rx#"^/tmp(?:/|$)")
(set! ev (let ([rx (if (eq? 'windows (system-type))
;; on windows this will have a drive letter
#rx#"^[a-zA-Z]:[/\\]tmp(?:[/\\]|$)"
#rx#"^/tmp(?:/|$)")])
(parameterize ([sandbox-path-permissions
;; allow all `/tmp' paths for windows
`((read ,rx)
,@(sandbox-path-permissions))])
(make-evaluator 'mzscheme '())))
(make-evaluator 'mzscheme '()))))
--eval--
(length (with-input-from-file ,test-lib read)) => 5
(list? (directory-list "/tmp"))