www

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

test-empty.rkt (3396B)

      1 #lang typed/racket
      2 
      3 (require phc-adt
      4          phc-toolkit
      5          type-expander
      6          typed/rackunit
      7          (only-in (lib "phc-adt/tagged-structure-low-level.hl.rkt")
      8                   λ-tagged-get-field))
      9 (adt-init)
     10 
     11 (define-structure empty-st)
     12 (define-tagged empty-tg)
     13 (define-constructor empty-ct :)
     14 (define-constructor empty-ct-t2 #:tag empty-ct ::)
     15 (define-constructor empty-ct-t3 #:tag empty-ct !)
     16 (define-constructor empty-ct-2 ::)
     17 (define-constructor empty-ct-3 !)
     18 
     19 ;(ann empty-ct (→ (constructor empty-ct)))
     20 ;(ann (empty-ct) (constructor empty-ct))
     21 (check-equal?: (if (match (constructor empty-ct)
     22                      [(empty-ct) #t]
     23                      [_ #f])
     24                    #t
     25                    #f)
     26                : #t
     27                #t)
     28 ;(ann (constructor empty-ct) empty-ct)
     29 (check-ann empty-ct?
     30            (→ Any Boolean : (constructor empty-ct)))
     31 (check-equal?: (if (empty-ct? (constructor empty-ct)) #t #f)
     32                : #t
     33                #t)
     34 
     35 (check-ann (structure #:builder)
     36            (→ (structure)))
     37 (check-ann (tagged empty-tg #:builder)
     38            (→ (tagged empty-tg)))
     39 (check-ann (constructor empty-ct :)
     40            (→ (constructor empty-ct)))
     41 (check-ann (constructor empty-ct ::)
     42            (→ Null (constructor empty-ct)))
     43 (check-ann (constructor empty-ct !)
     44            (→ Any * (constructor empty-ct)))
     45 
     46 (check-true: (match ((constructor empty-ct :))
     47                [(tagged empty-ct [values '()]) #t]
     48                [_ #f]))
     49 
     50 (check-true: (match ((constructor empty-ct ::) null)
     51                [(tagged empty-ct [values '()]) #t]
     52                [_ #f]))
     53 
     54 (check-true: (match ((constructor empty-ct !))
     55                [(tagged empty-ct [values '()]) #t]
     56                [_ #f]))
     57 
     58 (check-true: (match (constructor empty-ct)
     59                [(tagged empty-ct [values '()]) #t]
     60                [_ #f]))
     61 
     62 (check-ann (let ([v ((constructor empty-ct ::) null)])
     63              (if ((|(tagged-cast-predicate empty-ct values)|
     64                    (make-predicate Null))
     65                   v)
     66                  v
     67                  #f))
     68            (constructor empty-ct))
     69 
     70 ;; result type should be (constructor empty-ct . Number)
     71 (check-ann (constructor empty-ct . #{1 : Number})
     72            (constructor empty-ct . Number))
     73 (check-ann (constructor empty-ct #:rest 1 : Number)
     74            (constructor empty-ct . Number))
     75 
     76 (check-ann (constructor empty-ct . 1)
     77            (constructor empty-ct . 1))
     78 (check-ann (constructor empty-ct #:rest 1)
     79            (constructor empty-ct . 1))
     80 (check-ann (constructor empty-ct #:rest (list 1 2))
     81            (constructor empty-ct Number Number))
     82 
     83 (check-ann (constructor empty-ct 1)
     84            (constructor empty-ct 1))
     85 (check-ann (constructor empty-ct [1 : Number])
     86            (constructor empty-ct Number))
     87 (check-ann (constructor empty-ct)
     88            (constructor empty-ct))
     89 (check-ann (constructor empty-ct)
     90            (tagged empty-ct [values Null]))
     91 
     92 (check-equal?-classes:
     93  [(constructor empty-ct . #{1 : Number})
     94   (constructor empty-ct #:rest 1 : Number)
     95   (constructor empty-ct . 1)
     96   (constructor empty-ct #:rest 1)]
     97  [(constructor empty-ct #:rest (list 1 2))]
     98  [(constructor empty-ct 1)
     99   (constructor empty-ct [1 : Number])]
    100  [(constructor empty-ct)
    101   (constructor empty-ct . #{null : Null})
    102   (constructor empty-ct #:rest null : Null)
    103   (constructor empty-ct . null)
    104   (constructor empty-ct #:rest null)])