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

find-relative-path: case-normalize for comparison by default

Browse Source 
This change affects programs only on Windows. For example, `C:\a\b`
relative to `c:\A\c` is `..\b`, instead of not relative.

Closes #1603
This commit is contained in:
Matthew Flatt 2017-03-24 17:49:15 -06:00
parent 41e3deab97
commit e22a5da06c
5 changed files with 37 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
pkgs/base/info.rkt
View File

@ -12,7 +12,7 @@
(define collection 'multi)
(define version "6.8.0.2")
(define version "6.8.0.3")
(define deps `("racket-lib"
["racket" #:version ,version]))

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

@ -691,7 +691,8 @@ no extension, @racket[#f] is returned.}
@defproc[(find-relative-path [base (or/c path-string? path-for-some-system?)]
[path (or/c path-string? path-for-some-system?)]
[#:more-than-root? more-than-root? any/c #f])
[#:more-than-root? more-than-root? any/c #f]
[#:normalize-case? normalize-case? any/c #t])
path-for-some-system?]{
Finds a relative pathname with respect to @racket[base] that names the
@ -703,7 +704,19 @@ common with @racket[base], @racket[path] is returned.
If @racket[more-than-root?] is true, if @racket[base] and
@racket[path] share only a Unix root in common, and if neither
@racket[base] nor @racket[path] is just a root path, then
@racket[path] is returned.}
@racket[path] is returned.
If @racket[normalize-case?] is true (the default), then pairs of path
elements to be compared are first converted via
@racket[normal-case-path], which means that path elements are
comparsed case-insentively on Windows. If @racket[normalize-case?] is
@racket[#f], then path elements and the path roots match only if they
have the same case.
@history[#:changed "6.8.0.3" @elem{Made path elements case-normalized
for comparison by default, and
added the @racket[#:normalize-case?]
argument.}]}
@defproc[(normalize-path [path path-string?]
[wrt (and/c path-string? complete-path?)

8
pkgs/racket-test-core/tests/racket/pathlib.rktl
View File

@ -87,6 +87,14 @@
(test (bytes->path #"../.." 'unix) 'find-relative-path (find-relative-path (bytes->path #"/r/c" 'unix) (bytes->path #"/" 'unix)
#:more-than-root? #t))
(test (bytes->path #"..\\b\\a" 'windows) find-relative-path (bytes->path #"C:/r/c" 'windows) (bytes->path #"c:/R/b/a" 'windows))
(test (bytes->path #"..\\b\\a" 'windows) find-relative-path (bytes->path #"C:/r/c" 'windows) (bytes->path #"c:/r/b/a" 'windows))
(test (bytes->path #"c:/R/b/a" 'windows) find-relative-path (bytes->path #"D:/r/c" 'windows) (bytes->path #"c:/R/b/a" 'windows))
(test (bytes->path #"c:/R/b/a" 'windows) 'no-normalize
(find-relative-path (bytes->path #"C:/r/c" 'windows) (bytes->path #"c:/R/b/a" 'windows) #:normalize-case? #f))
(test (bytes->path #"c:/r/b/a" 'windows) 'no-normalize
(find-relative-path (bytes->path #"C:/r/c" 'windows) (bytes->path #"c:/r/b/a" 'windows) #:normalize-case? #f))
;; ----------------------------------------
;; normalize-path needs tests

16
racket/collects/racket/path.rkt
View File

@ -123,15 +123,21 @@
l)
;; Arguments must be in simple form
(define (find-relative-path directory filename #:more-than-root? [more-than-root? #f])
(define (find-relative-path directory filename
#:more-than-root? [more-than-root? #f]
#:normalize-case? [normalize-case? #t])
(let ([dir (do-explode-path 'find-relative-path directory)]
[file (do-explode-path 'find-relative-path filename)])
(if (and (equal? (car dir) (car file))
[file (do-explode-path 'find-relative-path filename)]
[normalize (lambda (p)
(if normalize-case?
(normal-case-path p)
p))])
(if (and (equal? (normalize (car dir)) (normalize (car file)))
(or (not more-than-root?)
(not (eq? 'unix (path-convention-type directory)))
(null? (cdr dir))
(null? (cdr file))
(equal? (cadr dir) (cadr file))))
(equal? (normalize (cadr dir)) (normalize (cadr file)))))
(let loop ([dir (cdr dir)]
[file (cdr file)])
(cond [(null? dir) (if (null? file) filename (apply build-path file))]
@ -140,7 +146,7 @@
(system-path-convention-type)
(path-convention-type filename))
(map (lambda (x) 'up) dir))]
[(equal? (car dir) (car file))
[(equal? (normalize (car dir)) (normalize (car file)))
(loop (cdr dir) (cdr file))]
[else
(apply build-path (append (map (lambda (x) 'up) dir) file))]))

4
racket/src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "6.8.0.2"
#define MZSCHEME_VERSION "6.8.0.3"
#define MZSCHEME_VERSION_X 6
#define MZSCHEME_VERSION_Y 8
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)