From 8ff011fc51fa064f30cec993677f8b124cd17eed Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 8 Jan 2017 07:07:02 -0600 Subject: [PATCH] fix srcloc collapse for a path to a file in a root directory --- pkgs/racket-test-core/tests/racket/stx.rktl | 17 +++++++++++++++++ racket/src/racket/src/syntax.c | 4 ++++ 2 files changed, 21 insertions(+) diff --git a/pkgs/racket-test-core/tests/racket/stx.rktl b/pkgs/racket-test-core/tests/racket/stx.rktl index f272cd88f2..2a3c417acf 100644 --- a/pkgs/racket-test-core/tests/racket/stx.rktl +++ b/pkgs/racket-test-core/tests/racket/stx.rktl @@ -2468,6 +2468,23 @@ (check-bad (read (open-input-string "#0=(1 . #0#)"))) (check-bad void)) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Make sure the srcloc encoding doesn't do something strange +;; with a path in a root directory: + +(parameterize ([current-namespace (make-base-namespace)]) + (define path (build-path (car (filesystem-root-list)) "x.rkt")) + (parameterize ([current-module-declare-name (make-resolved-module-path path)] + [read-accept-reader #t] + [read-accept-compiled #t]) + (define p (open-input-string "#lang racket/base (provide f) (define (f) #'a)")) + (port-count-lines! p) + (define-values (in out) (make-pipe)) + (write (compile (read-syntax path p)) out) + (eval (read in)) + (define src (syntax-source ((dynamic-require path 'f)))) + (test (path->string path) values src))) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (report-errs) diff --git a/racket/src/racket/src/syntax.c b/racket/src/racket/src/syntax.c index 6aaa2576be..617c3dc7c8 100644 --- a/racket/src/racket/src/syntax.c +++ b/racket/src/racket/src/syntax.c @@ -6445,6 +6445,10 @@ static Scheme_Object *srcloc_path_to_string(Scheme_Object *p) 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)) { 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(dir_name)) name = scheme_append_strings(scheme_path_to_char_string(dir_name), scheme_append_strings(scheme_make_utf8_string("/"),