Commit 3597ff2a authored by Pietro Abate's avatar Pietro Abate
Browse files

Add compile tests (broken)

parent 468b4581
open OUnit2
open Camlp4.PreCast
open Camlp4.PreCast
(* Typed -> Lamda *)
let run_test_compile expected totest =
let aux str =
try
let expr = Parse.ExprParser.of_string_no_file str in
let env, texpr = Compute.to_typed expr in
let lambdaexpr = Compile.compile env texpr in
Printer.lambda_to_string lambdaexpr
with
| Compute.Error -> exit 3
| Loc.Exc_located (loc, exn) ->
let l = Loc.start_line loc in
let cbegin = Loc.start_off loc - Loc.start_bol loc in
let cend = Loc.stop_off loc - Loc.start_bol loc in
Printf.eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc) l
cbegin cend; raise exn
| e -> Printf.eprintf "Runtime error.\n"; raise e
in
fun _ -> assert_equal ~printer:(fun x -> x) expected (aux totest)
let tests_poly_abstr = [
"Abstraction((Int, Int),{})","fun f x : Int : Int -> 2";
"Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})", "(fun f x : 'A{A/Int;A/String} : 'A{A/Int;A/String} -> x) {A/Int;A/String}";
]
let tests_compile = "CDuce compile tests (Typed -> Lambda )" >:::
List.map (fun (e,f) -> f >:: run_test_compile e f) tests_poly_abstr
(* Typed -> Lambda -> Value *)
let run_test_eval str =
......@@ -18,23 +46,6 @@ let run_test_eval str =
cbegin cend; raise exn
| e -> Printf.eprintf "Runtime error.\n"; raise e
(* Typed -> Lamda *)
let run_test_compile str =
try
let expr = Parse.ExprParser.of_string_no_file str in
let env, texpr = Compute.to_typed expr in
let lambdaexpr = Compile.compile env texpr in
Printer.lambda_to_string lambdaexpr
with
| Compute.Error -> exit 3
| Loc.Exc_located (loc, exn) ->
let l = Loc.start_line loc in
let cbegin = Loc.start_off loc - Loc.start_bol loc in
let cend = Loc.stop_off loc - Loc.start_bol loc in
Printf.eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc) l
cbegin cend; raise exn
| e -> Printf.eprintf "Runtime error.\n"; raise e
let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
[
"abstr" >:: ( fun test_ctxt ->
......@@ -192,4 +203,12 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
]
let _ = run_test_tt_main tests_eval
let _ =
run_test_tt_main (
test_list
[ tests_compile;
(* tests_eval *)
]
)
;;
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