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.

pkgs/racket-test/tests/stxparse/setup.rkt

@@ -8,6 +8,7 @@
          (for-syntax racket/base))
 
 (provide tok
+         t3d
          terx
          terx*
          tcerr
@@ -64,6 +65,35 @@ Auxiliaries
     [(tok s p)
      #'(tok s p 'ok)]))
 
+(define-syntax (t3d stx)
+  (syntax-case stx ()
+    [(_ #:pass [pass ...] #:fail [fail ...])
+     (with-syntax ([(pass-line ...) (map syntax-line
+                                         (syntax->list #'(pass ...)))]
+                   [(fail-line ...) (map syntax-line
+                                         (syntax->list #'(fail ...)))])
+     #`(begin
+         (test-case (format "line ~s: ~a should not be 3D syntax"
+                            'pass-line
+                            'pass)
+                    (check-not-exn
+                     (λ ()
+                       (syntax-parse (quote-syntax ())
+                         [_
+                          #:with _ pass
+                          'ok]))))
+         ...
+         (test-case (format "line ~s: ~a should be rejected 3D syntax"
+                            'fail-line
+                            'fail)
+                    (check-exn #px"implicit conversion to 3D syntax"
+                     (λ ()
+                       (syntax-parse (quote-syntax ())
+                         [_
+                          #:with _ fail
+                          'ok]))))
+         ...))]))
+
 (define-syntax-rule (bound b ...)
   (begin (bound1 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)

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

pkgs/racket-test/tests/stxparse/test.rkt

@@ -50,22 +50,92 @@
 (terx (1 (2 3)) (_:one _:two) "expected one")
 (terx ((1) 2) (_:one _:two) "expected two")
 
-;; datum patterns
+(test-case "datum patterns"
-(tok 1 1
+  (tok () ()
-     'ok)
+       'ok
-(tok 1 _
+       #:pre [(_) 0] #:post [])
-     #t
+  (tok "here" "here"
-     #:pre [2] #:post [])
+       'ok
-(tok "here" "here"
+       #:pre ["there" #"here" 0] #:post [])
-     'ok
+  (tok #"byte" #"byte"
-     #:pre ["there"] #:post [])
+       'ok
-(tok #f #f
+       #:pre [#"other" "byte" 0] #:post [])
-     'ok
+  (tok 1 1
-     #:pre [#t 0] #:post [_])
+       'ok)
+  (tok 1 _
+       #t
+       #:pre [2] #:post [])
+  (tok #f #f
+       'ok
+       #:pre [#t 0] #:post [_])
+  (tok #\c #\c
+       'ok
+       #:pre [#\d "c" 0] #:post [_])
+  (tok #:kw #:kw
+       'ok
+       #:pre [#:other {~datum kw} "kw" 0] #:post [_])
+  (tok #rx".*" #rx".*"
+       'ok
+       #:pre [#rx"." #px".*" #rx#".*" #px#".*"] #:post [_])
+  (tok #px".*" #px".*"
+       'ok
+       #:pre [#px"." #rx".*" #rx#".*" #px#".*"] #:post [_])
+  (tok #rx#".*" #rx#".*"
+       'ok
+       #:pre [#rx#"." #px#".*" #rx".*" #px".*"] #:post [_])
+  (tok #px#".*" #px#".*"
+       'ok
+       #:pre [#px#"." #rx#".*" #rx".*" #px".*"] #:post [_])
+  (tok #&"box" #&"box"
+       'ok
+       #:pre [#&"other" {~datum #&_} 0] #:post [_])
+  (tok #&_ #&_
+       'ok
+       #:pre [{~datum #&other}] #:post [_])
+  (tok #&xyz {~datum #&xyz}
+       'ok)
+  (tok xyz {~datum xyz}
+       'ok)
+  (tok (a . b) {~datum (a . b)}
+       'ok
+       #:pre [{~datum (_ . _)}] #:post [_])
+  (tok (a b c) {~datum (a b c)}
+       'ok
+       #:pre [{~datum (_ _ _)} {~datum (_ . _)}] #:post [_])
 
-(terx 1 2 "literal 2")
+  (tok #(1 2 3) {~datum #(1 2 3)}
-(terx (1 2) 1 "literal 1")
+       'ok
-(terx (1 2) (1 1) "literal 1")
+       #:pre [{~datum #(_ _ _)}] #:post [_])
+  (tok #hash([a . 1] [b . 2]) {~datum #hash([b . 2] [a . 1])}
+       'ok
+       #:pre [{~datum #hash([_ . 1] [_ . 2])}
+              {~datum #hash([a . _] [b . _])}
+              {~datum #hasheq([a . 1] [b . 2])}
+              {~datum #hasheqv([a . 1] [b . 2])}]
+       #:post [_])
+  (tok #hasheq([a . 1] [b . 2]) {~datum #hasheq([b . 2] [a . 1])}
+       'ok
+       #:pre [{~datum #hasheq([_ . 1] [_ . 2])}
+              {~datum #hasheq([a . _] [b . _])}
+              {~datum #hash([a . 1] [b . 2])}
+              {~datum #hasheqv([a . 1] [b . 2])}]
+       #:post [_])
+  (tok #hasheqv([a . 1] [b . 2]) {~datum #hasheqv([b . 2] [a . 1])}
+       'ok
+       #:pre [{~datum #hasheqv([_ . 1] [_ . 2])}
+              {~datum #hasheqv([a . _] [b . _])}
+              {~datum #hasheq([a . 1] [b . 2])}
+              {~datum #hash([a . 1] [b . 2])}]
+       #:post [_])
+  (tok #s(prefab-st x y z) {~datum #s(prefab-st x y z)}
+       'ok
+       #:pre [{~datum #s(prefab-st _ _ _)}] #:post [_])
+  (tok #s(prefab-st x y z) #s(prefab-st _ _ _)
+       'ok)
+
+  (terx 1 2 "literal 2")
+  (terx (1 2) 1 "literal 1")
+  (terx (1 2) (1 1) "literal 1"))
 
 ;; literal patterns
 (test-case "literals: +"
@@ -702,3 +772,33 @@
 ;; nullable but bounded EH pattern ok (thanks Alex Knauth) (7/2016)
 (tok (1 2 3) ((~once (~seq)) ... n:nat ...) 'ok)
 (tok (1 2 3) ((~once (~or (~seq a:id) (~seq))) ... x y z) 'ok)
+
+(struct s-3d () #:transparent)
+(test-case "3D syntax checks"
+           (t3d #:pass ['()
+                        '"here"
+                        '#"byte"
+                        '1
+                        '123.4
+                        '+inf.f
+                        '#t
+                        '#f
+                        '#\c
+                        '#:kw
+                        '#rx".*"
+                        '#px".*"
+                        '#rx#".*"
+                        '#px#".*"
+                        '#&"box"
+                        '#&box
+                        'xyz
+                        '(a . b)
+                        '(a b c)
+                        '#(1 2 3)
+                        '#s(prefab-st x y z)
+                        '#hash([a . 1] [b . 2])
+                        '#hasheq([a . 1] [b . 2])
+                        '#hasheqv([a . 1] [b . 2])]
+                #:fail [(s-3d)
+                        (vector-immutable 1 (s-3d) 3)
+                        (list 'a (s-3d) 'c)]))

racket/collects/syntax/parse/experimental/template.rkt

@@ -4,7 +4,8 @@
                      racket/syntax
                      syntax/parse/private/minimatch
                      racket/private/stx ;; syntax/stx
-                     racket/private/sc)
+                     racket/private/sc
+                     racket/struct)
          syntax/parse/private/residual
          "private/substitute.rkt")
 (provide template
@@ -403,11 +404,13 @@ instead of integers and integer vectors.
        (char? v)
        (keyword? v)
        (regexp? v)
+       (byte-regexp? v)
        (and (box? v) (quotable? (unbox v)))
        (and (symbol? v) (symbol-interned? v))
        (and (pair? v) (quotable? (car v)) (quotable? (cdr v)))
        (and (vector? v) (andmap quotable? (vector->list v)))
-       (and (prefab-struct-key v) (andmap quotable? (struct->vector v)))))
+       (and (hash? v) (andmap quotable? (hash->list v)))
+       (and (prefab-struct-key v) (andmap quotable? (struct->list v)))))
 
  (define (cons-guide g1 g2)
    (if (and (eq? g1 '_) (eq? g2 '_)) '_ (cons g1 g2)))

racket/collects/syntax/parse/private/3d-stx.rkt

@@ -174,6 +174,7 @@ period.
           (char? x)
           (keyword? x)
           (regexp? x)
+          (byte-regexp? x)
           (extflonum? x))
       fuel]
      [(symbol? x)

racket/collects/syntax/parse/private/rep.rkt

@@ -83,7 +83,8 @@
         (keyword? datum)
         (bytes? datum)
         (char? datum)
-        (regexp? datum))))
+        (regexp? datum)
+        (byte-regexp? datum))))
 
 (define (id-predicate kw)
   (lambda (stx)