From 2490b0711c27eecedc38105b5d60f8a59ad143f9 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Sun, 10 Jul 2011 06:51:57 -0400 Subject: [PATCH] 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 ebe9453e7371fba259146a5b6cc3b7a52eeb11ee) --- collects/scribblings/raco/setup.scrbl | 43 ++++++++++++++++++------- collects/setup/path-to-relative.rkt | 3 +- collects/tests/racket/scheme-tests.rktl | 1 + collects/tests/racket/setup.rktl | 24 ++++++++++++++ 4 files changed, 59 insertions(+), 12 deletions(-) create mode 100644 collects/tests/racket/setup.rktl diff --git a/collects/scribblings/raco/setup.scrbl b/collects/scribblings/raco/setup.scrbl index 93675cdada..c91b9f53fd 100644 --- a/collects/scribblings/raco/setup.scrbl +++ b/collects/scribblings/raco/setup.scrbl @@ -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["/"]. Similarly, a path in the user-specific collects results in a prefix of @racket["/"], and a @PLaneT path results in - @racket["/"]. 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["/"]. + + 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[""] 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 diff --git a/collects/setup/path-to-relative.rkt b/collects/setup/path-to-relative.rkt index 44584ac550..bc97f87601 100644 --- a/collects/setup/path-to-relative.rkt +++ b/collects/setup/path-to-relative.rkt @@ -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) diff --git a/collects/tests/racket/scheme-tests.rktl b/collects/tests/racket/scheme-tests.rktl index 8b7aef79de..a1d162f36d 100644 --- a/collects/tests/racket/scheme-tests.rktl +++ b/collects/tests/racket/scheme-tests.rktl @@ -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") diff --git a/collects/tests/racket/setup.rktl b/collects/tests/racket/setup.rktl new file mode 100644 index 0000000000..6fbf83ba9c --- /dev/null +++ b/collects/tests/racket/setup.rktl @@ -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" "/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)