tallyingTest.ml 1.77 KB
Newer Older
1
open OUnit
2
open Types
3
4
5
6
7
8
9
10

let parse_typ s =
  let st = Stream.of_string s in
  let astpat = Parser.pat st in 
  let nodepat = Typer.typ Builtin.env astpat in
  Types.descr nodepat
;;

11
12
13
14
15
16
let cup = Tallying.CS.cup
let cap = Tallying.CS.cap
let singleton = Tallying.CS.singleton

let mk_pos (alpha,t) = singleton (Tallying.Pos (`Var alpha,parse_typ t))
let mk_neg (t,alpha) = singleton (Tallying.Neg (parse_typ t,`Var alpha))
17

18
let norm_tests = [
19
20
21
22
23
24
25
26
27
28
29
30
  "(`$A -> Bool)", "(`$B -> `$B)", 
                    cup (mk_pos ("B","Empty"))
                      (cap 
                        (mk_neg ("`$B","A"))
                        (mk_neg ("Bool","B"))
                      );
  "`$B", "`$A", mk_neg ("`$B","A");
  "`$B", "Empty", mk_pos ("B","Empty");
  "Int", "`$B", mk_neg ("Int","B");
  "Int", "(`$A | `$B)", mk_neg ("Int \\ `$B","A");
  "(Int -> Bool)", "(`$A -> `$B)",
                    cup (mk_pos ("A","Empty")) 
31
                      (cap 
32
33
                        (mk_pos ("A","Int"))
                        (mk_neg ("Bool","B"))
34
                      );
35
36
]

37
38
39
40
41
42
43
44
45
let m_compare = Tallying.CS.M.compare Types.compare

module ECS = OUnitDiff.ListSimpleMake (struct 
  type t = Tallying.CS.m
  let compare = m_compare
  let pp_printer = Tallying.CS.print_m
  let pp_print_sep = OUnitDiff.pp_comma_separator
end)

46
47
let test_norm =
  "test tallying norm" >:::
48
49
50
51
52
53
54
    List.map (fun (s,t,expected) ->
      (Printf.sprintf " %s \\ %s" s t) >:: (fun _ ->
        let s = parse_typ s in
        let t = parse_typ t in
        let result = Tallying.norm (diff s t) in
        let elem s = List.sort m_compare (Tallying.CS.S.elements s) in
        ECS.assert_equal (elem expected) (elem result)
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
      )
    ) norm_tests
;;

let all =
  "all tests" >::: [
    test_norm;
  ]
 
let main () =
  OUnit.run_test_tt_main all
;;
 
main ()