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.
This commit is contained in:
parent
1b4cb7722e
commit
2aece162a9
65
pkgs/racket-test/tests/stxparse/test-template-save-props.rkt
Normal file
65
pkgs/racket-test/tests/stxparse/test-template-save-props.rkt
Normal file
|
@ -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)
|
|
@ -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
|
Loading…
Reference in New Issue
Block a user