lambdaTests.ml 23.6 KB
Newer Older
1
open OUnit2
Pietro Abate's avatar
Pietro Abate committed
2
3
open Camlp4.PreCast 

Pietro Abate's avatar
Pietro Abate committed
4
(* Typed -> Lambda *)
5
let run_test_compile msg expected totest =
Pietro Abate's avatar
Pietro Abate committed
6
7
8
9
  let aux str =
    try
      let expr = Parse.ExprParser.of_string_no_file str in
      let env, texpr = Compute.to_typed expr in
Pietro Abate's avatar
Pietro Abate committed
10
      Format.printf "Computed Typed -> %s%!@." (Printer.typed_to_string texpr);
Pietro Abate's avatar
Pietro Abate committed
11
12
13
14
15
      let lambdaexpr = Compile.compile env texpr in
      Printer.lambda_to_string lambdaexpr
    with
      | Compute.Error -> exit 3
      | Loc.Exc_located (loc, exn) ->
16
17
18
19
20
	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
Pietro Abate's avatar
Pietro Abate committed
21
22
      | e -> Printf.eprintf "Runtime error.\n"; raise e
  in
23
  fun _ -> assert_equal ~msg:msg ~printer:(fun x -> x) expected (aux totest)
Pietro Abate's avatar
Pietro Abate committed
24
25

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

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

  "Test CDuce.runtime.poly.tail failed",
37
38
39
40
41
42
43
  "Abstraction(Dummy,,,,Sel(,([ (`$A & Int | Char | Atom | (Any,Any) |
                             <(Any) (Any)>Any | Arrow)* ] -> [ (`$A & Int |
                                                               Char | 
                                                               Atom |
                                                               (Any,Any) |
                                                               <(Any) (Any)>Any |
                                                               Arrow)* ]),{}))",
44
  "fun tail x : ['A] : ['A] -> match x : ['A] with | (el : 'A) :: (rest : ['A]) -> rest";
Pietro Abate's avatar
Pietro Abate committed
45

46
47
48
49
  "Test CDuce.runtime.poly.pair failed", "Abstraction(Dummy,,,,Sel(,((`$A & Int | Char | Atom | (Any,Any) |
                           <(Any) (Any)>Any | Arrow,`$B & Int | Char | 
                           Atom | (Any,Any) | <(Any) (Any)>Any | Arrow) -> 
`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | Arrow),{}))",
50
  "fun pair x : ('A * 'B) : 'A -> match x : ('A * 'B) with | (z : 'A, y : 'B) -> z";
51

52
53
54
55
56
57
58
59
60
  "Test CDuce.runtime.poly.match_abstr failed", "Apply(Match(Abstraction(Dummy,,,,Sel(,(`$A & Int | Char | Atom | (Any,Any) |
                                       <(Any) (Any)>Any | Arrow -> `$A & Int |
                                                                   Char |
                                                                   Atom |
                                                                   (Any,Any) |
                                                                   <(Any) (Any)>Any |
                                                                   Arrow),{})), {accept_chars=false; brs_disp=<disp>; brs_rhs=[| (2, TVar(Local(0),Comp({},{ { `$A = 
Int
 } }))) |]; brs_stack_pos=0}),Const(3))",
61
  "(match (fun f x : 'A : 'A -> x) : ('A -> 'A) with | y : ('A -> 'A) -> y[{A/Int}]).3";
62
63
64



Pietro Abate's avatar
Pietro Abate committed
65
66
]

Pietro Abate's avatar
Pietro Abate committed
67
let tests_poly_abstr = [
68
  (*
Pietro Abate's avatar
Pietro Abate committed
69
70
  "Test CDuce.lambda.const_abstr failed",
  "Abstraction(Dummy,,,,Sel((Int -> Int),{}))",
71
  "fun f x : 'A : 'A -> 2";
72
  *)
Pietro Abate's avatar
Pietro Abate committed
73

74
  "Test CDuce.lambda.identity_applied failed",
75
76
  "Apply(Abstraction(Dummy,Dummy,,,,Sel(Env(1),(`$A -> `$A),{ { `$A = Int
 } }),Env(1)),Const(2))",
