main.ml 11.3 KB
Newer Older
1
open OUnit2
Pietro Abate's avatar
Pietro Abate committed
2
3
4
open Camlp4.PreCast 

(* Typed -> Lamda *)
5
let run_test_compile msg expected totest =
Pietro Abate's avatar
Pietro Abate committed
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
  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
22
  fun _ -> assert_equal ~msg:msg ~printer:(fun x -> x) expected (aux totest)
Pietro Abate's avatar
Pietro Abate committed
23
24

let tests_poly_abstr = [
25
26
27
  "Test CDuce.lambda.const_abstr failed",
  "Abstraction(Dummy,,,,Sel(,(Int -> Int),{}))",
  "fun f x : Int : Int -> 2";
Pietro Abate's avatar
Pietro Abate committed
28

29
  "Test CDuce.lambda.poly.identity failed",
30
  "Abstraction(Dummy,,,,Sel(,([ Char* ] | Int -> [ Char* ] | Int),Comp({},{ { (`$A/
31
32
[ Char* ]) } ,{ (`$A/Int) } })))",
  "(fun f x : 'A{A/Int;A/String} : 'A{A/Int;A/String} -> x) {A/Int;A/String}";
Pietro Abate's avatar
Pietro Abate committed
33
34
35
36
37
38
39

  "Test CDuce.runtime.poly.tail failed",
  "Abstraction(([ (`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any \
 | Arrow)* ], [ (`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | \
 Arrow)* ]),{})",
   "fun tail x : ['A{}] : ['A{}] -> match x : ['A{}] with | (el : 'A{}) :: (rest : ['A{}]) -> rest";

40
41
42
43
44
45
46
47
  "Test CDuce.runtime.poly.pair failed", "",
   "fun pair x : ('A * 'B) -> match x : ('A * 'B) with | (x,y) : ('A * 'B) -> x";

  "Test CDuce.runtime.poly.pair failed", "",
   "(match ( fun f x : 'A{} : 'A{} ) with y : ('A{} -> 'A{}) -> y{A/Int}).3";



Pietro Abate's avatar
Pietro Abate committed
48
49
]

50
51
let tests_compile = "CDuce compile tests (Typed -> Lambda )" >:::
  List.map (fun (m,e,f) -> f >:: run_test_compile m e f) tests_poly_abstr
52

53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
(* Typed -> Lambda -> Value *)
let run_test_eval str =
  try
    let expr = Parse.ExprParser.of_string_no_file str in
    let env, texpr = Compute.to_typed expr in
    let evalexpr = Compile.compile_eval_expr env texpr in
    Printer.value_to_string evalexpr
  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
69

70
let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
71
72
73
  [
    "abstr" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.abstr.simple failed"
Pietro Abate's avatar
Pietro Abate committed
74
       ~printer:(fun x -> x) "Abstraction((Int, Int),{})"
75
	(run_test_eval "fun f x : Int : Int -> 2");
76
      assert_equal ~msg:"Test CDuce.runtime.abstr.medium failed"
77
78
       ~printer:(fun x -> x)
	"Abstraction((Int, [ Char* ] -> [ Int Char* ]),{})"
79
	(run_test_eval "fun f x : Int y : String : (Int*String) -> x,y");
80
81
82
83
84
    );

    "apply" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.apply.simple failed"
	 ~printer:(fun x -> x) "2"
85
	(run_test_eval "(fun f x : Int : Int -> x).2");
86
      assert_equal ~msg:"Test CDuce.runtime.apply.simple_pair failed"
Pietro Abate's avatar
Pietro Abate committed
87
       ~printer:(fun x -> x) "(3, 2, {})"
88
	(run_test_eval "(fun f x : (Int*Int) : (Int*Int) -> x).(3,2)");
89
      assert_equal ~msg:"Test CDuce.runtime.apply.medium failed"
Pietro Abate's avatar
Pietro Abate committed
90
       ~printer:(fun x -> x) "(2, 3, {})"
91
	(run_test_eval "((fun f x : Int y : Int : (Int*Int) -> x,y).2).3");
92
93
94
    );

    "misc" >:: ( fun test_ctxt ->
95
96
97
98
99
100
101
102
103
104
105
106
107
108
      assert_equal ~msg:"Test CDuce.runtime.misc.is_int failed"
       ~printer:(fun x -> x)
	"Abstraction(([ Char* ] | Int, Bool),{})"
	(run_test_eval "fun is_int x : (Int | String) : Bool ->
                          match x : (Int | String) with
                            | x : Int -> `true
                            | x : String -> `false");
      assert_equal ~msg:"Test CDuce.runtime.misc.map failed"
       ~printer:(fun x -> x)
	"Abstraction(((Int,Int), X1 -> X1 where X1 = (Int,Int)),{})"
	(run_test_eval "fun map f : ('A{}->'B{}) x : ['A{}] : ['B{}] ->
                          match x : ['A{}] with
                            | (el : 'A{}) :: (rest : ['A{}]) -> [f.el; (map.f).rest]
                            | el : ['A{}] -> f.el");
109
      assert_equal ~msg:"Test CDuce.runtime.misc.firsts failed"
110
111
       ~printer:(fun x -> x)
	"Abstraction(((Int,Int), X1 -> X1 where X1 = (Int,Int)),{})"
112
	(run_test_eval "fun firsts x : (Int*Int) y : (Int*Int) : (Int*Int) ->
113
114
115
                     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"
Pietro Abate's avatar
Pietro Abate committed
116
       ~printer:(fun x -> x) "(5, 1, {})"
117
	(run_test_eval "((fun firsts x : (Int*Int) y : (Int*Int) : (Int*Int) ->
118
119
120
                       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
121
      assert_equal ~msg:"Test CDuce.runtime.misc.applier failed"
Pietro Abate's avatar
Pietro Abate committed
122
       ~printer:(fun x -> x) "Abstraction((Int, Int -> Int -> Int),{})"
123
	(run_test_eval "fun applier x : Int f : (Int->Int) : Int -> f.x");
Julien Lopez's avatar
Julien Lopez committed
124
125
      assert_equal ~msg:"Test CDuce.runtime.misc.applier_applied failed"
	 ~printer:(fun x -> x) "2"
126
	(run_test_eval "((fun applier x : Int f : (Int->Int) : Int ->
Julien Lopez's avatar
Julien Lopez committed
127
                       f.x).2).(fun g x : Int : Int -> x)");
128
129
130
131
132
    );

    "match" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.match.simple failed"
	 ~printer:(fun x -> x) "1"
133
	(run_test_eval "match 1 : Int with | 1 -> 1 | \"true\" -> \"true\"");
134
135
      assert_equal ~msg:"Test CDuce.runtime.match.unused_branches failed"
	 ~printer:(fun x -> x) "1"
136
	(run_test_eval "match 1 : Int with
137
138
139
                     | s : String -> s | b : Bool -> b | i : Int -> i");
      assert_equal ~msg:"Test CDuce.runtime.match.simple_var failed"
	 ~printer:(fun x -> x) "2"
140
	(run_test_eval "(fun f x : Int : Int ->
141
142
143
                      match x : Int with | y : Int -> x).2");
      assert_equal ~msg:"Test CDuce.runtime.match.medium failed"
	 ~printer:(fun x -> x) "2"
144
	(run_test_eval "(fun f x : Int : Int ->
145
                      match x : Int with | 1 -> 3 | x : Int -> x).2");
146
147
      assert_equal ~msg:"Test CDuce.runtime.match.rec failed"
	 ~printer:(fun x -> x) "3"
148
	(run_test_eval "(fun f x : Int : Int ->
149
                      match x : Int with | 1 -> 3 | x : Int -> f.1).2");
150
151
152
153
154
    );

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

Julien Lopez's avatar
Julien Lopez committed
158
159
160
    "list" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.list.simple failed"
	~printer:(fun x -> x) "1"
161
	(run_test_eval "match [1; 2] : [Int] with
Julien Lopez's avatar
Julien Lopez committed
162
163
164
165
                     | (el : Int) :: (rest : [Int]) -> el
                     | x : Int -> 3");
      assert_equal ~msg:"Test CDuce.runtime.list.simple2 failed"
	~printer:(fun x -> x) "3"
166
	(run_test_eval "match 2 : Int with
Julien Lopez's avatar
Julien Lopez committed
167
168
169
                     | (el : Int) :: (rest : [Int]) -> el
                     | x : Int -> 3");
      assert_equal ~msg:"Test CDuce.runtime.list.tail failed"
Pietro Abate's avatar
Pietro Abate committed
170
      ~printer:(fun x -> x) "Abstraction(([ Int* ], [ Int* ]),{})"
171
	(run_test_eval "fun tail x : [Int] : [Int] -> match x : [Int] with
172
173
                     | (el : Int) :: (rest : [Int]) -> rest");
      assert_equal ~msg:"Test CDuce.runtime.list.tail.eval failed"
Pietro Abate's avatar
Pietro Abate committed
174
      ~printer:(fun x -> x) "(2, 5, {})"
175
	(run_test_eval "(fun tail x : [Int] : [Int] -> match x : [Int] with
Julien Lopez's avatar
Julien Lopez committed
176
                     | (el : Int) :: (rest : [Int]) -> rest).[1; 2; 5]");
177
      (* TODO: Fix this test, we need to define [] aka `nil *)
178
      assert_equal ~msg:"Test CDuce.runtime.list.last failed"
179
	~printer:(fun x -> x) "7"
180
	(run_test_eval "(fun f x : [Int] : [Int] -> match x : [Int] with
181
182
                     | (el : Int) :: (rest : [Int]) -> f.rest
                     | el : [Int] -> el).[1; 2; 5; 4; 8; 7]");
Julien Lopez's avatar
Julien Lopez committed
183
184
    );

