test-syntax-parse.rkt (2620B)
1 #lang racket 2 3 (require "../untyped-only/syntax-parse.rkt" 4 syntax/parse 5 rackunit 6 syntax/macro-testing 7 (for-syntax racket/match)) 8 9 (check-equal? (map syntax->datum 10 (syntax-case #'(1 2 3) () 11 [(x ...) (attribute* x)])) 12 '(1 2 3)) 13 14 (check-equal? (map syntax->datum 15 (syntax-parse #'(1 2 3) 16 [(x ...) (attribute* x)])) 17 '(1 2 3)) 18 19 (check-exn #rx"not bound as an attribute or pattern variable" 20 (λ () 21 (convert-compile-time-error 22 (let ([x #'(1 2 3)]) 23 (attribute* x))))) 24 25 (define-syntax-class stxclass 26 (pattern foo)) 27 (check-true 28 (syntax-parse #'(1 2 3) 29 [(a ... sc:stxclass) 30 #:attr b 42 31 (syntax-case #'(4 5 6) () 32 [(c ...) 33 (let () 34 (define-syntax (tst stx) 35 #`#,(match (list (attribute-info #'a) 36 (attribute-info #'sc) 37 (attribute-info #'sc.foo) 38 (attribute-info #'b) 39 (attribute-info #'c) 40 ; 41 (attribute-info #'a '(pvar)) 42 (attribute-info #'sc '(pvar)) 43 (attribute-info #'sc.foo '(pvar)) 44 (attribute-info #'b '(pvar)) 45 (attribute-info #'c '(pvar)) 46 ; 47 (attribute-info #'a '(attr) #f) 48 (attribute-info #'sc '(attr) #f) 49 (attribute-info #'sc.foo '(attr) #f) 50 (attribute-info #'b '(attr) #f) 51 (attribute-info #'c '(attr) #f)) 52 [(list (list 'attr _ 1 'a #t) 53 (list 'attr _ 0 'sc #t) 54 (list 'attr _ 0 'sc.foo #t) 55 (list 'attr _ 0 'b #f) 56 (list 'pvar _ 1) 57 ; 58 (list 'pvar _ 1) 59 (list 'pvar _ 0) 60 (list 'pvar _ 0) 61 (list 'pvar _ 0) 62 (list 'pvar _ 1) 63 ; 64 (list 'attr _ 1 'a #t) 65 (list 'attr _ 0 'sc #t) 66 (list 'attr _ 0 'sc.foo #t) 67 (list 'attr _ 0 'b #f) 68 #f) 69 #t] 70 [_ 71 #f])) 72 tst)])]))