www

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

test-tagged-call-syntax.rkt (3243B)

      1 #lang racket/base
      2 
      3 (require (for-template (lib "phc-adt/tagged.hl.rkt"))
      4          rackunit
      5          syntax/parse)
      6 
      7 (check-equal?
      8  (syntax-parse #'(nam #:instance)
      9    [(:tagged-call-args-syntax-class)
     10     (list* (attribute instance?) (syntax->datum #'(name [fieldᵢ ...])))]
     11    [_ 'wrong])
     12  '(#t nam []))
     13          
     14 (check-equal?
     15  (syntax-parse #'(nam [field0 value0])
     16    [(:tagged-call-args-syntax-class)
     17     (list* (attribute instance?) (attribute no-types?)
     18            (syntax->datum #'(name [fieldᵢ ...] [valueᵢ ...])))]
     19    [_ 'wrong])
     20  '(#t #t nam [field0] [value0]))
     21 
     22 (check-equal?
     23  (syntax-parse #'(nam [field0 value0] [field1 value1])
     24    [(:tagged-call-args-syntax-class)
     25     (list* (attribute instance?) (attribute no-types?)
     26            (syntax->datum #'(name [fieldᵢ ...] [valueᵢ ...])))]
     27    [_ 'wrong])
     28  '(#t #t nam [field0 field1] [value0 value1]))
     29 
     30 (check-equal?
     31  (syntax-parse #'(nam [field0 : type0 value0])
     32    [(:tagged-call-args-syntax-class)
     33     (list* (attribute instance?) (attribute types?)
     34            (syntax->datum #'(name [fieldᵢ ...] [τᵢ ...] [valueᵢ ...])))]
     35    [_ 'wrong])
     36  '(#t #t nam [field0] [type0] [value0]))
     37 
     38 (check-equal?
     39  (syntax-parse #'(nam [field0 : type0 value0] [field1 : type1 value1])
     40    [(:tagged-call-args-syntax-class)
     41     (list* (attribute instance?) (attribute types?)
     42            (syntax->datum #'(name [fieldᵢ ...] [τᵢ ...] [valueᵢ ...])))]
     43    [_ 'wrong])
     44  '(#t #t nam [field0 field1] [type0 type1] [value0 value1]))
     45 
     46 (check-equal?
     47  (syntax-parse #'(nam #:instance)
     48    [(:tagged-call-args-syntax-class)
     49     (list* (attribute instance?)
     50            (syntax->datum #'(name)))]
     51    [_ 'wrong])
     52  '(#t nam))
     53 
     54 (check-equal?
     55  (syntax-parse #'(nam [field0 value0])
     56    [(:tagged-call-args-syntax-class)
     57     (list* (attribute instance?) (attribute no-types?)
     58            (syntax->datum #'(name [fieldᵢ ...] [valueᵢ ...])))]
     59    [_ 'wrong])
     60  '(#t #t nam [field0] [value0]))
     61 
     62 (check-equal?
     63  (syntax-parse #'(nam [field0 : type0 value0])
     64    [(:tagged-call-args-syntax-class)
     65     (list* (attribute instance?) (attribute types?)
     66            (syntax->datum #'(name [fieldᵢ ...] [τᵢ ...] [valueᵢ ...])))]
     67    [_ 'wrong])
     68  '(#t #t nam [field0] [type0] [value0]))
     69 
     70 (check-equal?
     71  (syntax-parse #'(nam [field0] field1)
     72    [(:tagged-call-args-syntax-class)
     73     (list* (attribute builder?)
     74            (syntax->datum #'(name [fieldᵢ ...])))]
     75    [_ 'wrong])
     76  '(#t nam [field0 field1]))
     77 
     78 (check-equal?
     79  (syntax-parse #'(nam [field0] field1)
     80    [(:tagged-call-args-syntax-class)
     81     (list* (attribute builder?)
     82            (syntax->datum #'(name [fieldᵢ ...])))]
     83    [_ 'wrong])
     84  '(#t nam [field0 field1]))
     85 
     86 (check-equal?
     87  (syntax-parse #'(nam [field0] field1)
     88    [(:tagged-call-args-syntax-class)
     89     (list* (attribute builder?)
     90            (syntax->datum #'(name [fieldᵢ ...])))]
     91    [_ 'wrong])
     92  '(#t nam [field0 field1]))
     93 
     94 (check-equal?
     95  (syntax-parse #'(nam)
     96    [(:tagged-call-args-syntax-class) 'wrong]
     97    [_ 'parse-failed])
     98  'parse-failed)
     99 
    100 (check-equal?
    101  (syntax-parse #'(#:instance)
    102    [(:tagged-call-args-syntax-class) 'wrong]
    103    [_ 'parse-failed])
    104  'parse-failed)
    105 
    106 (check-equal?
    107  (syntax-parse #'()
    108    [(:tagged-call-args-syntax-class) 'wrong]
    109    [_ 'parse-failed])
    110  'parse-failed)