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

fix .zo marshal of a syntax object containing a hash table in a list

Browse Source 
Also, fix `zo-parse` unmarshaling of syntax-object hash tables.

Closes PR 14087
This commit is contained in:
Matthew Flatt 2013-10-09 07:09:36 -06:00
parent f649599681
commit 70b6f6464f
3 changed files with 26 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
pkgs/compiler-lib/compiler/zo-parse.rkt
View File

@ -608,24 +608,27 @@
[(pair? v)
(if (eq? #t (car v))
;; Share decoded wraps with all nested parts.
(let loop ([v (cdr v)])
(let iloop ([v (cdr v)])
(cond
[(pair? v)
(let ploop ([v v])
(cond
[(null? v) null]
[(pair? v) (add-wrap (cons (loop (car v)) (ploop (cdr v))))]
[else (loop v)]))]
[(box? v) (add-wrap (box (loop (unbox v))))]
[(pair? v) (add-wrap (cons (iloop (car v)) (ploop (cdr v))))]
[else (iloop v)]))]
[(box? v) (add-wrap (box (iloop (unbox v))))]
[(vector? v)
(add-wrap (list->vector (map loop (vector->list v))))]
(add-wrap (list->vector (map iloop (vector->list v))))]
[(hash? v)
(add-wrap (for/hash ([(k v) (in-hash v)])
(values k (iloop v))))]
[(prefab-struct-key v)
=> (lambda (k)
(add-wrap
(apply
make-prefab-struct
k
(map loop (struct->list v)))))]
(map iloop (struct->list v)))))]
[else (add-wrap v)]))
;; Decode sub-elements that have their own wraps:
(let-values ([(v counter) (if (exact-integer? (car v))
@ -641,6 +644,9 @@
[(box? v) (add-wrap (box (loop (unbox v))))]
[(vector? v)
(add-wrap (list->vector (map loop (vector->list v))))]
[(hash? v)
(add-wrap (for/hash ([(k v) (in-hash v)])
(values k (loop v))))]
[(prefab-struct-key v)
=> (lambda (k)
(add-wrap

13
pkgs/racket-pkgs/racket-test/tests/racket/syntax.rktl
View File

@ -1799,6 +1799,19 @@
(compile '(#%variable-reference))
(expand '(#%variable-reference))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check marshal & unmarshal of a syntax object
;; containing a list with a hash table
(let ([v #'(quote-syntax (#hash((1 . 2))))])
(define-values (i o) (make-pipe))
(write (compile v) o)
(close-output-port o)
(define e
(parameterize ([read-accept-compiled #t])
(read i)))
(test (syntax->datum (eval v)) syntax->datum (eval e)))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs)

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

@ -6594,7 +6594,7 @@ static Scheme_Object *extract_for_common_wrap(Scheme_Object *a, int get_mark, in
else
return SCHEME_CDR(v);
}
} else if (!SCHEME_BOXP(v) && !SCHEME_VECTORP(v) && !prefab_p(v)) {
} else if (!SCHEME_BOXP(v) && !SCHEME_VECTORP(v) && !SCHEME_HASHTRP(v) && !prefab_p(v)) {
/* It's atomic. */
if (get_mark)
return SCHEME_CDR(a);