185
    "union" >:: ( fun test_ctxt ->
186
187
188
189
190
      assert_equal ~msg:"Test CDuce.runtime.union.identity_precise failed"
      ~printer:(fun x -> x) "Abstraction((Int -> Int & X1 -> X1 where X1 = [ Char* ], Int -> Int &
                                                         X1 -> X1 where
                                                         X1 = [ Char* ]),{})"
	(run_test_eval "fun _f f : ((Int -> Int) & (String -> String)) : ((Int -> Int) & (String -> String)) -> f");
191
      assert_equal ~msg:"Test CDuce.runtime.union.identity failed"
Pietro Abate's avatar
Pietro Abate committed
192
      ~printer:(fun x -> x) "Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
193
	(run_test_eval "fun f x : (Int | String) : (Int | String) -> x");
194
      assert_equal ~msg:"Test CDuce.runtime.union.match failed"
Pietro Abate's avatar
Pietro Abate committed
195
      ~printer:(fun x -> x) "Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
196
	(run_test_eval "fun f x : (Int | String) : (Int | String) ->
197
198
199
200
201
                     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"
202
	(run_test_eval "(fun f x : (Int | String) : (Int | String) ->
203
204
205
206
207
                      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\""
208
	(run_test_eval "(fun f x : (Int | String) : (Int | String) ->
209
210
211
212
213
                      match x : (Int | String) with
                        | x : Int -> 2
                        | x : String -> \"Piece of cake\").\"test\"");
    );

214
    "poly" >:: ( fun test_ctxt ->
Julien Lopez's avatar
Julien Lopez committed
215
216
217
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_pure failed"
	~printer:(fun x -> x)
	"Abstraction((`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | \
Pietro Abate's avatar
Pietro Abate committed
218
 Arrow, `$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | Arrow),{})"
219
	(run_test_eval "fun f x : 'A{} : 'A{} -> x");
220
      assert_equal ~msg:"Test CDuce.runtime.poly.identity failed"
221
	~printer:(fun x -> x)
Pietro Abate's avatar
Pietro Abate committed
222
      "Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
223
	(run_test_eval "(fun f x : 'A{A/Int;A/String} : 'A{A/Int;A/String} -> x)
Julien Lopez's avatar
Julien Lopez committed
224
                   {A/Int;A/String}");
225
226
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_applied failed"
	~printer:(fun x -> x) "2"
227
	(run_test_eval "((fun f x : 'A{A/Int;A/String} : 'A{A/Int;A/String} -> x)
Julien Lopez's avatar
Julien Lopez committed
228
                   {A/Int;A/String}).2");
229
230
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_applied2 failed"
	~printer:(fun x -> x) "2"
231
	(run_test_eval "((fun f x : 'A{A/String} : 'A{A/String} -> x){A/String}).2");
Julien Lopez's avatar
Julien Lopez committed
232
233
234
235
      assert_equal ~msg:"Test CDuce.runtime.poly.tail failed"
	~printer:(fun x -> x)
	"Abstraction(([ (`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any \
 | Arrow)* ], [ (`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | \
Pietro Abate's avatar
Pietro Abate committed
236
 Arrow)* ]),{})"
237
	(run_test_eval "fun tail x : ['A{}] : ['A{}] -> match x : ['A{}] with
Julien Lopez's avatar
Julien Lopez committed
238
239
                     | (el : 'A{}) :: (rest : ['A{}]) -> rest");
      assert_equal ~msg:"Test CDuce.runtime.poly.tail_applied failed"
Pietro Abate's avatar
Pietro Abate committed
240
      ~printer:(fun x -> x) "(7, (8, 5, {}), {})"
241
	(run_test_eval "(fun tail x : ['A{}] : ['A{}] -> match x : ['A{}] with
Julien Lopez's avatar
Julien Lopez committed
242
                     | (el : 'A{}) :: (rest : ['A{}]) -> rest).[3; 7; 8; 5]");
243

244
245
    );

246
247
  ]

Pietro Abate's avatar
Pietro Abate committed
248
249
250
251
let _ =
  run_test_tt_main (
    test_list
      [ tests_compile;
252
        tests_eval
Pietro Abate's avatar
Pietro Abate committed
253
254
255
256
      ]
  )
;;