main.ml 6.33 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

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");
28
      assert_equal ~msg:"Test CDuce.runtime.abstr.medium failed"
29
	 ~printer:(fun x -> x) "Abstraction((Int, [ Char* ] -> [ Int Char* ]))"
30
	(run_test "fun f x : Int y : String : (Int*String) -> x,y");
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
    );

    "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"
47
	 ~printer:(fun x -> x) "Abstraction(((Int,Int), (Int,Int) -> (Int,Int)))"
48
49
50
51
52
53
54
55
56
	(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
57
58
59
60
61
62
63
      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)");
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
    );

    "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");
82
83
84
85
      assert_equal ~msg:"Test CDuce.runtime.match.rec failed"
	 ~printer:(fun x -> x) "3"
	(run_test "(fun f x : Int : Int ->
                      match x : Int with | 1 -> 3 | x : Int -> f.1).2");
86
87
88
89
90
91
92
93
    );

    "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\"");
    );

Julien Lopez's avatar
Julien Lopez committed
94
95
96
97
98
99
100
101
102
103
104
105
    "list" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.list.simple failed"
	~printer:(fun x -> x) "1"
	(run_test "match [1; 2] : [Int] with
                     | (el : Int) :: (rest : [Int]) -> el
                     | x : Int -> 3");
      assert_equal ~msg:"Test CDuce.runtime.list.simple2 failed"
	~printer:(fun x -> x) "3"
	(run_test "match 2 : Int with
                     | (el : Int) :: (rest : [Int]) -> el
                     | x : Int -> 3");
      assert_equal ~msg:"Test CDuce.runtime.list.tail failed"
106
107
108
109
	~printer:(fun x -> x) "Abstraction(([ Int* ], [ Int* ]))"
	(run_test "fun tail x : [Int] : [Int] -> match x : [Int] with
                     | (el : Int) :: (rest : [Int]) -> rest");
      assert_equal ~msg:"Test CDuce.runtime.list.tail.eval failed"
Julien Lopez's avatar
Julien Lopez committed
110
	~printer:(fun x -> x) "(2, 5)"
111
	(run_test "(fun tail x : [Int] : [Int] -> match x : [Int] with
Julien Lopez's avatar
Julien Lopez committed
112
                     | (el : Int) :: (rest : [Int]) -> rest).[1; 2; 5]");
113
      (* TODO: Fix this test, we need to define [] aka `nil *)
114
      assert_equal ~msg:"Test CDuce.runtime.list.last failed"
115
	~printer:(fun x -> x) "7"
116
	(run_test "(fun f x : [Int] : [Int] -> match x : [Int] with
117
118
                     | (el : Int) :: (rest : [Int]) -> f.rest
                     | el : [Int] -> el).[1; 2; 5; 4; 8; 7]");
Julien Lopez's avatar
Julien Lopez committed
119
120
    );

121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
    "union" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.union.identity failed"
	~printer:(fun x -> x) "Abstraction(([ Char* ] | Int, [ Char* ] | Int))"
	(run_test "fun f x : (Int | String) : (Int | String) -> x");
      assert_equal ~msg:"Test CDuce.runtime.union.match failed"
	~printer:(fun x -> x) "Abstraction(([ Char* ] | Int, [ Char* ] | Int))"
	(run_test "fun f x : (Int | String) : (Int | String) ->
                     match x : (Int | String) with
                       | x : Int -> 2
                       | x : String -> \"Piece of cake\"");
      assert_equal ~msg:"Test CDuce.runtime.union.match_applied failed"
	~printer:(fun x -> x) "2"
	(run_test "(fun f x : (Int | String) : (Int | String) ->
                      match x : (Int | String) with
                        | x : Int -> 2
                        | x : String -> \"Piece of cake\").5");
      assert_equal ~msg:"Test CDuce.runtime.union.match_applied2 failed"
	~printer:(fun x -> x) "\"Piece of cake\""
	(run_test "(fun f x : (Int | String) : (Int | String) ->
                      match x : (Int | String) with
                        | x : Int -> 2
                        | x : String -> \"Piece of cake\").\"test\"");
    );

145
146
147
  ]

let _ = run_test_tt_main tests