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

fix unmarshaling of perserved syntax properties

Browse Source 
Unmarshaling was broken for a syntax object that doesn't have
a 'paren-shape property.
This commit is contained in:
Matthew Flatt 2016-04-24 07:19:02 -06:00
parent 68b8bf760a
commit 18fd9949a6
2 changed files with 29 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
pkgs/racket-test-core/tests/racket/stx.rktl
View File

@ -2338,7 +2338,34 @@
(test #t syntax-property-preserved? s0 'a-third-thing) (test #t syntax-property-preserved? s0 'a-third-thing)
;; 'paren-shape has a special default: ;; 'paren-shape has a special default:
(test #t syntax-property-preserved? (syntax-property #'#f 'paren-shape #\() 'paren-shape)) (test #t syntax-property-preserved? (syntax-property #'#f 'paren-shape #\() 'paren-shape)
;; Without 'paren-shape ------------------------------
(define s2-0 (syntax-property
(syntax-property
(syntax-property #'0 'something-else 1.0 #t)
'something-not-saved 2.0)
'a-third-thing 3.0 #t))
(define s2 (zo-bounce s2-0))
(test #f syntax-property s2 'paren-shape)
(test #f syntax-property s2-0 'paren-shape)
(test 1.0 syntax-property s2 'something-else)
(test 1.0 syntax-property s2-0 'something-else)
(test #t syntax-property-preserved? s2 'something-else)
(test #t syntax-property-preserved? s2-0 'something-else)
(test #f syntax-property s2 'something-not-saved)
(test 2.0 syntax-property s2-0 'something-not-saved)
(test #f syntax-property-preserved? s2 'something-not-saved)
(test #f syntax-property-preserved? s2-0 'something-not-saved)
(test 3.0 syntax-property s2 'a-third-thing)
(test 3.0 syntax-property s2-0 'a-third-thing)
(test #t syntax-property-preserved? s2 'a-third-thing)
(test #t syntax-property-preserved? s2-0 'a-third-thing))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

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

@ -6530,7 +6530,7 @@ static void unconvert_srcloc(Scheme_Object *srcloc_vec, Scheme_Stx *dest)
if (SCHEME_PAIRP(p) if (SCHEME_PAIRP(p)
&& SCHEME_SYMBOLP(SCHEME_CAR(p)) && SCHEME_SYMBOLP(SCHEME_CAR(p))
&& !SCHEME_SYM_WEIRDP(SCHEME_CAR(p))) { && !SCHEME_SYM_WEIRDP(SCHEME_CAR(p))) {
props = scheme_hash_tree_set(dest->props, props = scheme_hash_tree_set((dest->props ? dest->props : empty_hash_tree),
SCHEME_CAR(p), SCHEME_CAR(p),
make_preserved_property_value(SCHEME_CDR(p))); make_preserved_property_value(SCHEME_CDR(p)));
dest->props = props; dest->props = props;