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

cs: fix resolve-path to just cleanse when there's no link

Browse Source 
Don't convert thet path to absolute, and don't normalize separators on
Windows.

Also, fill in `current-drive`.
This commit is contained in:
Matthew Flatt 2020-07-16 08:22:01 -06:00
parent 0f49bc1079
commit 9867d11d68
7 changed files with 39 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/racket-doc/scribblings/reference/paths.scrbl
View File

@ -374,7 +374,7 @@ same file or directory as @racket[path]. If
@racket[path] is a soft link to another path, then the referenced path
is returned (this may be a relative path with respect to the directory
owning @racket[path]), otherwise @racket[path] is returned (after
expansion).
cleansing).
On Windows, the path for a link should be simplified syntactically, so
that an up-directory indicator removes a preceding path element

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

@ -482,6 +482,22 @@
; normal-case-path now checks for pathness:
(err/rt-test (normal-case-path (string #\a #\nul #\b)))
;; Check that `cleanse-path` and `resolve-path` keep relative paths
;; and keep forward slashes on Windows
(let ()
(define (check-cleanse cleanse-path)
(test (build-path "not-there" "file-also-not-there")
cleanse-path
(build-path "not-there" "file-also-not-there"))
(test (string->path "not-there/b") cleanse-path "not-there///b")
(when (eq? 'windows (system-path-convention-type))
(test (string->path "not-there\\b") cleanse-path "not-there\\\\b")
(test (string->path "not-there\\b/c") cleanse-path "not-there\\\\b/c")
(test (string->path "not-there\\b/c") cleanse-path "not-there\\b//c")
(test (string->path "not-there\\b/c") cleanse-path "not-there\\\\b//c")))
(check-cleanse cleanse-path)
(check-cleanse resolve-path))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; \\?\ paths in Windows

2
racket/src/io/file/host.rkt
View File

@ -18,7 +18,7 @@
(let ([p (->path p)])
(when who
(security-guard-check-file who p guards))
(path-bytes (cleanse-path (path->complete-path p current-directory #:wrt-given? #f)))))
(path-bytes (cleanse-path/convert-slashes (path->complete-path p current-directory #:wrt-given? #f)))))
(define (->host/as-is p who src)
(let ([p (->path p)])

8
racket/src/io/file/main.rkt
View File

@ -4,6 +4,7 @@
"../path/path.rkt"
"../path/parameter.rkt"
"../path/directory-path.rkt"
"../path/cleanse.rkt"
(only-in "../path/windows.rkt" special-filename?)
"../host/rktio.rkt"
"../host/thread.rkt"
@ -375,7 +376,8 @@
(define (do-resolve-path p who)
(check who path-string? p)
(define host-path (->host p who '(exists)))
(define p-path (->path p))
(define host-path (->host p-path who '(exists)))
(define host-path/no-sep (host-path->host-path-without-trailing-separator host-path))
(start-atomic)
(define r0 (rktio_readlink rktio host-path/no-sep))
@ -388,10 +390,10 @@
(cond
[(rktio-error? r)
;; Errors are not reported, but are treated like non-links
(define new-path (host-> host-path))
(define new-path (cleanse-path p-path))
;; If cleansing didn't change p, then return an `eq?` path
(cond
[(equal? new-path p) p]
[(equal? new-path p-path) p-path]
[else new-path])]
[else (host-> r)]))

6
racket/src/io/path/api.rkt
View File

@ -11,7 +11,8 @@
"path.rkt"
"relativity.rkt"
"simplify.rkt"
"directory-path.rkt")
"directory-path.rkt"
(only-in "windows.rkt" split-drive))
(provide path->complete-path
current-drive
@ -32,7 +33,8 @@
(security-guard-check-file who #f '(exists))
(if (eq? (system-path-convention-type) 'unix)
(string->path "/")
(error who "not yet ready")))
(let ([dir (current-directory)])
(path (split-drive (path-bytes dir)) 'windows))))
;; ----------------------------------------

16
racket/src/io/path/cleanse.rkt
View File

@ -7,11 +7,17 @@
"windows.rkt")
(provide cleanse-path
cleanse-path/convert-slashes
clean-double-slashes)
(define/who (cleanse-path p-in)
(check-path-argument who p-in)
(define p (->path p-in))
(do-cleanse-path (->path p-in) #f))
(define (cleanse-path/convert-slashes p)
(do-cleanse-path p #t))
(define (do-cleanse-path p convert-slashes?)
(define convention (path-convention p))
(define (return bstr)
(if (eq? bstr (path-bytes p))
@ -49,21 +55,21 @@
[(parse-unc bstr 0)
=> (lambda (drive-len)
(return (clean-double-slashes bstr 'windows (sub1 drive-len)
#:to-backslash-from 0)))]
#:to-backslash-from (and convert-slashes? 0))))]
[(letter-drive-start? bstr (bytes-length bstr))
(cond
[(and ((bytes-length bstr) . > . 2)
(is-sep? (bytes-ref bstr 2) 'windows))
(return (clean-double-slashes bstr 'windows 2
#:to-backslash-from 2))]
#:to-backslash-from (and convert-slashes? 2)))]
[else
(return (bytes-append (subbytes bstr 0 2)
#"\\"
(clean-double-slashes (subbytes bstr 2) 'windows 0
#:to-backslash-from 0)))])]
#:to-backslash-from (and convert-slashes? 0))))])]
[else
(return (clean-double-slashes bstr 'windows 0
#:to-backslash-from 0))])]))
#:to-backslash-from (and convert-slashes? 0)))])]))
;; ----------------------------------------

2
racket/src/io/path/simplify.rkt
View File

@ -28,7 +28,7 @@
(cond
[(simple? p convention) p]
[else
(define clean-p (cleanse-path p))
(define clean-p (cleanse-path/convert-slashes p))
(cond
[(simple? clean-p convention) clean-p]
[else