test-or-syntax.rkt (3250B)
1 #lang racket 2 3 (require subtemplate/private/ddd 4 subtemplate/private/unsyntax-preparse 5 stxparse-info/case 6 stxparse-info/parse 7 rackunit 8 syntax/macro-testing 9 (only-in racket/base [... …])) 10 11 ;; ?? 12 13 (define (test-??-all v) 14 (syntax->datum 15 (syntax-parse v 16 [({~optional a:nat} 17 {~optional b:id} 18 {~optional c:boolean} 19 {~optional d:keyword}) 20 (quasitemplate-ddd (?? a b c d))]))) 21 22 (check-equal? (test-??-all #'(1 x #f #:kw)) '1) 23 (check-equal? (test-??-all #'(x #f #:kw)) 'x) 24 (check-equal? (test-??-all #'(#f #:kw)) '#f) 25 (check-equal? (test-??-all #'(#:kw)) '#:kw) 26 27 (check-equal? (test-??-all #'(1)) '1) 28 (check-equal? (test-??-all #'(x)) 'x) 29 (check-equal? (test-??-all #'(#f)) '#f) 30 (check-equal? (test-??-all #'(#:kw)) '#:kw) 31 32 ;; ?cond 33 34 (define (test-?cond v) 35 (syntax->datum 36 (syntax-parse v 37 [({~optional a:nat} 38 {~optional b:id} 39 {~optional c:boolean} 40 {~optional d:keyword}) 41 (quasitemplate-ddd (?cond [a 10] [b 20] [c 30] [d 40]))]))) 42 43 (check-equal? (test-?cond #'(1 x #f #:kw)) 10) 44 (check-equal? (test-?cond #'(x #f #:kw)) 20) 45 (check-equal? (test-?cond #'(#f #:kw)) 30) 46 (check-equal? (test-?cond #'(#:kw)) 40) 47 48 (check-equal? (test-?cond #'(1)) 10) 49 (check-equal? (test-?cond #'(x)) 20) 50 (check-equal? (test-?cond #'(#f)) 30) 51 (check-equal? (test-?cond #'(#:kw)) 40) 52 53 ;; ?attr 54 55 (define (test-?attr v) 56 (syntax->datum 57 (syntax-parse v 58 [({~optional a:nat} 59 {~optional b:id} 60 {~optional c:boolean} 61 {~optional d:keyword}) 62 (quasitemplate-ddd ((?attr a) (?attr b) (?attr c) (?attr d)))]))) 63 64 (check-equal? (test-?attr #'(1 x #f #:kw)) '(#t #t #t #t)) 65 (check-equal? (test-?attr #'(x #f #:kw)) '(#f #t #t #t)) 66 (check-equal? (test-?attr #'(#f #:kw)) '(#f #f #t #t)) 67 (check-equal? (test-?attr #'(#:kw)) '(#f #f #f #t)) 68 69 (check-equal? (test-?attr #'(1)) '(#t #f #f #f)) 70 (check-equal? (test-?attr #'(x)) '(#f #t #f #f)) 71 (check-equal? (test-?attr #'(#f)) '(#f #f #t #f)) 72 (check-equal? (test-?attr #'(#:kw)) '(#f #f #f #t)) 73 74 ;; ?if 75 76 (define (test-?if v) 77 (syntax->datum 78 (syntax-parse v 79 [({~optional a:nat} 80 {~optional b:id} 81 {~optional c:boolean}) 82 (quasitemplate-ddd (?if a b c))]))) 83 84 (check-equal? (test-?if #'(1 x #f)) 'x) 85 (check-equal? (test-?if #'(x #f)) '#f) 86 (check-equal? (test-?if #'(#f)) '#f) 87 (check-exn #rx"attribute contains non-syntax value" 88 (λ () 89 (convert-compile-time-error 90 (check-equal? (test-?if #'(1 #f)) '#f)))) 91 92 (check-equal? (syntax->datum 93 (syntax-parse #'(1 x) 94 [({~optional a:nat} 95 {~optional b:id} 96 {~optional c:boolean} 97 {~optional d:keyword}) 98 (quasitemplate-ddd (?if a (?if b a d) 0))])) 99 1) 100 101 ;; ?@@ 102 103 (check-equal? (syntax->datum 104 (syntax-parse #'((1 2 3) (x y) (#f)) 105 [(a b c) 106 (quasitemplate-ddd ({?@@ a b c}))])) 107 '(1 2 3 x y #f)) 108 109 (check-equal? (syntax->datum 110 (syntax-parse #'((1 2 3) (x y) (#f)) 111 [whole 112 (quasitemplate-ddd ({?@@ . whole}))])) 113 '(1 2 3 x y #f))