diff --git a/racket/collects/racket/private/truncate-path.rkt b/racket/collects/racket/private/truncate-path.rkt index cf71938c37..00d5c2f07e 100644 --- a/racket/collects/racket/private/truncate-path.rkt +++ b/racket/collects/racket/private/truncate-path.rkt @@ -1,30 +1,37 @@ #lang racket/base (provide truncate-path) -;; Drop information from the path `p` in the same way as marshaling a -;; path in a srcloc as part of compiled code +;; Drop information from the path-for-some-system `p` in the same way +;; as marshaling a path in a srcloc as part of compiled code (define (truncate-path p) (define-values (base1 name1 dir?) (split-path p)) (cond - [(path? base1) + [(path-for-some-system? base1) (define-values (base2 name2 dir?) (split-path base1)) (cond [(not base2) ;; Path at a root - (path->string p)] + (path-for-some-system->string p)] [(symbol? name2) ;; "." or ".." before a name (string-append ".../" (path-elem->string name1))] [else - (string-append ".../" (path->string name2) "/" (path-elem->string name1))])] + (string-append ".../" (path-for-some-system->string name2) "/" (path-elem->string name1))])] [(eq? base1 'relative) (path-elem->string name1)] [else ;; Path is a root, ".", or ".." - (path->string p)])) + (path-for-some-system->string p)])) (define (path-elem->string p) (cond [(eq? p 'same) "."] [(eq? p 'up) ".."] - [else (path->string p)])) + [else (path-for-some-system->string p)])) + +(define (path-for-some-system->string p) + (cond + [(path? p) (path->string p)] + [else + ;; There's no right answer here, but UTF-8 likely works out + (bytes->string/utf-8 (path->bytes p) #\uFFFD)])) diff --git a/racket/src/schemify/wrap-path.rkt b/racket/src/schemify/wrap-path.rkt index 6d1865cc5e..ff4b5d75be 100644 --- a/racket/src/schemify/wrap-path.rkt +++ b/racket/src/schemify/wrap-path.rkt @@ -15,11 +15,13 @@ (define u-e (wrap-truncate-paths orig)) (define-values (src line col pos span) (wrap-source e)) (cond - [(and (not (path? src)) + [(and (not (path-for-some-system? src)) (eq? orig u-e)) e] + [(path-for-some-system? src) + (reannotate/new-srcloc e u-e (srcloc (truncate-path src) line col pos span))] [else - (reannotate/new-srcloc e u-e (srcloc (truncate-path src) line col pos span))])] + (reannotate e u-e)])] [(pair? e) (define a (wrap-truncate-paths (car e))) (define d (wrap-truncate-paths (cdr e)))