www

Unnamed repository; edit this file 'description' to name the repository.
Log | Files | Refs | README

test-ddd.rkt (2968B)

      1 #lang racket
      2 (require subtemplate/private/ddd
      3          stxparse-info/case
      4          stxparse-info/parse
      5          (only-in racket/base [... …])
      6          rackunit
      7          syntax/macro-testing
      8          syntax/stx)
      9 
     10 (check-equal? (syntax-case #'((1 2 3) (4 5)) ()
     11                 [((x …) …)
     12                  (ddd (list (length (syntax->list #'(x …)))
     13                             (ddd (+ (syntax-e #'x) 3))))])
     14               '([3 (4 5 6)]
     15                 [2 (7 8)]))
     16 
     17 (check-equal? (syntax-case #'(1 2 3) ()
     18                 [(x …)
     19                  (ddd (+ (syntax-e #'x) 3))])
     20               '(4 5 6))
     21 
     22 (check-equal? (syntax-parse #'(1 2 3)
     23                 [(x …)
     24                  (ddd (+ (syntax-e #'x) 3))])
     25               '(4 5 6))
     26 
     27 (check-equal? (syntax-case #'(((1 2) (3)) ((4 5 6))) ()
     28                 [(((x …) …) …)
     29                  (ddd (list (length (syntax->list #'((x …) …)))
     30                             (length (syntax->list #'(x … …)))
     31                             (ddd (ddd (- (syntax-e #'x))))))])
     32               '([2 3 ((-1 -2) (-3))]
     33                 [1 3 ((-4 -5 -6))]))
     34 
     35 (check-equal? (syntax-case #'([1 2 3] [a]) ()
     36                 [([x …] [y …])
     37                  (ddd (+ (syntax-e #'x) 3))])
     38               '(4 5 6))
     39 
     40 (check-equal? (syntax-case #'(([1 2 3] [a])) ()
     41                 [(([x …] [y …]) …)
     42                  (ddd (ddd (+ (syntax-e #'x) 3)))])
     43               '((4 5 6)))
     44 
     45 ;; The inner ddd should not make the outer one consider the variables actually
     46 ;; used. This test will break if y is considered to be used, because it does not
     47 ;; have the same shape as x anywhere, so map will complain that the lists do not
     48 ;; have the same length.
     49 (check-equal? (syntax-case #'([#:xs (1 2 3) (4 5)]
     50                               [#:ys (a) (b) (c) (d)]) ()
     51                 [([#:xs (x …) …]
     52                   [#:ys (y …) …])
     53                  (ddd (ddd (+ (syntax-e #'x) 3)))])
     54               '((4 5 6) (7 8)))
     55 
     56 (check-exn
     57  #rx"no pattern variables with depth > 0 were found in the body"
     58  (λ ()
     59    (convert-compile-time-error
     60     (syntax-parse #'(1 2 3)
     61       [(x y z)
     62        (ddd (+ (syntax-e #'x) 3))]))))
     63 
     64 (check-equal? (syntax-parse #'(1 2 3 4)
     65                 [(x … y)
     66                  (ddd (+ (syntax-e #'x) (syntax-e #'y)))])
     67               '(5 6 7))
     68 
     69 (check-equal? (syntax-case #'((1 2 3) (4 5)) ()
     70                 [((x …) …)
     71                  (ddd (list (length (syntax->list #'(x …)))
     72                             (ddd (+ (syntax-e #'x) 3))))])
     73               '([3 (4 5 6)]
     74                 [2 (7 8)]))
     75 
     76 
     77 ;; omitted element at the leaves = ok (should it be ok?)
     78 (check-equal? (syntax-parse #'(1 #f 3)
     79                 [({~and {~or x:nat #f}} …)
     80                  (ddd x)])
     81               '(1 #f 3))
     82 
     83 ;; omitted element in the tree = not ok
     84 (check-exn
     85  #rx"attribute contains an omitted element"
     86  (λ ()
     87    (syntax-parse #'((1 1) #f (1 2 1 1))
     88      [({~and {~or (x:nat …) #f}} …)
     89       (ddd (ddd x))])))