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

cs & io: fix simplify-path for 'up relative to a root

Browse Source 
Closes #3716
This commit is contained in:
Matthew Flatt 2021-03-06 09:36:33 -07:00
parent 07c7ff51ff
commit a3bf702ac9
3 changed files with 24 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/racket-test-core/tests/racket/path.rktl
View File

@ -944,6 +944,8 @@
(test (bytes->path #"../") simplify-path (bytes->path #"../") #f) (test (bytes->path #"../") simplify-path (bytes->path #"../") #f)
(test (bytes->path #"../") simplify-path (bytes->path #"..//") #f) (test (bytes->path #"../") simplify-path (bytes->path #"..//") #f)
(test (bytes->path #"../") simplify-path (bytes->path #"..//./") #f) (test (bytes->path #"../") simplify-path (bytes->path #"..//./") #f)
(test (bytes->path #"/x") simplify-path (bytes->path #"/../../x") #f)
(test (bytes->path #"/") simplify-path (bytes->path #"/x/../..") #f)
(test (bytes->path #"x/") path->directory-path (bytes->path #"x")) (test (bytes->path #"x/") path->directory-path (bytes->path #"x"))
(test (bytes->path #"x/") path->directory-path (bytes->path #"x/")) (test (bytes->path #"x/") path->directory-path (bytes->path #"x/"))
(test (bytes->path #"x/./") path->directory-path (bytes->path #"x/.")) (test (bytes->path #"x/./") path->directory-path (bytes->path #"x/."))

17
racket/src/cs/schemified/io.scm
View File

@ -25003,11 +25003,20 @@
accum_0) accum_0)
(if (eq? 'up (car l_1)) (if (eq? 'up (car l_1))
(if (pair? accum_0) (if (pair? accum_0)
(let ((app_0 (if (if (null?
(cdr l_1))) (cdr
accum_0))
(1/absolute-path?
(car accum_0))
#f)
(loop_0 (loop_0
app_0 (cdr l_1)
(cdr accum_0))) accum_0)
(let ((app_0
(cdr l_1)))
(loop_0
app_0
(cdr accum_0))))
(cons (cons
'up 'up
(loop_0 (loop_0

11
racket/src/io/path/simplify-nofs.rkt
View File

@ -8,7 +8,8 @@
"directory-path.rkt" "directory-path.rkt"
"complete.rkt" "complete.rkt"
"parameter.rkt" "parameter.rkt"
"windows.rkt") "windows.rkt"
"relativity.rkt")
(provide simplify-path-syntactically) (provide simplify-path-syntactically)
@ -52,7 +53,13 @@
[(eq? 'up (car l)) [(eq? 'up (car l))
(cond (cond
[(pair? accum) [(pair? accum)
(loop (cdr l) (cdr accum))] (cond
[(and (null? (cdr accum))
(absolute-path? (car accum)))
;; for 'up at root, just keep the root
(loop (cdr l) accum)]
[else
(loop (cdr l) (cdr accum))])]
[else [else
(cons 'up (loop (cdr l) null))])] (cons 'up (loop (cdr l) null))])]
[else (loop (cdr l) (cons (car l) accum))]))) [else (loop (cdr l) (cons (car l) accum))])))