fix main-relative->path* (check and throw a type error) and fix the doc accordingly, do path->main-relative* too
svn: r11336
This commit is contained in:
parent
f095993e4c
commit
fb56a59571
|
@ -1209,9 +1209,10 @@ usually a good idea.
|
|||
For historical reasons, @scheme[path] can be a byte string, which is
|
||||
converted to a path using @scheme[bytes->path].}
|
||||
|
||||
@defproc[(main-collects-relative->path [rel (or/c path?
|
||||
(cons/c 'collects
|
||||
(or/c (listof bytes?) bytes?)))])
|
||||
@defproc[(main-collects-relative->path
|
||||
[rel (or/c path? path-string?
|
||||
(cons/c 'collects
|
||||
(or/c (listof bytes?) bytes?)))])
|
||||
path?]{
|
||||
|
||||
|
||||
|
|
|
@ -34,16 +34,20 @@
|
|||
|
||||
;; path->main-relative* : path-or-bytes -> datum-containing-bytes-or-path
|
||||
(define (path->main-relative* path)
|
||||
(let loop ([exploded (explode-path*
|
||||
(if (bytes? path) (bytes->path path) path))]
|
||||
(let loop ([exploded
|
||||
(explode-path*
|
||||
(cond [(bytes? path) (bytes->path path)]
|
||||
[(path-string? path) path]
|
||||
[else (raise-type-error
|
||||
to-rel-name "path, string, or bytes" path)]))]
|
||||
[main-exploded (force main-dir/)])
|
||||
(cond
|
||||
[(null? main-exploded) (cons tag (map path-element->bytes exploded))]
|
||||
[(null? exploded) path]
|
||||
[(equal? (normal-case-path (car exploded))
|
||||
(normal-case-path (car main-exploded)))
|
||||
(loop (cdr exploded) (cdr main-exploded))]
|
||||
[else path])))
|
||||
(cond [(null? main-exploded)
|
||||
(cons tag (map path-element->bytes exploded))]
|
||||
[(null? exploded) path]
|
||||
[(equal? (normal-case-path (car exploded))
|
||||
(normal-case-path (car main-exploded)))
|
||||
(loop (cdr exploded) (cdr main-exploded))]
|
||||
[else path])))
|
||||
|
||||
;; main-relative->path* : datum-containing-bytes-or-path -> path
|
||||
(define (main-relative->path* path)
|
||||
|
@ -63,7 +67,13 @@
|
|||
;; Normal mode:
|
||||
(apply build-path dir
|
||||
(map bytes->path-element (cdr path)))))]
|
||||
[else path]))
|
||||
[(path? path) path]
|
||||
[(bytes? path) (bytes->path path)]
|
||||
[(string? path) (string->path path)]
|
||||
[else (raise-type-error
|
||||
from-rel-name
|
||||
(format "path, string, bytes, or a list beginning with ~a" tag)
|
||||
path)]))
|
||||
|
||||
(values path->main-relative*
|
||||
main-relative->path*))
|
||||
|
|
Loading…
Reference in New Issue
Block a user