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

fix srcloc collapse for a path to a file in a root directory

Browse Source
This commit is contained in:
Matthew Flatt 2017-01-08 07:07:02 -06:00
parent dc9aa8a569
commit 8ff011fc51
2 changed files with 21 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
pkgs/racket-test-core/tests/racket/stx.rktl
View File

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

4
racket/src/racket/src/syntax.c
View File

@ -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("/"),