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:
parent
177fff49e6
commit
2490b0711c
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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")
|
||||
|
|
24
collects/tests/racket/setup.rktl
Normal file
24
collects/tests/racket/setup.rktl
Normal 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)
|
Loading…
Reference in New Issue
Block a user