77
  "(fun f x : 'A : 'A -> x)[{A/Int}].2";
Pietro Abate's avatar
Pietro Abate committed
78
79
];;

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

83
84
85
86
87
88
89
90
91
92
93
94
95
(* 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
96
97
      Printf.eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc)
	l cbegin cend; raise exn
98
    | e -> Printf.eprintf "Runtime error.\n"; raise e
99

100
let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
101
102
  [
    "abstr" >:: ( fun test_ctxt ->
103
104
105
      assert_equal ~msg:"Test CDuce.runtime.abstr.let_simple failed"
	~printer:(fun x -> x) "3"
	(run_test_eval "let x : Int = 3 in x : Int");
106
107
108
109
110
111
112
113
114
115
116
117
118
119
      assert_equal ~msg:"Test CDuce.runtime.abstr.let_medium failed"
	~printer:(fun x -> x) "2"
	(run_test_eval "let f : (Int -> Int) = (fun (Int -> Int) | x : Int -> x)
                        in (f.f.2) : Int");
      assert_equal ~msg:"Test CDuce.runtime.abstr.let_nested_simple failed"
	~printer:(fun x -> x) "3"
	(run_test_eval "let f : (Int -> Int) = (fun (Int -> Int) | x : Int -> x + 1)
                        in (let x : Int = f.2
                            in x : Int) : Int");
      assert_equal ~msg:"Test CDuce.runtime.abstr.let_nested_medium failed"
	~printer:(fun x -> x) "4"
	(run_test_eval "let f : (Int -> Int) = (fun (Int -> Int) | x : Int -> x + 1)
                        in (let x : Int = f.2
                            in f.x : Int) : Int");
120
      assert_equal ~msg:"Test CDuce.runtime.abstr.simple failed"
121
	~printer:(fun x -> x) "Abstraction((Int,Int),Sel(1,(Int -> Int),Id))"
122
	(run_test_eval "fun f x : Int : Int -> 2");
123
      assert_equal ~msg:"Test CDuce.runtime.abstr.medium failed"
124
	~printer:(fun x -> x)
125
126
	"Abstraction((Int,[ Char* ] -> [ Int Char* ]),Sel(1,(Int -> [ Char* ] -> 
                                                           [ Int Char* ]),Id))"
127
	(run_test_eval "fun f x : Int y : String : (Int*String) -> x,y");
128
129
130
131
    );

    "apply" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.apply.simple failed"
132
	~printer:(fun x -> x) "2"
133
	(run_test_eval "(fun f x : Int : Int -> x).2");
134
      assert_equal ~msg:"Test CDuce.runtime.apply.simple_pair failed"
135
	~printer:(fun x -> x) "(3,2,Id)"
136
	(run_test_eval "(fun f x : (Int*Int) : (Int*Int) -> x).(3,2)");
137
      assert_equal ~msg:"Test CDuce.runtime.apply.medium failed"
138
	~printer:(fun x -> x) "(2,3,Id)"
139
	(run_test_eval "((fun f x : Int y : Int : (Int*Int) -> x,y).2).3");
140
141
142
    );

    "misc" >:: ( fun test_ctxt ->
143
144
      assert_equal ~msg:"Test CDuce.runtime.misc.even failed"
	~printer:(fun x -> x)
145
146
	"Abstraction((Int,Bool),(Any \\ (Int),Any \\ (Int)),Sel(1,(Int -> Bool),(
Any \\ (Int) -> Any \\ (Int)),Id))"
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
	(run_test_eval "fun ((Int -> Bool) & ((!Int) -> (!Int)))
                          | x : Int -> (match (x % 2) : Int with
                                          | 0 -> `true
                                          | 1 -> `false)
                          | x : (!Int) -> x");
      assert_equal ~msg:"Test CDuce.runtime.misc.even_applied1 failed"
	~printer:(fun x -> x)
	"Atom(false)"
	(run_test_eval "(fun ((Int -> Bool) & ((!Int) -> (!Int)))
                          | x : Int -> (match (x % 2) : Int with
                                          | 0 -> `true
                                          | 1 -> `false)
                          | x : (!Int) -> x).5");
      assert_equal ~msg:"Test CDuce.runtime.misc.even_applied2 failed"
	~printer:(fun x -> x)
	"Atom(true)"
	(run_test_eval "(fun ((Int -> Bool) & ((!Int) -> (!Int)))
                          | x : Int -> (match (x % 2) : Int with
                                          | 0 -> `true
                                          | 1 -> `false)
                          | x : (!Int) -> x).8");
      assert_equal ~msg:"Test CDuce.runtime.misc.even_applied3 failed"
	~printer:(fun x -> x)
170
	"(2,(3,Atom(nil),Id),Id)"
171
172
173
174
175
	(run_test_eval "(fun ((Int -> Bool) & ((!Int) -> (!Int)))
                          | x : Int -> (match (x % 2) : Int with
                                          | 0 -> `true
                                          | 1 -> `false)
                          | x : (!Int) -> x).[2; 3]");
176
      assert_equal ~msg:"Test CDuce.runtime.misc.is_int failed"
177
	~printer:(fun x -> x)
178
179
	"Abstraction((Int,Bool),(Bool,Bool),(Any \\ (Int | Bool),Any \\ (Int | Bool)),Sel(1,(
Int -> Bool),(Bool -> Bool),(Any \\ (Int | Bool) -> Any \\ (Int | Bool)),Id))"
180
	(run_test_eval "fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
181
                          | x : Int -> `true
182
183
                          | x : Bool -> `false
                          | x : (!(Int|Bool)) -> x");
184
185
186
      assert_equal ~msg:"Test CDuce.runtime.misc.is_int_applied1 failed"
	~printer:(fun x -> x)
	"Atom(true)"
187
	(run_test_eval "(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
188
                           | x : Int -> `true
189
190
                           | x : Bool -> `false
                           | x : (!(Int|Bool)) -> x).2");
191
192
193
      assert_equal ~msg:"Test CDuce.runtime.misc.is_int_applied2 failed"
	~printer:(fun x -> x)
	"Atom(false)"
194
	(run_test_eval "(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
195
                           | x : Int -> `true
196
197
                           | x : Bool -> `false
                           | x : (!(Int|Bool)) -> x).`true");
198
199
      assert_equal ~msg:"Test CDuce.runtime.misc.is_int_applied3 failed"
	~printer:(fun x -> x)
200
	"(2,(3,Atom(nil),Id),Id)"
201
	(run_test_eval "(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
202
                           | x : Int -> `true
203
204
                           | x : Bool -> `false
                           | x : (!(Int|Bool)) -> x).[2; 3]");
205
      assert_equal ~msg:"Test CDuce.runtime.misc.map failed"
206
	~printer:(fun x -> x)
207
208
209
	"Abstraction((`$A -> `$B,[ `$A* ] -> [ `$B* ]),Sel(1,(`$A -> `$B -> [ `$A* ] -> 
                                                                   [ 
                                                                   `$B* ]),Id))"
210
211
212
213
	(run_test_eval "fun map f : ('A -> 'B) x : ['A] : ['B] ->
                          match x : ['A] with
                            | (el : 'A) :: [] -> f.el
                            | (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))");
214
215
      assert_equal ~msg:"Test CDuce.runtime.misc.map_even_simple failed"
	~printer:(fun x -> x)
216
217
218
219
220
	"(\"hey\",(Atom(false),Atom(nil),Id),Id)"
	(run_test_eval "(fun map f : ('A->'B) x : ['A] : ['B] ->
                          match x : ['A] with
                            | (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))
                            | [] -> [])[{A/Int},{A/Bool}].(fun ((Int -> Bool) & ((!Int) -> (!Int)))
221
222
223
224
225
226
                          | x : Int -> (match (x % 2) : Int with
                                          | 0 -> `true
                                          | 1 -> `false)
                          | x : (!Int) -> x).[\"hey\"; 3]");
      assert_equal ~msg:"Test CDuce.runtime.misc.map_even_medium failed"
	~printer:(fun x -> x)
227
228
229
230
231
	"(Atom(true),(\"hey\",(Atom(false),(Atom(true),Atom(nil),Id),Id),Id),Id)"
	(run_test_eval "(fun map f : ('A->'B) x : ['A] : ['B] ->
                          match x : ['A] with
                            | (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))
                            | [] -> [])[{A/Int},{A/Bool}].(fun ((Int -> Bool) & ((!Int) -> (!Int)))
232
233
234
                          | x : Int -> (match (x % 2) : Int with
                                          | 0 -> `true
                                          | 1 -> `false)
235
                          | x : (!Int) -> x).[4; \"hey\"; 3; 2]");
236
237
      assert_equal ~msg:"Test CDuce.runtime.misc.map_even_hard failed"
	~printer:(fun x -> x)
238
239
240
	"(Atom(true),(\"hey\",((3,(5,Atom(nil),Id),{ { `$A = Int } ,{ `$A = Bool
 } }),(Atom(true),(Abstraction((`$C,`$C),Comp({ { `$A = Int } ,{ `$A = 
Bool } },Sel(1,(`$C -> `$C),Id))),(Atom(false),Atom(nil),Id),Id),Id),Id),Id),Id)"
241
242
243
244
	(run_test_eval "(fun map f : ('A->'B) x : ['A] : ['B] ->
                          match x : ['A] with
                            | (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))
                            | [] -> [])[{A/Int},{A/Bool}].(fun ((Int -> Bool) & ((!Int) -> (!Int)))
245
246
247
                          | x : Int -> (match (x % 2) : Int with
                                          | 0 -> `true
                                          | 1 -> `false)
248
                          | x : (!Int) -> x).[4; \"hey\"; [3; 5]; 2; (fun ('C -> 'C) | x : 'C -> x); 3+4]");
249
250
      assert_equal ~msg:"Test CDuce.runtime.misc.map_is_int_simple failed"
	~printer:(fun x -> x)
251
252
253
254
255
	"(Atom(false),(Atom(true),Atom(nil),Id),Id)"
	(run_test_eval "(fun map f : ('A->'B) x : ['A] : ['B] ->
                          match x : ['A] with
                            | (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))
                            | [] -> [])[{A/Int},{A/Bool}].(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
256
257
258
259
260
                          | x : Int -> `true
                          | x : Bool -> `false
                          | x : (!(Int|Bool)) -> x).[`true; 3]");
      assert_equal ~msg:"Test CDuce.runtime.misc.map_is_int_medium failed"
	~printer:(fun x -> x)
