Commit ec4c848f authored by Pietro Abate's avatar Pietro Abate

Move squaresubtype tests to Tallying unit tests

parent ea80ff58
......@@ -8,7 +8,6 @@ let parse_typ s =
Types.descr nodepat
;;
(* the abstract field is ignored in the comparison *)
module ESet = OUnitDiff.SetMake (struct
type t = (Var.var * Types.t)
let compare (v1,t1) (v2,t2) =
......@@ -481,6 +480,25 @@ let test_apply =
) apply_raw_tests
;;
let squaresubtype_tests = [
"'A -> 'A", "Bool -> Bool", [], true;
"'A -> 'B", "Int -> Bool", [], true;
"'A -> 'B", "Int -> Bool", ["A"], false;
"'A -> 'A", "(Int -> Int) & (Bool -> Bool)", [], true;
]
let test_squaresubtype =
"test squaresubtype" >:::
List.map (fun (s,t,delta,expected) ->
(Printf.sprintf " %s [= %s " s t) >:: (fun _ ->
let t1 = parse_typ s in
let t2 = parse_typ t in
let delta = List.fold_left (fun acc v -> Var.Set.add (Var.mk v) acc) Var.Set.empty delta in
assert_equal (Types.is_squaresubtype delta t1 t2) expected
)
) squaresubtype_tests
;;
let suite =
"tests" >::: [
test_constraints;
......@@ -488,6 +506,7 @@ let suite =
test_merge;
test_tallying;
test_apply;
test_squaresubtype;
]
let main () =
......
......@@ -124,23 +124,19 @@ let test_set_operations =
) set_op_tests
;;
let squaresubtype_tests = [
"'A -> 'A", "Bool -> Bool", [], true;
"'A -> 'B", "Int -> Bool", [], true;
"'A -> 'B", "Int -> Bool", ["A"], false;
"'A -> 'A", "(Int -> Int) & (Bool -> Bool)", [], true;
let cleantype_tests = [
]
let test_squaresubtype =
let test_cleantypes =
"test squaresubtype" >:::
List.map (fun (s,t,delta,expected) ->
(Printf.sprintf " %s [= %s " s t) >:: (fun _ ->
List.map (fun (s,delta,expected) ->
(Printf.sprintf " %s" s) >:: (fun _ ->
let t1 = parse_typ s in
let t2 = parse_typ t in
let expected = parse_typ expected in
let delta = List.fold_left (fun acc v -> Var.Set.add (Var.mk v) acc) Var.Set.empty delta in
assert_equal (Types.is_squaresubtype delta t1 t2) expected
assert_equal ~cmp:Types.equal (Types.Positive.clean_type delta t1) expected
)
) squaresubtype_tests
) cleantype_tests
;;
let subst_tests = [
......@@ -332,7 +328,6 @@ let test_witness =
let all =
"all tests" >::: [
test_set_operations;
test_squaresubtype;
test_subtype;
test_substitution;
test_rec_subtitutions;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment