test-ddd-forms.rkt (8690B)
1 #lang racket 2 3 (require subtemplate/private/ddd-forms 4 stxparse-info/case 5 stxparse-info/parse 6 rackunit 7 syntax/macro-testing 8 phc-toolkit/untyped) 9 10 ;; case, let + begin, define 11 (check-equal? (syntax-case #'((1 2 3) (4 5)) () 12 [((x …) …) 13 (let () 14 (begin 15 (define y (- (syntax-e #'x))) … … 16 y))]) 17 '((-1 -2 -3) (-4 -5))) 18 19 ;; case, let + begin, define/with-syntax 20 (check-equal? (syntax->datum 21 (syntax-case #'((1 2 3) (4 5)) () 22 [((x …) …) 23 (let () 24 (begin 25 (define/with-syntax y (- (syntax-e #'x))) … … 26 #'((y …) …)))])) 27 '((-1 -2 -3) (-4 -5))) 28 29 ;; case, let, define 30 (check-equal? (syntax-case #'((1 2 3) (4 5)) () 31 [((x …) …) 32 (let () 33 (define y (- (syntax-e #'x))) … … 34 y)]) 35 '((-1 -2 -3) (-4 -5))) 36 37 ;; case, let, define/with-syntax 38 (check-equal? (syntax->datum 39 (syntax-case #'((1 2 3) (4 5)) () 40 [((x …) …) 41 (let () 42 (define/with-syntax y (- (syntax-e #'x))) … … 43 #'((y …) …))])) 44 '((-1 -2 -3) (-4 -5))) 45 46 ;; parse, let + begin, define 47 (check-equal? (syntax-parse #'((1 2 3) (4 5)) 48 [((x …) …) 49 (let () 50 (begin 51 (define y (- (syntax-e #'x))) … … 52 y))]) 53 '((-1 -2 -3) (-4 -5))) 54 55 ;; parse, let + begin, define/with-syntax 56 (check-equal? (syntax->datum 57 (syntax-parse #'((1 2 3) (4 5)) 58 [((x …) …) 59 (let () 60 (begin 61 (define/with-syntax y (- (syntax-e #'x))) … … 62 #'((y …) …)))])) 63 '((-1 -2 -3) (-4 -5))) 64 65 ;; parse, let, define 66 (check-equal? (syntax-parse #'((1 2 3) (4 5)) 67 [((x …) …) 68 (let () 69 (define y (- (syntax-e #'x))) … … 70 y)]) 71 '((-1 -2 -3) (-4 -5))) 72 73 ;; parse, let, define/with-syntax 74 (check-equal? (syntax->datum 75 (syntax-parse #'((1 2 3) (4 5)) 76 [((x …) …) 77 (let () 78 (define/with-syntax y (- (syntax-e #'x))) … … 79 #'((y …) …))])) 80 '((-1 -2 -3) (-4 -5))) 81 82 ;; parse, begin, define 83 (check-equal? (syntax-parse #'((1 2 3) (4 5)) 84 [((x …) …) 85 (begin 86 (define y (- (syntax-e #'x))) … …) 87 y]) 88 '((-1 -2 -3) (-4 -5))) 89 90 ;; parse, begin, define/with-syntax 91 (check-equal? (syntax->datum 92 (syntax-parse #'((1 2 3) (4 5)) 93 [((x …) …) 94 (begin 95 (define/with-syntax y (- (syntax-e #'x))) … …) 96 #'((y …) …)])) 97 '((-1 -2 -3) (-4 -5))) 98 99 ;; parse, directly in the body, define 100 (check-equal? (syntax-parse #'((1 2 3) (4 5)) 101 [((x …) …) 102 (define y (- (syntax-e #'x))) … … 103 y]) 104 '((-1 -2 -3) (-4 -5))) 105 106 ;; parse, directly in the body, define/with-syntax 107 (check-equal? (syntax->datum 108 (syntax-parse #'((1 2 3) (4 5)) 109 [((x …) …) 110 (define/with-syntax y (- (syntax-e #'x))) … … 111 #'((y …) …)])) 112 '((-1 -2 -3) (-4 -5))) 113 114 ;; #%app 115 (check-equal? (syntax-case #'([1 2 3] [a]) () 116 [([x …] [y …]) 117 (vector (syntax-e #'x) … 'then (syntax-e #'y) …)]) 118 #(1 2 3 then a)) 119 120 ;; #%app, depth 2 → flat 121 (check-equal? (syntax-case #'(([1 2 3] [4 5 6]) [a]) () 122 [(([x …] …) [y …]) 123 (vector (syntax-e #'x) … … 'then (syntax-e #'y) …)]) 124 #(1 2 3 4 5 6 then a)) 125 126 ;; #%app, depth 2 → nested 127 (check-equal? (syntax-case #'(([1 2 3] [4 5 6]) [a]) () 128 [(([x …] …) [y …]) 129 (vector ((syntax-e #'x) …) … 'then (syntax-e #'y) …)]) 130 #((1 2 3) (4 5 6) then a)) 131 132 ;; #%app, with auto-syntax-e behaviour :) 133 (check-equal? (syntax-case #'([1 2 3] [a]) () 134 [([x …] [y …]) 135 (vector x … 'then y …)]) 136 #(1 2 3 then a)) 137 138 ;; #%app, with auto-syntax-e behaviour, same variable iterated twice 139 (check-equal? (syntax-case #'([1 2 3] [a]) () 140 [([x …] [y …]) 141 (vector x … 'then x …)]) 142 #(1 2 3 then 1 2 3)) 143 144 ;; #%app, depth 2 → flat, with auto-syntax-e behaviour :) 145 (check-equal? (syntax-case #'(([1 2 3] [4 5 6]) [a]) () 146 [(([x …] …) [y …]) 147 (vector x … … 'then y …)]) 148 #(1 2 3 4 5 6 then a)) 149 150 ;; #%app, depth 2 → nested, with auto-syntax-e behaviour :) 151 (check-equal? (syntax-case #'(([1 2 3] [4 5 6]) [a]) () 152 [(([x …] …) [y …]) 153 (vector (x …) … 'then y …)]) 154 #((1 2 3) (4 5 6) then a)) 155 156 (check-equal? (syntax-parse #'(([1 2 3] [4 5 6]) [a]) 157 [(([x …] …) [y …]) 158 (vector (x … …) 'then y …)]) 159 #((1 2 3 4 5 6) then a)) 160 161 (check-equal? (syntax-parse #'(([1 2 3] [4 5 6]) [a]) 162 [(([x …] …) [y …]) 163 (y …)]) 164 '(a)) 165 166 (check-equal? (syntax-parse #'(([1 2 3] [4 5 6]) [a]) 167 [(([x …] …) [y …]) 168 (x … …)]) 169 '(1 2 3 4 5 6)) 170 171 ;; Implicit (list _), could also be changed to an implicit (values). 172 (check-equal? (list ;; unwrap the splice 173 (syntax-parse #'(([1 2 3] [4 5 6]) [a]) 174 [(([x …] …) [y …]) 175 x … …])) 176 '(1 2 3 4 5 6)) 177 178 ;; TODO: expr … inside begin and let 179 (check-equal? (list ;; unwrap the splice 180 (syntax-case #'((1 2 3) (4 5)) () 181 [((x …) …) 182 (let () 183 (list (length (syntax->list #'(x …))) 184 (+ (syntax-e #'x) 3) …) 185 …)])) 186 '([3 4 5 6] 187 [2 7 8])) 188 189 (check-equal? (list ;; unwrap the splice 190 (syntax-parse #'([1 2 3] [4 5 6]) 191 [([x …] …) 192 x … …])) 193 '(1 2 3 4 5 6)) 194 (check-equal? (list ;; unwrap the splice 195 (syntax-parse #'([1 2 3] [4 5 6]) 196 [([x …] …) 197 (x …) …])) 198 '((1 2 3) (4 5 6))) 199 (check-equal? (list ;; unwrap the splice 200 (syntax-parse #'([1 2 3] [4 5 6]) 201 [([x …] …) 202 ((list x) …) …])) 203 '(((1) (2) (3)) ((4) (5) (6)))) 204 (check-equal? (list ;; unwrap the splice 205 (syntax-parse #'([1 2 3] [4 5 6]) 206 [([x …] …) 207 ((+ x 10) …) …])) 208 '((11 12 13) (14 15 16))) 209 (check-equal? (list ;; unwrap the splice 210 (syntax-parse #'([1 2 3] [4 5 6]) 211 [([x …] …) 212 (begin ((+ x 10) …) …)])) 213 '((11 12 13) (14 15 16))) 214 (check-equal? (list ;; unwrap the splice 215 (syntax-parse #'([1 2 3] [4 5 6]) 216 [([x …] …) 217 (define/with-syntax y (+ x 10)) … … 218 y … …])) 219 '(11 12 13 14 15 16)) 220 221 ;; Implicit apply with (+ y … …) 222 (check-equal? (syntax-parse #'([1 2 3] [4 5 6]) 223 [([x …] …) 224 (define/with-syntax y (+ x 10)) … … 225 (+ y … …)]) 226 81) 227 228 ;; Implicit apply with (+ (* x 2) … …) 229 (check-equal? (syntax-parse #'([1 2 3] [4 5 6]) 230 [([x …] …) 231 (+ (* x 2) … …)]) 232 42) 233 234 ;; TODO: (define ) … … should register the variable with current-pvars. 235 #;(syntax-parse #'([1 2 3] [4 5 6]) 236 [([x …] …) 237 (define y (+ x 10)) … … 238 y … …]) 239 240 241 ;; omitted element in the tree = not ok under ellipses 242 (check-exn 243 #rx"attribute contains an omitted element" 244 (λ () 245 (syntax-parse #'([1 2 3] #:kw [4 5 6]) 246 [({~and {~or [x …] #:kw}} …) 247 ((x …) …)]))) 248 249 ;; omitted element in the tree = ok as auto-syntax-e 250 (check-equal? (syntax-parse #'([1 2 3] #:kw [4 5 6]) 251 [({~and {~or [x …] #:kw}} …) 252 (x …)]) 253 '((1 2 3) #f (4 5 6)))