261
262
263
264
265
	"(Atom(false),(Atom(true),(Atom(false),Atom(nil),Id),Id),Id)"
	(run_test_eval "(fun map f : ('A->'B) x : ['A] : ['B] ->
                          match x : ['A] with
                            | (el : 'A) :: (rest : ['A]) -> ((f.el), ((map.f).rest))
                            | [] -> [])[{A/Int},{A/Bool}].(fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
266
267
268
                          | x : Int -> `true
                          | x : Bool -> `false
                          | x : (!(Int|Bool)) -> x).[`true; 3; `true]");
269
      assert_equal ~msg:"Test CDuce.runtime.misc.firsts failed"
270
	~printer:(fun x -> x)
271
272
	"Abstraction(((Int,Int),X1 -> X1 where X1 = (Int,Int)),Sel(1,((Int,Int) -> 
X1 -> X1 where X1 = (Int,Int)),Id))"
273
	(run_test_eval "fun firsts x : (Int*Int) y : (Int*Int) : (Int*Int) ->
274
275
276
                     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"
277
	~printer:(fun x -> x) "(5,1,Id)"
278
	(run_test_eval "((fun firsts x : (Int*Int) y : (Int*Int) : (Int*Int) ->
279
280
281
                       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
282
      assert_equal ~msg:"Test CDuce.runtime.misc.applier failed"
283
	~printer:(fun x -> x) "Abstraction((Int,Int -> Int -> Int),Sel(1,(Int -> Int -> Int -> Int),Id))"
284
	(run_test_eval "fun applier x : Int f : (Int->Int) : Int -> f.x");
Julien Lopez's avatar
Julien Lopez committed
285
      assert_equal ~msg:"Test CDuce.runtime.misc.applier_applied failed"
286
	~printer:(fun x -> x) "2"
287
	(run_test_eval "((fun applier x : Int f : (Int->Int) : Int ->
Julien Lopez's avatar
Julien Lopez committed
288
                       f.x).2).(fun g x : Int : Int -> x)");
289
290
    );

