Commit 441e31d9 authored by Julien Lopez's avatar Julien Lopez
Browse files

[TESTS][TYPED] Add printer file; update printer; add new test

parent cc60dc82
open OUnit2
let rec typed_to_string e = "{typ:" ^ (Types.Print.to_string e.Typed.exp_typ)
^ "; descr=" ^ (match e.Typed.exp_descr with
| Typed.Forget(e, _) -> "Forget(" ^ typed_to_string e ^ ")"
| Typed.Check(_, e, _) -> "Check(" ^ typed_to_string e ^ ")"
| Typed.Var(id, name) -> "Var(" ^ (string_of_int (Upool.int id)) ^ ", "
^ (Encodings.Utf8.to_string name) ^ ")"
| Typed.ExtVar(_, (id, name), _) -> "ExtVar("
^ (string_of_int (Upool.int id)) ^ ", " ^ (Encodings.Utf8.to_string name)
^ ")"
| Typed.Apply(e1, e2) -> "(" ^ typed_to_string e1 ^ ").("
^ (typed_to_string e2) ^ ")"
| Typed.Abstraction(abstr) -> "Abstraction(" ^ (abst abstr) ^ ")"
| Typed.Cst(cst) -> const cst
| Typed.Pair(e1, e2) -> "(" ^ (typed_to_string e1) ^ ", "
^ (typed_to_string e2) ^ ")"
| Typed.String(_, _, s, _) -> "\"" ^ (Encodings.Utf8.to_string s) ^ "\""
| Typed.Match(e, b) -> "Match(" ^ (typed_to_string e) ^ "," ^ (branches b)
^ ")"
| _ -> assert false) ^ "}"
and const cst = match cst with
| Types.Integer(i) -> "Integer(" ^ (Intervals.V.to_string i) ^ ")"
| Types.Atom(a) -> "Atom(" ^ (Atoms.V.to_string a) ^ ")"
| Types.Char(c) -> "Char(" ^ (string_of_int (Chars.V.to_int c)) ^ ")"
| Types.Pair(c1, c2) -> "(" ^ const c1 ^ ", " ^ const c2 ^ ")"
| Types.String(_, _, s, _) -> "\"" ^ (Encodings.Utf8.to_string s) ^ "\""
| _ -> assert false
and abst abstr = (match abstr.Typed.fun_name with
| Some (id, name) -> "name:(" ^ (string_of_int (Upool.int id)) ^ ", "
^ (Encodings.Utf8.to_string name) ^ ")"
| None -> "name:<none>") ^ ",\niface:[" ^ (iface abstr.Typed.fun_iface)
^ "],\nbody:[" ^ (branches abstr.Typed.fun_body) ^ "], "
^ "typ:" ^ (Types.Print.to_string abstr.Typed.fun_typ) ^ ", fv:["
^ (fv_to_string abstr.Typed.fun_fv) ^ "]"
and iface list = match list with
| (t1, t2) :: [] -> "(" ^ (Types.Print.to_string t1) ^ ", "
^ (Types.Print.to_string t2) ^ ")"
| (t1, t2) :: rest -> "(" ^ (Types.Print.to_string t1) ^ ", "
^ (Types.Print.to_string t2) ^ "),"
| [] -> ""
and branches brs = "typ:" ^ (Types.Print.to_string brs.Typed.br_typ)
^ ", accept:" ^ (Types.Print.to_string brs.Typed.br_accept) ^ ", branches:"
^ (branch brs.Typed.br_branches)
and branch brs = match brs with
| br :: [] -> "\n{used:" ^ (string_of_bool br.Typed.br_used) ^ "; ghost:"
^ (string_of_bool br.Typed.br_ghost) ^ "; br_vars_empty:["
^ (fv_to_string br.Typed.br_vars_empty) ^ "];\npat:{"
^ (node br.Typed.br_pat) ^ "};\nbody:{typ:"
^ (Types.Print.to_string br.Typed.br_body.Typed.exp_typ) ^ ", descr:"
^ (typed_to_string br.Typed.br_body) ^ "}}"
| br :: rest -> "\n{used:" ^ (string_of_bool br.Typed.br_used) ^ "; ghost:"
^ (string_of_bool br.Typed.br_ghost) ^ "; br_vars_empty:["
^ (fv_to_string br.Typed.br_vars_empty) ^ "];\npat:{"
^ (node br.Typed.br_pat) ^ "};\nbody:{typ:"
^ (Types.Print.to_string br.Typed.br_body.Typed.exp_typ) ^ ", descr:"
^ (typed_to_string br.Typed.br_body) ^ "}}," ^ (branch rest)
| [] -> ""
and node node = "id:" ^ (string_of_int node.Patterns.id) ^ "; descr:["
^ (descr node.Patterns.descr) ^ "]; accept:[id:"
^ (string_of_int (Types.id node.Patterns.accept)) ^ "; descr:"
^ (Types.Print.to_string (Types.descr node.Patterns.accept)) ^ "]; fv:["
^ (fv_to_string node.Patterns.fv) ^ "]"
and descr (t, fv, d) = (Types.Print.to_string t)
^ "; [" ^ (fv_to_string fv) ^ "]; " ^ descr2 d
and descr2 d = match d with
| Patterns.Constr(t) -> "Constr(" ^ (Types.Print.to_string t) ^ ")"
| Patterns.Cup(d1, d2) -> "Cup([" ^ (descr d1) ^ "], [" ^ (descr d2) ^ "])"
| Patterns.Cap(d1, d2) -> "Cap([" ^ (descr d1) ^ "], [" ^ (descr d2) ^ "])"
| Patterns.Times(n1, n2) -> "Times({" ^ (node n1) ^ "}, {" ^ (node n2) ^ "})"
| Patterns.Xml(n1, n2) -> "Xml({" ^ (node n1) ^ "}, {" ^ (node n2) ^ "})"
| Patterns.Record(l, n) -> "Record(" ^ (Ns.Label.string_of_tag l) ^ ", {"
^ (node n) ^ "})"
| Patterns.Capture((id, name)) -> "Capture(" ^ (string_of_int (Upool.int id))
^ ", " ^ (Encodings.Utf8.to_string name) ^ ")"
| Patterns.Constant((id, name), ct) -> "Constant(("
^ (string_of_int (Upool.int id)) ^ ", " ^ (Encodings.Utf8.to_string name)
^ "), " ^ const ct ^ ")"
| Patterns.Dummy -> "Dummy"
and fv_to_string fv = match fv with
| (id, name) :: [] -> "(" ^ (string_of_int (Upool.int id)) ^ ", "
^ (Encodings.Utf8.to_string name) ^ ")"
| (id, name) :: rest -> "(" ^ (string_of_int (Upool.int id)) ^ ", "
^ (Encodings.Utf8.to_string name) ^ "), " ^ (fv_to_string rest)
| [] -> ""
open Printer
let run_test str =
try
......@@ -108,6 +16,12 @@ let tests = "CDuce runtime tests" >:::
~printer:(fun x -> x) ""
(run_test "(fun (Int -> Int) | x -> x)2");
);
]
"poly" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.typed.abstr.identity failed"
~printer:(fun x -> x) ""
(run_test "(fun (`A -> `A) | x -> x)2");
);
]
let _ = run_test_tt_main tests
let rec typed_to_string e = "{typ:" ^ (Types.Print.to_string e.Typed.exp_typ)
^ "; descr=" ^ (match e.Typed.exp_descr with
| Typed.Forget(e, _) -> "Forget(" ^ typed_to_string e ^ ")"
| Typed.Check(_, e, _) -> "Check(" ^ typed_to_string e ^ ")"
| Typed.Var(id, name) -> "Var(" ^ (string_of_int (Upool.int id)) ^ ", "
^ (Encodings.Utf8.to_string name) ^ ")"
| Typed.TVar(id, name) -> "TVar(" ^ (string_of_int (Upool.int id)) ^ ", "
^ (Encodings.Utf8.to_string name) ^ ")"
| Typed.Subst(e, _) -> "Subst(" ^ (typed_to_string e) ^ ", <sigma>)"
| Typed.ExtVar(_, (id, name), _) -> "ExtVar("
^ (string_of_int (Upool.int id)) ^ ", " ^ (Encodings.Utf8.to_string name)
^ ")"
| Typed.Apply(e1, e2) -> "(" ^ typed_to_string e1 ^ ").("
^ (typed_to_string e2) ^ ")"
| Typed.Abstraction(abstr) -> "Abstraction(" ^ (abst abstr) ^ ")"
| Typed.Cst(cst) -> const cst
| Typed.Pair(e1, e2) -> "(" ^ (typed_to_string e1) ^ ", "
^ (typed_to_string e2) ^ ")"
| Typed.String(_, _, s, _) -> "\"" ^ (Encodings.Utf8.to_string s) ^ "\""
| Typed.Match(e, b) -> "Match(" ^ (typed_to_string e) ^ "," ^ (branches b)
^ ")"
| _ -> assert false) ^ "}"
and const cst = match cst with
| Types.Integer(i) -> "Integer(" ^ (Intervals.V.to_string i) ^ ")"
| Types.Atom(a) -> "Atom(" ^ (Atoms.V.to_string a) ^ ")"
| Types.Char(c) -> "Char(" ^ (string_of_int (Chars.V.to_int c)) ^ ")"
| Types.Pair(c1, c2) -> "(" ^ const c1 ^ ", " ^ const c2 ^ ")"
| Types.String(_, _, s, _) -> "\"" ^ (Encodings.Utf8.to_string s) ^ "\""
| _ -> assert false
and abst abstr = (match abstr.Typed.fun_name with
| Some (id, name) -> "name:(" ^ (string_of_int (Upool.int id)) ^ ", "
^ (Encodings.Utf8.to_string name) ^ ")"
| None -> "name:<none>") ^ ",\niface:[" ^ (iface abstr.Typed.fun_iface)
^ "],\nbody:[" ^ (branches abstr.Typed.fun_body) ^ "], "
^ "typ:" ^ (Types.Print.to_string abstr.Typed.fun_typ) ^ ", fv:["
^ (fv_to_string abstr.Typed.fun_fv) ^ "]"
and iface list = match list with
| (t1, t2) :: [] -> "(" ^ (Types.Print.to_string t1) ^ ", "
^ (Types.Print.to_string t2) ^ ")"
| (t1, t2) :: rest -> "(" ^ (Types.Print.to_string t1) ^ ", "
^ (Types.Print.to_string t2) ^ "),"
| [] -> ""
and branches brs = "typ:" ^ (Types.Print.to_string brs.Typed.br_typ)
^ ", accept:" ^ (Types.Print.to_string brs.Typed.br_accept) ^ ", branches:"
^ (branch brs.Typed.br_branches)
and branch brs = match brs with
| br :: [] -> "\n{used:" ^ (string_of_bool br.Typed.br_used) ^ "; ghost:"
^ (string_of_bool br.Typed.br_ghost) ^ "; br_vars_empty:["
^ (fv_to_string br.Typed.br_vars_empty) ^ "];\npat:{"
^ (node br.Typed.br_pat) ^ "};\nbody:{typ:"
^ (Types.Print.to_string br.Typed.br_body.Typed.exp_typ) ^ ", descr:"
^ (typed_to_string br.Typed.br_body) ^ "}}"
| br :: rest -> "\n{used:" ^ (string_of_bool br.Typed.br_used) ^ "; ghost:"
^ (string_of_bool br.Typed.br_ghost) ^ "; br_vars_empty:["
^ (fv_to_string br.Typed.br_vars_empty) ^ "];\npat:{"
^ (node br.Typed.br_pat) ^ "};\nbody:{typ:"
^ (Types.Print.to_string br.Typed.br_body.Typed.exp_typ) ^ ", descr:"
^ (typed_to_string br.Typed.br_body) ^ "}}," ^ (branch rest)
| [] -> ""
and node node = "id:" ^ (string_of_int node.Patterns.id) ^ "; descr:["
^ (descr node.Patterns.descr) ^ "]; accept:[id:"
^ (string_of_int (Types.id node.Patterns.accept)) ^ "; descr:"
^ (Types.Print.to_string (Types.descr node.Patterns.accept)) ^ "]; fv:["
^ (fv_to_string node.Patterns.fv) ^ "]"
and descr (t, fv, d) = (Types.Print.to_string t)
^ "; [" ^ (fv_to_string fv) ^ "]; " ^ descr2 d
and descr2 d = match d with
| Patterns.Constr(t) -> "Constr(" ^ (Types.Print.to_string t) ^ ")"
| Patterns.Cup(d1, d2) -> "Cup([" ^ (descr d1) ^ "], [" ^ (descr d2) ^ "])"
| Patterns.Cap(d1, d2) -> "Cap([" ^ (descr d1) ^ "], [" ^ (descr d2) ^ "])"
| Patterns.Times(n1, n2) -> "Times({" ^ (node n1) ^ "}, {" ^ (node n2) ^ "})"
| Patterns.Xml(n1, n2) -> "Xml({" ^ (node n1) ^ "}, {" ^ (node n2) ^ "})"
| Patterns.Record(l, n) -> "Record(" ^ (Ns.Label.string_of_tag l) ^ ", {"
^ (node n) ^ "})"
| Patterns.Capture((id, name)) -> "Capture(" ^ (string_of_int (Upool.int id))
^ ", " ^ (Encodings.Utf8.to_string name) ^ ")"
| Patterns.Constant((id, name), ct) -> "Constant(("
^ (string_of_int (Upool.int id)) ^ ", " ^ (Encodings.Utf8.to_string name)
^ "), " ^ const ct ^ ")"
| Patterns.Dummy -> "Dummy"
and fv_to_string fv = match fv with
| (id, name) :: [] -> "(" ^ (string_of_int (Upool.int id)) ^ ", "
^ (Encodings.Utf8.to_string name) ^ ")"
| (id, name) :: rest -> "(" ^ (string_of_int (Upool.int id)) ^ ", "
^ (Encodings.Utf8.to_string name) ^ "), " ^ (fv_to_string rest)
| [] -> ""
val typed_to_string : Typed.texpr -> string
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