cs: reject certain srclocs in marshaled form

This commit is contained in:
Matthew Flatt 2019-01-31 08:55:05 -07:00
parent cf72bace95
commit 8b4075bd3d
2 changed files with 20 additions and 8 deletions

View File

@ -51,13 +51,22 @@
(define p (if (path-for-srcloc? orig-p)
(path-for-srcloc-path orig-p)
orig-p))
(cond
[(path? p)
(or (path->relative-path-elements p)
(cond
[(path-for-srcloc? orig-p)
;; Can't make relative, so create a string that keeps up
;; to two path elements
(truncate-path p)]
[else (path->bytes p)]))))
[else (path->bytes p)]))]
[(or (string? p) (bytes? p) (symbol? p) (not p))
;; Allowed in compiled form
p]
[else
(error 'write
"cannot marshal value that is embedded in compiled code: ~V"
p)])))
(define (compiled-path->path e)
(cond

View File

@ -174,7 +174,10 @@
[(srcloc? q)
`(unsafe-make-srcloc
,(let ([src (srcloc-source q)])
(if (and (path? src) (not for-cify?))
(if (and (not for-cify?)
;; Need to handle paths, need to reject (later) anything other
;; than a few type slike strings and byte strings
(not (or (string? src) (bytes? src) (symbol? src) (not src))))
;; Like paths, `path-for-srcloc` must be recognized later
(make-construct (path-for-srcloc src))
(make-construct src)))