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]
|
@defmodule[setup/path-to-relative]
|
||||||
|
|
||||||
@defproc[(path->relative-string/library [path path-string?]
|
@defproc[(path->relative-string/library
|
||||||
[default any/c (lambda (x) x)])
|
[path path-string?]
|
||||||
any]{
|
[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
|
Produces a string suitable for display in error messages. If the path
|
||||||
is an absolute one that is inside the @filepath{collects} tree, the
|
is an absolute one that is inside the @filepath{collects} tree, the
|
||||||
result will be a string that begins with @racket["<collects>/"].
|
result will be a string that begins with @racket["<collects>/"].
|
||||||
Similarly, a path in the user-specific collects results in a prefix of
|
Similarly, a path in the user-specific collects results in a prefix of
|
||||||
@racket["<user-collects>/"], and a @PLaneT path results in
|
@racket["<user-collects>/"], and a @PLaneT path results in
|
||||||
@racket["<planet>/"]. If the path is not absolute, or if it is not in
|
@racket["<planet>/"].
|
||||||
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
|
If the path is not absolute, or if it is not in any of these, it is
|
||||||
is returned.
|
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?]
|
@defproc[(path->relative-string/setup
|
||||||
[default any/c (lambda (x) x)])
|
[path path-string?]
|
||||||
|
[default (or/c (-> path-string? any/c) any/c)
|
||||||
|
(lambda (x) (if (path? x) (path->string x) x))])
|
||||||
any]{
|
any]{
|
||||||
Similar to @racket[path->relative-string/library], but more suited for
|
Similar to @racket[path->relative-string/library], but more suited for
|
||||||
output during compilation: @filepath{collects} paths are shown with no
|
output during compilation: @filepath{collects} paths are shown with no
|
||||||
prefix, and in the user-specific collects with just a
|
prefix, and in the user-specific collects with just a
|
||||||
@racket["<user>"] prefix.
|
@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?))]
|
@defproc[(make-path->relative-string
|
||||||
[default any/c (lambda (x) x)])
|
[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)]{
|
(path-string? any/c . -> . any)]{
|
||||||
This function produces functions like
|
This function produces functions like
|
||||||
@racket[path->relative-string/library] and
|
@racket[path->relative-string/library] and
|
||||||
|
|
|
@ -10,7 +10,8 @@
|
||||||
path->relative-string/setup
|
path->relative-string/setup
|
||||||
path->relative-string/library)
|
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)
|
(unless (and (list? dirs)
|
||||||
(andmap (lambda (x)
|
(andmap (lambda (x)
|
||||||
(and (pair? x)
|
(and (pair? x)
|
||||||
|
|
|
@ -1,6 +1,7 @@
|
||||||
|
|
||||||
(load-relative "loadtest.rktl")
|
(load-relative "loadtest.rktl")
|
||||||
|
|
||||||
|
(load-in-sandbox "setup.rktl")
|
||||||
(load-in-sandbox "for.rktl")
|
(load-in-sandbox "for.rktl")
|
||||||
(load-in-sandbox "list.rktl")
|
(load-in-sandbox "list.rktl")
|
||||||
(load-in-sandbox "math.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