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

cs: reject certain srclocs in marshaled form

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
racket/src/schemify/path.rkt
View File

@ -51,13 +51,22 @@
(define p (if (path-for-srcloc? orig-p) (define p (if (path-for-srcloc? orig-p)
(path-for-srcloc-path orig-p) (path-for-srcloc-path orig-p)
orig-p)) orig-p))
(cond
[(path? p)
(or (path->relative-path-elements p) (or (path->relative-path-elements p)
(cond (cond
[(path-for-srcloc? orig-p) [(path-for-srcloc? orig-p)
;; Can't make relative, so create a string that keeps up ;; Can't make relative, so create a string that keeps up
;; to two path elements ;; to two path elements
(truncate-path p)] (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) (define (compiled-path->path e)
(cond (cond

5
racket/src/schemify/serialize.rkt
View File

@ -174,7 +174,10 @@
[(srcloc? q) [(srcloc? q)
`(unsafe-make-srcloc `(unsafe-make-srcloc
,(let ([src (srcloc-source q)]) ,(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 ;; Like paths, `path-for-srcloc` must be recognized later
(make-construct (path-for-srcloc src)) (make-construct (path-for-srcloc src))
(make-construct src))) (make-construct src)))