cs: fix truncation of path information in optimization info

Handle not-this-platform paths that manage to evade the heuristics for
converting paths to and from relative form. Otherwise, building can go
wrong on on Windows when using machine-independent starting files
generated on Unix-like systems.
This commit is contained in:
Matthew Flatt 2019-03-06 14:00:27 -07:00
parent 875e3b290d
commit d9d8d39f00
2 changed files with 18 additions and 9 deletions

View File

@ -1,30 +1,37 @@
#lang racket/base #lang racket/base
(provide truncate-path) (provide truncate-path)
;; Drop information from the path `p` in the same way as marshaling a ;; Drop information from the path-for-some-system `p` in the same way
;; path in a srcloc as part of compiled code ;; as marshaling a path in a srcloc as part of compiled code
(define (truncate-path p) (define (truncate-path p)
(define-values (base1 name1 dir?) (split-path p)) (define-values (base1 name1 dir?) (split-path p))
(cond (cond
[(path? base1) [(path-for-some-system? base1)
(define-values (base2 name2 dir?) (split-path base1)) (define-values (base2 name2 dir?) (split-path base1))
(cond (cond
[(not base2) [(not base2)
;; Path at a root ;; Path at a root
(path->string p)] (path-for-some-system->string p)]
[(symbol? name2) [(symbol? name2)
;; "." or ".." before a name ;; "." or ".." before a name
(string-append ".../" (path-elem->string name1))] (string-append ".../" (path-elem->string name1))]
[else [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) [(eq? base1 'relative)
(path-elem->string name1)] (path-elem->string name1)]
[else [else
;; Path is a root, ".", or ".." ;; Path is a root, ".", or ".."
(path->string p)])) (path-for-some-system->string p)]))
(define (path-elem->string p) (define (path-elem->string p)
(cond (cond
[(eq? p 'same) "."] [(eq? p 'same) "."]
[(eq? p 'up) ".."] [(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)]))

View File

@ -15,11 +15,13 @@
(define u-e (wrap-truncate-paths orig)) (define u-e (wrap-truncate-paths orig))
(define-values (src line col pos span) (wrap-source e)) (define-values (src line col pos span) (wrap-source e))
(cond (cond
[(and (not (path? src)) [(and (not (path-for-some-system? src))
(eq? orig u-e)) (eq? orig u-e))
e] e]
[(path-for-some-system? src)
(reannotate/new-srcloc e u-e (srcloc (truncate-path src) line col pos span))]
[else [else
(reannotate/new-srcloc e u-e (srcloc (truncate-path src) line col pos span))])] (reannotate e u-e)])]
[(pair? e) [(pair? e)
(define a (wrap-truncate-paths (car e))) (define a (wrap-truncate-paths (car e)))
(define d (wrap-truncate-paths (cdr e))) (define d (wrap-truncate-paths (cdr e)))