www

commit 2aece162a90a6257cfb9ad1aea877d11be5c500a
parent 1b4cb7722eab8d609450420d6db29cd9729db928
Author: Georges Dupéron <georges.duperon@gmail.com>
Date:   Sat, 21 Jan 2017 18:04:37 +0100

Fixes several issues with syntax/parse, and adds some tests.

* byte-regexp? values should not be considered 3D syntax.
* hash? values are now allowed in serialized syntax properties with (template … #:properties (…))
* marshalling properties which were prefab structs called map on the result of struct->vector, changed it to struct->list as the struct "name" is always serializable.

Diffstat:
A
pkgs/racket-test/tests/stxparse/test-template-save-props.rkt
 | 
66
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
A
pkgs/racket-test/tests/stxparse/test-template-saved-props.rkt
 | 
25
+++++++++++++++++++++++++

2 files changed, 91 insertions(+), 0 deletions(-)
diff --git a/pkgs/racket-test/tests/stxparse/test-template-save-props.rkt b/pkgs/racket-test/tests/stxparse/test-template-save-props.rkt
@@ -0,0 +1,65 @@
+#lang racket
+(require syntax/parse
+         syntax/parse/experimental/template)
+
+(begin-for-syntax
+  (struct prefab-st (a b c) #:prefab)
+  (struct st (a b c))
+  (define (syntax-properties s . p*)
+    (if (null? p*)
+        s
+        (apply syntax-properties
+               (syntax-property s (car p*) (cadr p*))
+               (cddr p*)))))
+
+(define-syntax (define-with-prop stx)
+  (syntax-case stx ()
+    [(_ name)
+     #`(define (name)
+         (syntax-parse #'1
+           [v
+            (template #,(syntax-properties #'(v)
+                                           'null '()
+                                           'string "str"
+                                           'bytes #"by"
+                                           'number 123.4
+                                           'boolean #t
+                                           'char #\c
+                                           'keyword '#:kw
+                                           'regexp #rx".*"
+                                           'pregexp #px".*"
+                                           'byte-regexp #rx#".*"
+                                           'byte-pregexp #px#".*"
+                                           'box #&bx
+                                           'symbol 'sym
+                                           'pair '(a . b)
+                                           'vector #(1 2 3)
+                                           'hash #hash([a . 1] [b . 2])
+                                           'hasheq #hasheq([a . 1] [b . 2])
+                                           'hasheqv #hasheqv([a . 1] [b . 2])
+                                           'prefab-st (prefab-st 'x 'y 'z)
+                                           'st (st 'x 'y 'z))
+                      #:properties (null
+                                    string
+                                    bytes
+                                    number
+                                    boolean
+                                    char
+                                    keyword
+                                    regexp
+                                    pregexp
+                                    byte-regexp
+                                    byte-pregexp
+                                    box
+                                    symbol
+                                    pair
+                                    vector
+                                    hash
+                                    hasheq
+                                    hasheqv
+                                    prefab-st
+                                    st))]))]))
+
+(define-with-prop get-syntax-with-saved-props)
+
+(provide get-syntax-with-saved-props)
+\ No newline at end of file
diff --git a/pkgs/racket-test/tests/stxparse/test-template-saved-props.rkt b/pkgs/racket-test/tests/stxparse/test-template-saved-props.rkt
@@ -0,0 +1,24 @@
+#lang racket
+(require "test-template-save-props.rkt"
+         rackunit)
+(define s (get-syntax-with-saved-props))
+(check-equal? (syntax-property s 'null) '())
+(check-equal? (syntax-property s 'string) "str")
+(check-equal? (syntax-property s 'bytes) #"by")
+(check-equal? (syntax-property s 'number) 123.4)
+(check-equal? (syntax-property s 'boolean) #t)
+(check-equal? (syntax-property s 'char) #\c)
+(check-equal? (syntax-property s 'keyword) '#:kw)
+(check-equal? (syntax-property s 'regexp) #rx".*")
+(check-equal? (syntax-property s 'pregexp) #px".*")
+(check-equal? (syntax-property s 'byte-regexp) #rx#".*")
+(check-equal? (syntax-property s 'byte-pregexp) #px#".*")
+(check-equal? (syntax-property s 'box) #&bx)
+(check-equal? (syntax-property s 'symbol) 'sym)
+(check-equal? (syntax-property s 'pair) '(a . b))
+(check-equal? (syntax-property s 'vector) #(1 2 3))
+(check-equal? (syntax-property s 'hash) #hash([a . 1] [b . 2]))
+(check-equal? (syntax-property s 'hasheq) #hasheq([a . 1] [b . 2]))
+(check-equal? (syntax-property s 'hasheqv) #hasheqv([a . 1] [b . 2]))
+(check-equal? (syntax-property s 'prefab-st) #s(prefab-st x y z))
+(check-equal? (syntax-property s 'st) #f) ; st is not serializable, should be #f
+\ No newline at end of file