www

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

test-or.rkt (2857B)

      1 #lang racket
      2 
      3 (require subtemplate/private/ddd
      4          subtemplate/private/ddd-forms
      5          subtemplate/private/unsyntax-preparse
      6          stxparse-info/case
      7          stxparse-info/parse
      8          rackunit
      9          syntax/macro-testing
     10          (only-in racket/base [... …]))
     11 
     12 ;; ??
     13 
     14 (define (test-??-all v)
     15   (syntax-parse v
     16     [({~optional a:nat}
     17       {~optional b:id}
     18       {~optional c:boolean}
     19       {~optional d:keyword})
     20      (?? 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-parse v
     36     [({~optional a:nat}
     37       {~optional b:id}
     38       {~optional c:boolean}
     39       {~optional d:keyword})
     40      (?cond [a 10] [b 20] [c 30] [d 40])]))
     41 
     42 (check-equal? (test-?cond #'(1 x #f #:kw)) 10)
     43 (check-equal? (test-?cond #'(x #f #:kw)) 20)
     44 (check-equal? (test-?cond #'(#f #:kw)) 30)
     45 (check-equal? (test-?cond #'(#:kw)) 40)
     46 
     47 (check-equal? (test-?cond #'(1)) 10)
     48 (check-equal? (test-?cond #'(x)) 20)
     49 (check-equal? (test-?cond #'(#f)) 30)
     50 (check-equal? (test-?cond #'(#:kw)) 40)
     51 
     52 ;; ?attr
     53 
     54 (define (test-?attr v)
     55   (syntax-parse v
     56     [({~optional a:nat}
     57       {~optional b:id}
     58       {~optional c:boolean}
     59       {~optional d:keyword})
     60      (list (?attr a) (?attr b) (?attr c) (?attr d))]))
     61 
     62 (check-equal? (test-?attr #'(1 x #f #:kw)) '(#t #t #t #t))
     63 (check-equal? (test-?attr #'(x #f #:kw))   '(#f #t #t #t))
     64 (check-equal? (test-?attr #'(#f #:kw))     '(#f #f #t #t))
     65 (check-equal? (test-?attr #'(#:kw))        '(#f #f #f #t))
     66 
     67 (check-equal? (test-?attr #'(1))    '(#t #f #f #f))
     68 (check-equal? (test-?attr #'(x))    '(#f #t #f #f))
     69 (check-equal? (test-?attr #'(#f))   '(#f #f #t #f))
     70 (check-equal? (test-?attr #'(#:kw)) '(#f #f #f #t))
     71 
     72 ;; ?if
     73 
     74 (define (test-?if v)
     75   (syntax-parse v
     76     [({~optional a:nat}
     77       {~optional b:id}
     78       {~optional c:keyword})
     79      (?if a b c)]))
     80 
     81 (check-equal? (test-?if #'(1 x #:kw)) 'x)
     82 (check-equal? (test-?if #'(x #:kw))   '#:kw)
     83 (check-equal? (test-?if #'(#:kw))     '#:kw)
     84 (check-equal? (test-?if #'(1 #:kw))   '#f)
     85 
     86 (check-equal? (syntax-parse #'(1 x)
     87                 [({~optional a:nat}
     88                   {~optional b:id}
     89                   {~optional c:boolean}
     90                   {~optional d:keyword})
     91                  (?if a (?if b a d) 0)])
     92               1)
     93 
     94 ;; ?@@
     95 
     96 (check-equal? (syntax-parse #'((1 2 3) (x y) (#f))
     97                 [(a b c)
     98                  (vector {?@@ a b c})])
     99               #(1 2 3 x y #f))
    100 
    101 (check-equal? (syntax-parse #'((1 2 3) (x y) (#f))
    102                 [whole
    103                  (vector {?@@ . whole})])
    104               #(1 2 3 x y #f))