Fix the path relative functions to return a string for a path input,

clarify the documentation, add a few tests.

Fixes pr 12032
Fixes pr 12034
(cherry picked from commit ebe9453e73)
This commit is contained in:
Eli Barzilay 2011-07-10 06:51:57 -04:00
parent 177fff49e6
commit 2490b0711c
4 changed files with 59 additions and 12 deletions

View File

@ -1189,31 +1189,52 @@ than specified in the contract above, it is returned as-is.}
@defmodule[setup/path-to-relative]
@defproc[(path->relative-string/library [path path-string?]
[default any/c (lambda (x) x)])
any]{
@defproc[(path->relative-string/library
[path path-string?]
[default (or/c (-> path-string? any/c) any/c)
(lambda (x) (if (path? x) (path->string x) x))])
any/c]{
Produces a string suitable for display in error messages. If the path
is an absolute one that is inside the @filepath{collects} tree, the
result will be a string that begins with @racket["<collects>/"].
Similarly, a path in the user-specific collects results in a prefix of
@racket["<user-collects>/"], and a @PLaneT path results in
@racket["<planet>/"]. If the path is not absolute, or if it is not in
any of these, the @racket[default] determines the result: if it is a
procedure, it is applied onto the path to get the result, otherwise it
is returned.
@racket["<planet>/"].
If the path is not absolute, or if it is not in any of these, it is
returned as-is (converted to a string if needed). If @racket[default]
is given, it specifies the return value instead: it can be a procedure
which is applied onto the path to get the result, or the result
itself.
Note that this function can be a non-string only if @racket[default]
is given, and it does not return a string.
}
@defproc[(path->relative-string/setup [path path-string?]
[default any/c (lambda (x) x)])
@defproc[(path->relative-string/setup
[path path-string?]
[default (or/c (-> path-string? any/c) any/c)
(lambda (x) (if (path? x) (path->string x) x))])
any]{
Similar to @racket[path->relative-string/library], but more suited for
output during compilation: @filepath{collects} paths are shown with no
prefix, and in the user-specific collects with just a
@racket["<user>"] prefix.
If the path is not absolute, or if it is not in any of these, it is
returned as-is (converted to a string if needed). If @racket[default]
is given, it specifies the return value instead: it can be a procedure
which is applied onto the path to get the result, or the result
itself.
Note that this function can be a non-string only if @racket[default]
is given, and it does not return a string.
}
@defproc[(make-path->relative-string [dirs (listof (cons (-> path?) string?))]
[default any/c (lambda (x) x)])
@defproc[(make-path->relative-string
[dirs (listof (cons (-> path?) string?))]
[default (or/c (-> path-string? any/c) any/c)
(lambda (x) (if (path? x) (path->string x) x))])
(path-string? any/c . -> . any)]{
This function produces functions like
@racket[path->relative-string/library] and

View File

@ -10,7 +10,8 @@
path->relative-string/setup
path->relative-string/library)
(define (make-path->relative-string dirs [default (lambda (x) x)])
(define (make-path->relative-string
dirs [default (lambda (x) (if (path? x) (path->string x) x))])
(unless (and (list? dirs)
(andmap (lambda (x)
(and (pair? x)

View File

@ -1,6 +1,7 @@
(load-relative "loadtest.rktl")
(load-in-sandbox "setup.rktl")
(load-in-sandbox "for.rktl")
(load-in-sandbox "list.rktl")
(load-in-sandbox "math.rktl")

View File

@ -0,0 +1,24 @@
(load-relative "loadtest.rktl")
(Section 'setup)
(require setup/path-to-relative)
(let ([missing "/some/inexistent/path"]
[collects (build-path (collection-path "racket") "foo.rkt")]
[relative "some/path"])
(define (test-both path/str expected-str [lib-expected expected-str])
(define str (if (string? path/str) path/str (path->string path/str)))
(define path (string->path str))
(test expected-str path->relative-string/setup str)
(test expected-str path->relative-string/setup path)
(test lib-expected path->relative-string/library str)
(test lib-expected path->relative-string/library path))
(test-both missing missing)
(test-both relative relative)
(test-both collects "racket/foo.rkt" "<collects>/racket/foo.rkt")
(err/rt-test (path->relative-string/setup #f))
(err/rt-test (path->relative-string/setup #"bleh"))
(err/rt-test (path->relative-string/setup 'bleh)))
(report-errs)