291
292
293
294
295
296
297
298
299
    "arith" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.arith.simple failed"
	~printer:(fun x -> x) "5"
	(run_test_eval "2+3");
      assert_equal ~msg:"Test CDuce.runtime.arith.complete failed"
	~printer:(fun x -> x) "1"
	(run_test_eval "2+5*7%2-8/4");
    );

300
301
    "match" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.match.simple failed"
302
	~printer:(fun x -> x) "1"
303
	(run_test_eval "match 1 : Int with | 1 -> 1");
304
      assert_equal ~msg:"Test CDuce.runtime.match.simple_var failed"
305
	~printer:(fun x -> x) "2"
306
	(run_test_eval "(fun f x : Int : Int ->
307
                      match x : Int with | _ : Int -> x).2");
308
      assert_equal ~msg:"Test CDuce.runtime.match.medium failed"
309
	~printer:(fun x -> x) "2"
310
	(run_test_eval "(fun f x : Int : Int ->
311
                      match x : Int with | 1 -> 3 | _ : Int -> x).2");
312
      assert_equal ~msg:"Test CDuce.runtime.match.rec failed"
313
	~printer:(fun x -> x) "3"
314
	(run_test_eval "(fun f x : Int : Int ->
315
                      match x : Int with | 1 -> 3 | _ : Int -> f.1).2");
