diff --git a/pkgs/racket-test-core/tests/racket/fasl.rktl b/pkgs/racket-test-core/tests/racket/fasl.rktl index d946ee564e..f805c34ea6 100644 --- a/pkgs/racket-test-core/tests/racket/fasl.rktl +++ b/pkgs/racket-test-core/tests/racket/fasl.rktl @@ -96,7 +96,9 @@ (test (srcloc "there" 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc windows-path 1 2 3 4)))) (let ([root (car (filesystem-root-list))]) (test (srcloc (path->string root) 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc root 1 2 3 4))) - (test (srcloc (path->string (build-path root "x")) 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path root "x") 1 2 3 4)))) + (test (srcloc (path->string (build-path root "x")) 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path root "x") 1 2 3 4))) + (test (srcloc (path->string (build-path root 'up)) 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path root 'up) 1 2 3 4))) + (test (srcloc (path->string (build-path root 'same)) 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path root 'same) 1 2 3 4)))) (test (srcloc ".../a/b" 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path (current-directory) "a" "b") 1 2 3 4))))) (let* ([rel-p (build-path "nested" "data.rktd")] @@ -113,4 +115,9 @@ (test p fasl->s-exp bstr) (test (srcloc p 10 20 30 40) fasl->s-exp srcloc-bstr))) +(test (srcloc ".../a" 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path 'up "a") 1 2 3 4))) +(test (srcloc ".../a" 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path 'same "a") 1 2 3 4))) +(test (srcloc ".../a/.." 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path "a" 'up) 1 2 3 4))) +(test (srcloc ".../a/." 1 2 3 4) fasl->s-exp (s-exp->fasl (srcloc (build-path "a" 'same) 1 2 3 4))) + (report-errs) diff --git a/pkgs/racket-test-core/tests/racket/print.rktl b/pkgs/racket-test-core/tests/racket/print.rktl index 4557b73e80..896226a308 100644 --- a/pkgs/racket-test-core/tests/racket/print.rktl +++ b/pkgs/racket-test-core/tests/racket/print.rktl @@ -364,6 +364,16 @@ (try "apple") (try #"apple") (try (string->path "apple") "apple") + (try (build-path 'up) "..") + (try (build-path 'same) ".") + (try (build-path 'up "apple") ".../apple") + (try (build-path "x" 'up "apple") ".../apple") + (try (build-path "apple" 'up) ".../apple/..") + (try (build-path "apple" 'same) ".../apple/.") + (try (build-path "x" "apple" 'up) ".../apple/..") + (try (build-path "x" "apple" 'same) ".../apple/.") + (let ([d (car (filesystem-root-list))]) + (try (build-path d 'up) (path->string (build-path d 'up)))) (try 7 #:ok? #f) (try (box 7) #:ok? #f)) diff --git a/racket/collects/racket/private/truncate-path.rkt b/racket/collects/racket/private/truncate-path.rkt index 8217285c27..cf71938c37 100644 --- a/racket/collects/racket/private/truncate-path.rkt +++ b/racket/collects/racket/private/truncate-path.rkt @@ -12,10 +12,19 @@ [(not base2) ;; Path at a root (path->string p)] + [(symbol? name2) + ;; "." or ".." before a name + (string-append ".../" (path-elem->string name1))] [else - (string-append ".../" (path->string name2) "/" (path->string name1))])] + (string-append ".../" (path->string name2) "/" (path-elem->string name1))])] [(eq? base1 'relative) - (path->string name1)] - [else - ;; Path is a root - (path->string p)])) + (path-elem->string name1)] + [else + ;; Path is a root, ".", or ".." + (path->string p)])) + +(define (path-elem->string p) + (cond + [(eq? p 'same) "."] + [(eq? p 'up) ".."] + [else (path->string p)])) diff --git a/racket/src/racket/src/print.c b/racket/src/racket/src/print.c index 5df522283b..97851abf80 100644 --- a/racket/src/racket/src/print.c +++ b/racket/src/racket/src/print.c @@ -4311,23 +4311,30 @@ static Scheme_Object *srcloc_path_to_string(Scheme_Object *p) int isdir; name = scheme_split_path(SCHEME_PATH_VAL(p), SCHEME_PATH_LEN(p), &base, &isdir, SCHEME_PLATFORM_PATH_KIND); - if (SCHEME_PATHP(name) && SCHEME_PATHP(base)) { + if ((SCHEME_PATHP(name) || SCHEME_SYMBOLP(name)) && SCHEME_PATHP(base)) { dir_name = scheme_split_path(SCHEME_PATH_VAL(base), SCHEME_PATH_LEN(base), &base, &isdir, SCHEME_PLATFORM_PATH_KIND); if (SCHEME_FALSEP(base)) { /* Path is file at root, so just keep the whole path */ return scheme_path_to_char_string(p); } + if (SCHEME_PATHP(name)) + name = scheme_path_to_char_string(name); + else { + /* convert "." or ".." */ + if (!strcmp(SCHEME_SYM_VAL(name), "up")) + name = scheme_make_utf8_string(".."); + else + name = scheme_make_utf8_string("."); + } if (SCHEME_PATHP(dir_name)) name = scheme_append_strings(scheme_path_to_char_string(dir_name), scheme_append_strings(scheme_make_utf8_string("/"), - scheme_path_to_char_string(name))); - else - name = scheme_path_to_char_string(name); + name)); return scheme_append_strings(scheme_make_utf8_string(".../"), name); } else if (SCHEME_PATHP(name)) return scheme_path_to_char_string(name); else { - /* original path is a root */ + /* original path is a root, ".", or ".." */ return scheme_path_to_char_string(p); } }