suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

repairs for srcloc-marshaling change

Browse Source 
Handle "." and ".." as one of the last two elements of a path.
This commit is contained in:
Matthew Flatt 2018-06-27 17:21:03 -06:00
parent caf1b2e275
commit fc7c4bb42c
4 changed files with 44 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
pkgs/racket-test-core/tests/racket/fasl.rktl
View File

@ -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)

10
pkgs/racket-test-core/tests/racket/print.rktl
View File

@ -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))

19
racket/collects/racket/private/truncate-path.rkt
View File

@ -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)]))

17
racket/src/racket/src/print.c
View File

@ -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);
}
}