316
317
318
319
      assert_equal ~msg:"Test CDuce.runtime.match.desugar_if failed"
	~printer:(fun x -> x) "0"
	(run_test_eval "((fun f x : Int y : Int : Int ->
                           match (x = y) : Bool with | `true -> 0 | `false -> 1).2).2");
320
321
322
323
    );

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

Julien Lopez's avatar
Julien Lopez committed
328
329
330
    "list" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.list.simple failed"
	~printer:(fun x -> x) "1"
331
	(run_test_eval "match [1; 2] : [Int] with
332
333
                     | (el : Int) :: (_ : [Int]) -> el
                     | [] -> 3");
Julien Lopez's avatar
Julien Lopez committed
334
335
      assert_equal ~msg:"Test CDuce.runtime.list.simple2 failed"
	~printer:(fun x -> x) "3"
336
337
338
	(run_test_eval "match [] : [Int] with
                     | (el : Int) :: (_ : [Int]) -> el
                     | [] -> 3");
Julien Lopez's avatar
Julien Lopez committed
339
      assert_equal ~msg:"Test CDuce.runtime.list.tail failed"
340
	~printer:(fun x -> x) "Abstraction(([ Int* ],[ Int* ]),Sel(1,([ Int* ] -> [ Int* ]),Id))"
341
	(run_test_eval "fun tail x : [Int] : [Int] -> match x : [Int] with
342
                     | (_ : Int) :: (rest : [Int]) -> rest");
343
      assert_equal ~msg:"Test CDuce.runtime.list.tail.eval failed"
344
	~printer:(fun x -> x) "(2,(5,Atom(nil),Id),Id)"
345
	(run_test_eval "(fun tail x : [Int] : [Int] -> match x : [Int] with
346
                     | (_ : Int) :: (rest : [Int]) -> rest).[1; 2; 5]");
347
      assert_equal ~msg:"Test CDuce.runtime.list.last failed"
348
	~printer:(fun x -> x) "7"
349
	(run_test_eval "(fun f x : [Int] : [Int] -> match x : [Int] with
350
                     | (el : Int) :: [] -> el
351
                     | (_ : Int) :: (rest : [Int]) -> f.rest).[1; 2; 5; 4; 8; 7]");
352
      assert_equal ~msg:"Test CDuce.runtime.list.plusone failed"
353
	~printer:(fun x -> x) "(2,(3,(6,(5,(9,8,Id),Id),Id),Id),Id)"
354
	(run_test_eval "(fun f x : [Int] : [Int] -> match x : [Int] with
355
356
                     | (el : Int) :: [] -> el+1
                     | (el : Int) :: (rest : [Int]) -> ((el+1), (f.rest))).[1; 2; 5; 4; 8; 7]");
357
      assert_equal ~msg:"Test CDuce.runtime.list.concat failed"
358
	~printer:(fun x -> x) "(1,(2,(5,(4,(8,(7,(2,(3,(4,Atom(nil),Id),Id),Id),Id),Id),Id),Id),Id),Id)"
359
360
361
	(run_test_eval "(fun concat x : [[Int]] : [Int] -> match x : [[Int]] with
                     | (el : [Int]) :: [] -> el
                     | (el : [Int]) :: (rest : [[Int]]) -> (el@(concat.rest))).[[1; 2; 5; 4; 8; 7]; [2; 3; 4]]");
362
363
364
365
366
367
      assert_equal ~msg:"Test CDuce.runtime.list.length_easy failed"
	~printer:(fun x -> x) "6"
	(run_test_eval "(fun length x : [Int] : Int -> match x : [Int] with
                     | [] -> 0
                     | (el : Int) :: (rest : [Int]) -> length.rest + 1).[1; 2; 5; 4; 8; 7]");
      assert_equal ~msg:"Test CDuce.runtime.list.length_hard failed"
368
369
370
	~printer:(fun x -> x) "((6,0,Id),2,Id)"
	(run_test_eval "let length : (['A] -> Int) =
                          (fun f l : ['A] : Int -> match l : ['A] with
371
                             | [] -> 0
372
                             | (el : 'A) :: (rest : ['A]) -> f.rest + 1)[{A/Int},{A/Bool}]
373
374
                        in
                        (length.[1; 2; 5; 4; 8; 7], length.[], length.[`true; 2]) : (Int*Int*Int)");
375
376
      assert_equal ~msg:"Test CDuce.runtime.list.nth failed"
	~printer:(fun x -> x) "5"
377
378
379
380
381
	(run_test_eval "(fun nth l : ['A] n : Int : 'A ->
                           match l : ['A] with
                             | (el : 'A) :: [] -> el
                             | (el : 'A) :: (rest : ['A]) ->
                               (if n = 0 then el else nth.rest.(n-1)))[{A/(Int|Bool)}].[1; 2; 5; `true; 2].2");
382
      assert_equal ~msg:"Test CDuce.runtime.list.rev failed"
383
384
385
386
387
388
	~printer:(fun x -> x) "(2,(Atom(true),(5,(2,(1,Atom(nil),Id),Id),Id),Id),Id)"
	(run_test_eval "(fun rev l : ['A] : ['A] ->
                           match l : ['A] with
                             | (el : 'A) :: [] -> [el]
                             | (el : 'A) :: (rest : ['A]) ->
                               (rev.rest) @ [el])[{A/(Int|Bool)}].[1; 2; 5; `true; 2]");
Julien Lopez's avatar
Julien Lopez committed
389
390
    );

391
392
    "union" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.union.identity failed"
393
394
	~printer:(fun x -> x) "Abstraction(([ Char* ] | Int,[ Char* ] | Int),Sel(1,([ Char* ] | Int -> 
[ Char* ] | Int),Id))"
395
	(run_test_eval "fun f x : (Int | String) : (Int | String) -> x");
396
      assert_equal ~msg:"Test CDuce.runtime.union.match failed"
397
398
	~printer:(fun x -> x) "Abstraction(([ Char* ] | Int,[ Char* ] | Int),Sel(1,([ Char* ] | Int -> 
[ Char* ] | Int),Id))"
399
	(run_test_eval "fun f x : (Int | String) : (Int | String) ->
400
                     match x : (Int | String) with
401
402
                       | _ : Int -> 2
                       | _ : String -> \"Piece of cake\"");
403
404
      assert_equal ~msg:"Test CDuce.runtime.union.match_applied failed"
	~printer:(fun x -> x) "2"
405
	(run_test_eval "(fun f x : (Int | String) : (Int | String) ->
406
                      match x : (Int | String) with
407
408
                        | _ : Int -> 2
                        | _ : String -> \"Piece of cake\").5");
409
410
      assert_equal ~msg:"Test CDuce.runtime.union.match_applied2 failed"
	~printer:(fun x -> x) "\"Piece of cake\""
411
	(run_test_eval "(fun f x : (Int | String) : (Int | String) ->
412
                      match x : (Int | String) with
413
414
                        | _ : Int -> 2
                        | _ : String -> \"Piece of cake\").\"test\"");
415
416
    );

417
418
    "union_precise" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.union_precise.identity failed"
419
420
	~printer:(fun x -> x) "Abstraction((Int,Int),([ Char* ],[ Char* ]),Sel(1,(Int -> Int),([ Char* ] -> 
[ Char* ]),Id))"
421
422
423
	(run_test_eval "fun ((Int -> Int) & (String -> String))
                          | x : (Int | String) -> x");
      assert_equal ~msg:"Test CDuce.runtime.union_precise.match failed"
424
425
	~printer:(fun x -> x) "Abstraction((Int,Int),([ Char* ],[ Char* ]),Sel(1,(Int -> Int),([ Char* ] -> 
[ Char* ]),Id))"
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
	(run_test_eval "fun ((Int -> Int) & (String -> String))
                          | x : Int -> 2
                          | x : String -> \"Piece of cake\"");
      assert_equal ~msg:"Test CDuce.runtime.union_precise.match_applied failed"
	~printer:(fun x -> x) "2"
	(run_test_eval "(fun ((Int -> Int) & (String -> String))
                           | x : Int -> 2
                           | x : String -> \"Piece of cake\").5");
      assert_equal ~msg:"Test CDuce.runtime.union_precise.match_applied2 failed"
	~printer:(fun x -> x) "\"Piece of cake\""
	(run_test_eval "(fun ((Int -> Int) & (String -> String))
                           | x : Int -> 2
                           | x : String -> \"Piece of cake\").\"test\"");
    );

441
    "poly" >:: ( fun test_ctxt ->
Julien Lopez's avatar
Julien Lopez committed
442
443
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_pure failed"
	~printer:(fun x -> x)
444
	"Abstraction((`$A,`$A),Sel(1,(`$A -> `$A),Id))"
445
	(run_test_eval "fun f x : 'A : 'A -> x");
446
      assert_equal ~msg:"Test CDuce.runtime.poly.identity failed"
447
	~printer:(fun x -> x)
448
449
	"Abstraction((`$A,`$A),Sel(1,(`$A -> `$A),{ { `$A = Int } ,{ `$A = [ Char* ]
 } }))"
450
	(run_test_eval "(fun f x : 'A : 'A -> x)[{A/Int},{A/String}]");
451
452
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_applied failed"
	~printer:(fun x -> x) "2"
453
	(run_test_eval "((fun f x : 'A : 'A -> x)[{A/Int},{A/String}]).2");
454
455
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_applied2 failed"
	~printer:(fun x -> x) "2"
456
	(run_test_eval "((fun f x : 'A : 'A -> x)[{A/Int}]).2");
Julien Lopez's avatar
Julien Lopez committed
457
458
      assert_equal ~msg:"Test CDuce.runtime.poly.tail failed"
	~printer:(fun x -> x)
459
	"Abstraction(([ `$A* ],[ `$A* ]),Sel(1,([ `$A* ] -> [ `$A* ]),Id))"
460
461
	(run_test_eval "fun tail x : ['A] : ['A] -> match x : ['A] with
                     | (_ : 'A) :: (rest : ['A]) -> rest");
Julien Lopez's avatar
Julien Lopez committed
462
      assert_equal ~msg:"Test CDuce.runtime.poly.tail_applied failed"
463
	~printer:(fun x -> x) "(7,(8,(5,Atom(nil),Id),Id),Id)"
464
465
	(run_test_eval "(fun tail x : ['A] : ['A] -> match x : ['A] with
                     | (_ : 'A) :: (rest : ['A]) -> rest).[3; 7; 8; 5]");
466

467
468
    );

469
470
  ]

Pietro Abate's avatar
Pietro Abate committed
471
472
473
474
let _ =
  run_test_tt_main (
    test_list
      [ tests_compile;
475
        tests_eval
Pietro Abate's avatar
Pietro Abate committed
476
477
478
      ]
  )
;;