main.ml 3.46 KB
Newer Older
1
open OUnit2
2
open Printf
3
open Printer
4
5
open Camlp4.PreCast

6
let run_test str =
7
try
8
  let expr = Parse.ExprParser.of_string_no_file str in
9
10
  let env, texpr = Compute.to_typed expr in
  let evalexpr = Compile.compile_eval_expr env texpr in
11
  value_to_string evalexpr
12
with
13
  | Compute.Error -> exit 3
14
15
16
17
18
19
  | 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
    eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc) l
      cbegin cend; raise exn
20
  | e -> eprintf "Runtime error.\n"; raise e
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43

let tests = "CDuce runtime tests" >:::
  [
    "abstr" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.abstr.simple failed"
	 ~printer:(fun x -> x) "Abstraction((Int, Int))"
	(run_test "fun f x : Int : Int -> 2");
    );

    "apply" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.apply.simple failed"
	 ~printer:(fun x -> x) "2"
	(run_test "(fun f x : Int : Int -> x).2");
      assert_equal ~msg:"Test CDuce.runtime.apply.simple_pair failed"
	 ~printer:(fun x -> x) "(3, 2)"
	(run_test "(fun f x : (Int*Int) : (Int*Int) -> x).(3,2)");
      assert_equal ~msg:"Test CDuce.runtime.apply.medium failed"
	 ~printer:(fun x -> x) "(2, 3)"
	(run_test "((fun f x : Int y : Int : (Int*Int) -> x,y).2).3");
    );

    "misc" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.misc.firsts failed"
44
	 ~printer:(fun x -> x) "Abstraction(((Int,Int), (Int,Int) -> (Int,Int)))"
45
46
47
48
49
50
51
52
53
	(run_test "fun firsts x : (Int*Int) y : (Int*Int) : (Int*Int) ->
                     match x,y : ((Int*Int)*(Int*Int)) with
                       | (a : Int,_ : Int),(b : Int,_ : Int) -> a,b");
      assert_equal ~msg:"Test CDuce.runtime.misc.firsts_applied failed"
	 ~printer:(fun x -> x) "(5, 1)"
	(run_test "((fun firsts x : (Int*Int) y : (Int*Int) : (Int*Int) ->
                       match x,y : ((Int*Int)*(Int*Int)) with
                         | (a : Int,_ : Int),(b : Int,_ : Int) -> a,b)
                   .(5, 3)).(1, 4)");
Julien Lopez's avatar
Julien Lopez committed
54
55
56
57
58
59
60
      assert_equal ~msg:"Test CDuce.runtime.misc.applier failed"
	 ~printer:(fun x -> x) "Abstraction((Int, Int -> Int -> Int))"
	(run_test "fun applier x : Int f : (Int->Int) : Int -> f.x");
      assert_equal ~msg:"Test CDuce.runtime.misc.applier_applied failed"
	 ~printer:(fun x -> x) "2"
	(run_test "((fun applier x : Int f : (Int->Int) : Int ->
                       f.x).2).(fun g x : Int : Int -> x)");
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
    );

    "match" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.match.simple failed"
	 ~printer:(fun x -> x) "1"
	(run_test "match 1 : Int with | 1 -> 1 | \"true\" -> \"true\"");
      assert_equal ~msg:"Test CDuce.runtime.match.unused_branches failed"
	 ~printer:(fun x -> x) "1"
	(run_test "match 1 : Int with
                     | s : String -> s | b : Bool -> b | i : Int -> i");
      assert_equal ~msg:"Test CDuce.runtime.match.simple_var failed"
	 ~printer:(fun x -> x) "2"
	(run_test "(fun f x : Int : Int ->
                      match x : Int with | y : Int -> x).2");
      assert_equal ~msg:"Test CDuce.runtime.match.medium failed"
	 ~printer:(fun x -> x) "2"
	(run_test "(fun f x : Int : Int ->
                      match x : Int with | 1 -> 3 | x : Int -> x).2");
    );

    "string" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.string.simple failed"
	 ~printer:(fun x -> x) "\"The cake is a lie\""
	(run_test "\"The cake is a lie\"");
    );

  ]

let _ = run_test_tt_main tests