test-ddd-top.rkt (6035B)
1 #lang racket 2 3 (require subtemplate/private/top-subscripts 4 subtemplate/private/ddd-forms 5 (only-in subtemplate/private/ddd ddd) 6 (except-in subtemplate/private/override ?? ?@) 7 stxparse-info/case 8 stxparse-info/parse 9 rackunit 10 syntax/macro-testing 11 phc-toolkit/untyped 12 (only-in racket/base [... …])) 13 14 (check-equal? (syntax-parse #'(a b c) 15 [(xᵢ …) 16 yᵢ]) 17 '(a/y b/y c/y)) 18 19 (check-equal? (syntax-case #'(a b c) () 20 [(xᵢ …) 21 (yᵢ …)]) 22 '(a/y b/y c/y)) 23 24 (check-equal? (syntax-case #'(a b c) () 25 [(xᵢ …) 26 ([list xᵢ yᵢ] …)]) 27 '([a a/y] [b b/y] [c c/y])) 28 29 (check-equal? (syntax-case #'(a b c) () 30 [(xᵢ …) 31 ({?@ xᵢ yᵢ} …)]) 32 '(a a/y b b/y c c/y)) 33 34 (check-match (syntax-case #'(a b c) () 35 [(xᵢ …) 36 (list #'yᵢ …)]) 37 (list (? syntax?) (? syntax?) (? syntax?))) 38 39 (check-equal? (map syntax->datum 40 (syntax-case #'(a b c) () 41 [(xᵢ …) 42 (list #'yᵢ …)])) 43 '(a/y b/y c/y)) 44 45 (check-match (syntax-case #'([a b c] [d e]) () 46 [((xᵢ …) …) 47 (list (list #'yᵢ …) …)]) 48 (list (list (? syntax?) (? syntax?) (? syntax?)) 49 (list (? syntax?) (? syntax?)))) 50 51 (check-equal? (map (curry map syntax->datum) 52 (syntax-case #'([a b c] [d e]) () 53 [((xᵢ …) …) 54 (list (list #'yᵢ …) …)])) 55 '([a/y b/y c/y] [d/y e/y])) 56 57 (check-match (syntax-case #'([(a1 a2) (b1) (c1 c2 c3)] 58 [(d1 d2 d3 d4) (e1 e2 e3 e4 e5)]) () 59 [(((xᵢ …) …) …) 60 (list (list (list #'yᵢ …) …) …)]) 61 (list (list (list (? syntax?) (? syntax?)) 62 (list (? syntax?)) 63 (list (? syntax?) (? syntax?) (? syntax?))) 64 (list (list (? syntax?) (? syntax?) (? syntax?) (? syntax?)) 65 (list (? syntax?) (? syntax?) (? syntax?) 66 (? syntax?) (? syntax?))))) 67 68 (check-equal? (map (curry map (curry map syntax->datum)) 69 (syntax-case #'([(a1 a2) (b1) (c1 c2 c3)] 70 [(d1 d2 d3 d4) (e1 e2 e3 e4 e5)]) () 71 [(((xᵢ …) …) …) 72 (list (list (list #'yᵢ …) …) …)])) 73 '([(a1/y a2/y) (b1/y) (c1/y c2/y c3/y)] 74 [(d1/y d2/y d3/y d4/y) (e1/y e2/y e3/y e4/y e5/y)])) 75 76 ;; CHeck that the same ids are produced. 77 (check-true (let ([ids (flatten 78 (syntax-case #'(id) () 79 [(_aᵢ …) 80 (list 81 (ddd #'bᵢ) 82 (list #'bᵢ …) 83 (syntax->list #'(bᵢ …)))]))]) 84 (andmap (curry apply free-identifier=?) 85 (cartesian-product ids ids)))) 86 87 (check-true (let ([ids (flatten 88 (syntax-case #'((id)) () 89 [((aᵢ …) …) 90 (list 91 (ddd (ddd #'bᵢ)) 92 (list (list #'bᵢ …) …) 93 (stx-map syntax->list #'((bᵢ …) …)) 94 (syntax->list #'(bᵢ … …)) 95 (map syntax->list (list #'(bᵢ …) …)))]))]) 96 (andmap (curry apply free-identifier=?) 97 (cartesian-product ids ids)))) 98 99 (check-equal? (map (curry map syntax->datum) 100 (syntax-case #'([a b c] [d e]) () 101 [((xᵢ …) …) 102 (list (list #'yᵢ …) …)])) 103 '([a/y b/y c/y] [d/y e/y])) 104 105 (check-equal? ((λ (result) (syntax->datum (datum->syntax #f result))) 106 (syntax-parse #'[(([h] [i] 10) ([j] 12 13 [m])) 107 (([a] #:kw #:kw) ([d] [e] [f] [g]))] 108 [[(({~and {~or (yᵢ:id …) :nat}} …) …) 109 (({~and {~or (xᵢ:id …) #:kw}} …) …)] 110 (list (list (?? (list #'zᵢ …) 'missing) …) …)])) 111 '(([a/z] [i/z] missing) ([d/z] [e/z] [f/z] [g/z]))) 112 113 (check-match (syntax-case #'(a b c) () 114 [(xᵢ …) 115 ([list xᵢ #'yᵢ] …)]) 116 (list (list 'a (? syntax?)) 117 (list 'b (? syntax?)) 118 (list 'c (? syntax?)))) 119 120 (check-match (syntax-case #'(a b c) () 121 [(xᵢ …) 122 ([list #'xᵢ #'yᵢ] …)]) 123 (list (list (? syntax?) (? syntax?)) 124 (list (? syntax?)(? syntax?)) 125 (list (? syntax?)(? syntax?)))) 126 127 (check-match (syntax-case #'(a b c) () 128 [(xᵢ …) 129 ({?@ #'xᵢ #'yᵢ} …)]) 130 (list (? syntax?) (? syntax?) 131 (? syntax?) (? syntax?) 132 (? syntax?) (? syntax?))) 133 134 (check-equal? (syntax->datum 135 (datum->syntax #f 136 (syntax-case #'(a b c) () 137 [(xᵢ …) 138 ([list xᵢ #'yᵢ] …)]))) 139 '([a a/y] [b b/y] [c c/y])) 140 141 (check-equal? (syntax->datum 142 (datum->syntax #f 143 (syntax-case #'(a b c) () 144 [(xᵢ …) 145 ([list #'xᵢ #'yᵢ] …)]))) 146 '([a a/y] [b b/y] [c c/y])) 147 148 (check-equal? (syntax->datum 149 (datum->syntax #f 150 (syntax-case #'(a b c) () 151 [(xᵢ …) 152 ({?@ #'xᵢ #'yᵢ} …)]))) 153 '(a a/y b b/y c c/y))