test-copy-attribute.rkt (12832B)
1 #lang racket 2 3 (require subtemplate/private/copy-attribute 4 stxparse-info/parse 5 stxparse-info/parse/experimental/template 6 phc-toolkit/untyped 7 rackunit) 8 9 (define (to-datum x) (syntax->datum (datum->syntax #f x))) 10 11 ;; Depth 2, no missing values 12 (begin 13 ;; with just x in the pattern 14 (check-equal? (syntax->datum 15 (syntax-parse #'([1 2 3] [4 5]) 16 [((x …) …) 17 (copy-raw-syntax-attribute y (attribute* x) 2 #t) 18 (template [(?@ y …) … ((y …) …)])])) 19 '(1 2 3 4 5 ((1 2 3) (4 5)))) 20 21 ;; shadowing the y in the pattern 22 (check-equal? (syntax->datum 23 (syntax-parse #'([1 2 3] [4 5]) 24 [((x …) … y) 25 (copy-raw-syntax-attribute y (attribute* x) 2 #t) 26 (template [(?@ y …) … ((y …) …)])])) 27 '(1 2 3 ((1 2 3)))) 28 29 ;; syntax? is #f (the leaves are still syntax though) 30 (check-equal? (to-datum 31 (syntax-parse #'([1 2 3] [4 5]) 32 [((x …) …) 33 (copy-raw-syntax-attribute y (attribute* x) 2 #f) 34 (attribute* y)])) 35 '([1 2 3] [4 5])) 36 37 ;; same as above, check that we have syntax at the leaves 38 (check-match (syntax-parse #'([1 2 3] [4 5]) 39 [((x …) …) 40 (copy-raw-syntax-attribute y (attribute* x) 2 #f) 41 (attribute* y)]) 42 (list (list (? syntax?) ...) ...)) 43 44 ;; syntax? is #f (the leaves are still syntax though), use it in a template 45 (check-equal? (to-datum 46 (syntax-parse #'([1 2 3] [4 5]) 47 [((x …) …) 48 (copy-raw-syntax-attribute y (attribute* x) 2 #f) 49 (template [(?@ y …) … ((y …) …)])])) 50 '(1 2 3 4 5 ((1 2 3) (4 5)))) 51 52 ;; syntax? is #f, the leaves are NOT syntax. 53 ;; Checks that (attribute* y) is not syntax either. 54 (check-equal? (let () 55 (copy-raw-syntax-attribute y `((1 2 3) (4 5)) 2 #f) 56 (attribute* y)) 57 '([1 2 3] [4 5]))) 58 59 ;; Depth 2, missing values at depth 1 60 (begin 61 ;; with just x in the pattern 62 (check-equal? (syntax->datum 63 (syntax-parse #'([1 2 3] #:kw [4 5]) 64 [({~and {~or #:kw (x …)}} …) 65 (copy-raw-syntax-attribute y (attribute* x) 2 #f); has ~or 66 (template [(?? (?@ y …) empty) … ((?? (y …) empty) …)])])) 67 '(1 2 3 empty 4 5 ((1 2 3) empty (4 5)))) 68 69 ;; shadowing the y in the pattern 70 (check-equal? (syntax->datum 71 (syntax-parse #'([1 2 3] #:kw [4 5]) 72 [({~and {~or #:kw (x …)}} … y) 73 (copy-raw-syntax-attribute y (attribute* x) 2 #f); has ~or 74 (template [(?? (?@ y …) empty) … ((?? (y …) empty) …)])])) 75 '(1 2 3 empty ((1 2 3) empty))) 76 77 ;; syntax? is #f (the leaves are still syntax though) 78 (check-equal? (to-datum 79 (syntax-parse #'([1 2 3] #:kw [4 5]) 80 [({~and {~or #:kw (x …)}} …) 81 (copy-raw-syntax-attribute y (attribute* x) 2 #f) 82 (attribute* y)])) 83 '([1 2 3] #f [4 5])) 84 85 ;; same as above, check that we have syntax at the leaves 86 (check-match (syntax-parse #'([1 2 3] #:kw [4 5]) 87 [({~and {~or #:kw (x …)}} …) 88 (copy-raw-syntax-attribute y (attribute* x) 2 #f) 89 (attribute* y)]) 90 (list (list (? syntax?) ...) #f (list (? syntax?) ...))) 91 92 ;; syntax? is #f (the leaves are still syntax though), use it in a template 93 (check-equal? (to-datum 94 (syntax-parse #'([1 2 3] #:kw [4 5]) 95 [({~and {~or #:kw (x …)}} …) 96 (copy-raw-syntax-attribute y (attribute* x) 2 #f) 97 (template [(?? (?@ y …) empty) … ((?? (y …) empty) …)])])) 98 '(1 2 3 empty 4 5 ((1 2 3) empty (4 5)))) 99 100 ;; syntax? is #f, the leaves are NOT syntax. 101 ;; Checks that (attribute* y) is not syntax either. 102 (check-equal? (let () 103 (copy-raw-syntax-attribute y '((1 2 3) #f (4 5)) 2 #f) 104 (attribute* y)) 105 '([1 2 3] #f [4 5]))) 106 107 ;; Depth 2, missing values at depth 2 108 (begin 109 ;; with just x in the pattern 110 (check-equal? (syntax->datum 111 (syntax-parse #'([1 #:kw 3] [4 5]) 112 [(({~and {~or #:kw x}} …) …) 113 (copy-raw-syntax-attribute y (attribute* x) 2 #f); has ~or 114 (template [(?@ (?? y empty) …) … (((?? y empty) …) …)])])) 115 '(1 empty 3 4 5 ((1 empty 3) (4 5)))) 116 117 ;; shadowing the y in the pattern 118 (check-equal? (syntax->datum 119 (syntax-parse #'([1 #:kw 3] [4 5]) 120 [(({~and {~or #:kw x}} …) … y) 121 (copy-raw-syntax-attribute y (attribute* x) 2 #f); has ~or 122 (template [(?@ (?? y empty) …) … (((?? y empty) …) …)])])) 123 '(1 empty 3 ((1 empty 3)))) 124 125 ;; syntax? is #f (the leaves are still syntax though) 126 (check-equal? (to-datum 127 (syntax-parse #'([1 #:kw 3] [4 5]) 128 [(({~and {~or #:kw x}} …) …) 129 (copy-raw-syntax-attribute y (attribute* x) 2 #f) 130 (attribute* y)])) 131 '([1 #f 3] [4 5])) 132 133 ;; same as above, check that we have syntax at the leaves 134 (check-match (syntax-parse #'([1 #:kw 3] [4 5]) 135 [(({~and {~or #:kw x}} …) …) 136 (copy-raw-syntax-attribute y (attribute* x) 2 #f) 137 (attribute* y)]) 138 (list (list (or #f (? syntax?)) ...) ...)) 139 140 ;; syntax? is #f (the leaves are still syntax though), use it in a template 141 (check-equal? (to-datum 142 (syntax-parse #'([1 #:kw 3] [4 5]) 143 [(({~and {~or #:kw x}} …) …) 144 (copy-raw-syntax-attribute y (attribute* x) 2 #f) 145 (template [(?@ (?? y empty) …) … (((?? y empty) …) …)])])) 146 '(1 empty 3 4 5 ((1 empty 3) (4 5)))) 147 148 ;; syntax? is #f, the leaves are NOT syntax. 149 ;; Checks that (attribute* y) is not syntax either. 150 (check-equal? (let () 151 (copy-raw-syntax-attribute y '((1 #f 3) (4 5)) 2 #f) 152 (attribute* y)) 153 '([1 #f 3] [4 5]))) 154 155 ;; Depth 1, missing values at depth 1 156 (begin 157 ;; with just x in the pattern 158 (check-equal? (syntax->datum 159 (syntax-parse #'(1 #:kw 3) 160 [({~and {~or #:kw x}} …) 161 (copy-raw-syntax-attribute y (attribute* x) 1 #f); has ~or 162 (template ({?? y empty} …))])) 163 '(1 empty 3)) 164 165 ;; shadowing the y in the pattern 166 (check-equal? (syntax->datum 167 (syntax-parse #'(1 #:kw 3 4) 168 [({~and {~or #:kw x}} … y) 169 (copy-raw-syntax-attribute y (attribute* x) 1 #f); has ~or 170 (template ({?? y empty} …))])) 171 '(1 empty 3)) 172 173 ;; syntax? is #f (the leaves are still syntax though) 174 (check-equal? (to-datum 175 (syntax-parse #'(1 #:kw 3) 176 [({~and {~or #:kw x}} …) 177 (copy-raw-syntax-attribute y (attribute* x) 1 #f) 178 (attribute* y)])) 179 '(1 #f 3)) 180 181 ;; same as above, check that we have syntax at the leaves 182 (check-match (syntax-parse #'(1 #:kw 3) 183 [({~and {~or #:kw x}} …) 184 (copy-raw-syntax-attribute y (attribute* x) 1 #f) 185 (attribute* y)]) 186 (list (or #f (? syntax?)) ...)) 187 188 ;; syntax? is #f (the leaves are still syntax though), use it in a template 189 (check-equal? (to-datum 190 (syntax-parse #'(1 #:kw 3) 191 [({~and {~or #:kw x}} …) 192 (copy-raw-syntax-attribute y (attribute* x) 1 #f) 193 (template ({?? y empty} …))])) 194 '(1 empty 3)) 195 196 ;; syntax? is #f, the leaves are NOT syntax. 197 ;; Checks that (attribute* y) is not syntax either. 198 (check-equal? (let () 199 (copy-raw-syntax-attribute y '(1 #f 3) 1 #f) 200 (attribute* y)) 201 '(1 #f 3)) 202 203 ;; syntax? is #f, compound values 204 (check-equal? (let () 205 (copy-raw-syntax-attribute y '((1 1 1) #f (3 (#t) #f)) 1 #f) 206 (attribute* y)) 207 '((1 1 1) #f (3 (#t) #f)))) 208 209 ;; Depth 1, no missing values 210 (begin 211 ;; with just x in the pattern 212 (check-equal? (syntax->datum 213 (syntax-parse #'(1 2 3) 214 [(x …) 215 (copy-raw-syntax-attribute y (attribute* x) 1 #t) 216 (template ({?? y empty} …))])) 217 '(1 2 3)) 218 219 ;; shadowing the y in the pattern 220 (check-equal? (syntax->datum 221 (syntax-parse #'(1 2 3 4) 222 [(x … y) 223 (copy-raw-syntax-attribute y (attribute* x) 1 #t) 224 (template ({?? y empty} …))])) 225 '(1 2 3)) 226 227 ;; syntax? is #f (the leaves are still syntax though) 228 (check-equal? (to-datum 229 (syntax-parse #'(1 2 3) 230 [(x …) 231 (copy-raw-syntax-attribute y (attribute* x) 1 #f) 232 (attribute* y)])) 233 '(1 2 3)) 234 235 ;; same as above, check that we have syntax at the leaves 236 (check-match (syntax-parse #'(1 2 3) 237 [(x …) 238 (copy-raw-syntax-attribute y (attribute* x) 1 #f) 239 (attribute* y)]) 240 (list (? syntax?) ...)) 241 242 ;; syntax? is #f (the leaves are still syntax though), use it in a template 243 (check-equal? (to-datum 244 (syntax-parse #'(1 2 3) 245 [(x …) 246 (copy-raw-syntax-attribute y (attribute* x) 1 #f) 247 (template ({?? y empty} …))])) 248 '(1 2 3)) 249 250 ;; syntax? is #f, the leaves are NOT syntax. 251 ;; Checks that (attribute* y) is not syntax either. 252 (check-equal? (let () 253 (copy-raw-syntax-attribute y '(1 2 3) 1 #f) 254 (attribute* y)) 255 '(1 2 3)) 256 257 ;; syntax? is #f, compound values 258 (check-equal? (let () 259 (copy-raw-syntax-attribute y '((1 1 1) 2 (3 (#t) #f)) 1 #f) 260 (attribute* y)) 261 '((1 1 1) 2 (3 (#t) #f)))) 262 263 ;; Depth 1, missing value at depth 0 264 (begin 265 ;; with just x in the pattern 266 (check-equal? (syntax->datum 267 (syntax-parse #'(#:kw) 268 [({~optional (x …)} #:kw) 269 (copy-raw-syntax-attribute y (attribute* x) 1 #f); has ~opt 270 (template {?? (y …) empty})])) 271 'empty) 272 273 ;; syntax? is #f, use it in a template 274 (check-equal? (to-datum 275 (syntax-parse #'(#:kw) 276 [({~optional (x …)} #:kw) 277 (copy-raw-syntax-attribute y (attribute* x) 1 #f) 278 (template {?? (y …) empty})])) 279 'empty) 280 281 ;; syntax? is #f, check with a raw attribute explicitly 282 (check-equal? (let () 283 (copy-raw-syntax-attribute y #f 1 #f) 284 (attribute* y)) 285 #f) 286 287 ;; syntax? is #f, check (in a template) with a raw attribute explicitly 288 (check-equal? (syntax->datum 289 (let () 290 (copy-raw-syntax-attribute y #f 1 #f) 291 (template {?? (y …) empty}))) 292 'empty)) 293 294 ;; Depth 2, missing value at depth 0 295 (begin 296 ;; with just x in the pattern 297 (check-equal? (syntax->datum 298 (syntax-parse #'(#:kw) 299 [({~optional ((x …) …)} #:kw) 300 (copy-raw-syntax-attribute y (attribute* x) 2 #f); has ~opt 301 (template {?? ((y …) …) empty})])) 302 'empty) 303 304 ;; syntax? is #f, use it in a template 305 (check-equal? (to-datum 306 (syntax-parse #'(#:kw) 307 [({~optional ((x …) …)} #:kw) 308 (copy-raw-syntax-attribute y (attribute* x) 2 #f) 309 (template {?? ((y …) …) empty})])) 310 'empty) 311 312 ;; syntax? is #f, check with a raw attribute explicitly 313 (check-equal? (let () 314 (copy-raw-syntax-attribute y #f 2 #f) 315 (attribute* y)) 316 #f) 317 318 ;; syntax? is #f, check (in a template) with a raw attribute explicitly 319 (check-equal? (syntax->datum 320 (let () 321 (copy-raw-syntax-attribute y #f 2 #f) 322 (template {?? ((y …) …) empty}))) 323 'empty))