diff --git a/pkgs/base/info.rkt b/pkgs/base/info.rkt index 9f83dff004..2cdc1eeeaf 100644 --- a/pkgs/base/info.rkt +++ b/pkgs/base/info.rkt @@ -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])) diff --git a/pkgs/racket-doc/scribblings/reference/paths.scrbl b/pkgs/racket-doc/scribblings/reference/paths.scrbl index d3688612e5..6165995e87 100644 --- a/pkgs/racket-doc/scribblings/reference/paths.scrbl +++ b/pkgs/racket-doc/scribblings/reference/paths.scrbl @@ -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?) diff --git a/pkgs/racket-test-core/tests/racket/pathlib.rktl b/pkgs/racket-test-core/tests/racket/pathlib.rktl index 563ea863b2..cff8d6c61e 100644 --- a/pkgs/racket-test-core/tests/racket/pathlib.rktl +++ b/pkgs/racket-test-core/tests/racket/pathlib.rktl @@ -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 diff --git a/racket/collects/racket/path.rkt b/racket/collects/racket/path.rkt index 8281f6a0d1..50ff6a05c4 100644 --- a/racket/collects/racket/path.rkt +++ b/racket/collects/racket/path.rkt @@ -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))])) diff --git a/racket/src/racket/src/schvers.h b/racket/src/racket/src/schvers.h index f78b92cb3f..4c7109838f 100644 --- a/racket/src/racket/src/schvers.h +++ b/racket/src/racket/src/schvers.h @@ -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)