lambdaTests.ml 24.1 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
  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) ->
15
16
17
18
19
	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
20
21
      | 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
31
32
  "Abstraction(Dummy,,,,Sel(,([ Char* ] | Int -> [ Char* ] | Int),Comp({},{ { `$A = 
Int } ,{ `$A = [ Char* ]
 } })))",
Julien Lopez's avatar
Julien Lopez committed
33
  "(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
34
35

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

45
46
47
48
  "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),{}))",
49
  "fun pair x : ('A[{}] * 'B[{}]) : 'A[{}] -> match x : ('A[{}] * 'B[{}]) with | (z : 'A[{}], y : 'B[{}]) -> z";
50

51
  "Test CDuce.runtime.poly.match_abstr failed", "Apply(,)",
52
  "(match (fun f x : 'A[{}] : 'A[{}] -> x) : ('A[{}] -> 'A[{}]) with | y : ('A[{}] -> 'A[{}]) -> y[{A/Int}]).3";
53
54
55



Pietro Abate's avatar
Pietro Abate committed
56
57
]

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

61
62
63
64
65
66
67
68
69
70
71
72
73
(* 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
74
75
      Printf.eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc)
	l cbegin cend; raise exn
76
    | e -> Printf.eprintf "Runtime error.\n"; raise e
77

78
let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
79
80
  [
    "abstr" >:: ( fun test_ctxt ->
81
82
83
      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");
84
85
86
87
88
89
90
91
92
93
94
95
96
97
      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");
98
      assert_equal ~msg:"Test CDuce.runtime.abstr.simple failed"
99
	~printer:(fun x -> x) "Abstraction((Int, Int),{})"
100
	(run_test_eval "fun f x : Int : Int -> 2");
101
      assert_equal ~msg:"Test CDuce.runtime.abstr.medium failed"
102
	~printer:(fun x -> x)
103
	"Abstraction((Int, [ Char* ] -> [ Int Char* ]),{})"
104
	(run_test_eval "fun f x : Int y : String : (Int*String) -> x,y");
105
106
107
108
    );

    "apply" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.apply.simple failed"
109
	~printer:(fun x -> x) "2"
110
	(run_test_eval "(fun f x : Int : Int -> x).2");
111
      assert_equal ~msg:"Test CDuce.runtime.apply.simple_pair failed"
112
	~printer:(fun x -> x) "(3, 2, {})"
113
	(run_test_eval "(fun f x : (Int*Int) : (Int*Int) -> x).(3,2)");
114
      assert_equal ~msg:"Test CDuce.runtime.apply.medium failed"
115
	~printer:(fun x -> x) "(2, 3, {})"
116
	(run_test_eval "((fun f x : Int y : Int : (Int*Int) -> x,y).2).3");
117
118
119
    );

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

274
275
276
277
278
279
280
281
282
    "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");
    );

283
284
    "match" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.match.simple failed"
285
	~printer:(fun x -> x) "1"
286
	(run_test_eval "match 1 : Int with | 1 -> 1");
287
      assert_equal ~msg:"Test CDuce.runtime.match.simple_var failed"
288
	~printer:(fun x -> x) "2"
289
	(run_test_eval "(fun f x : Int : Int ->
290
                      match x : Int with | _ : Int -> x).2");
291
      assert_equal ~msg:"Test CDuce.runtime.match.medium failed"
292
	~printer:(fun x -> x) "2"
293
	(run_test_eval "(fun f x : Int : Int ->
294
                      match x : Int with | 1 -> 3 | _ : Int -> x).2");
295
      assert_equal ~msg:"Test CDuce.runtime.match.rec failed"
296
	~printer:(fun x -> x) "3"
297
	(run_test_eval "(fun f x : Int : Int ->
298
                      match x : Int with | 1 -> 3 | _ : Int -> f.1).2");
299
300
301
302
      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");
303
304
305
306
    );

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

Julien Lopez's avatar
Julien Lopez committed
311
312
313
    "list" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.list.simple failed"
	~printer:(fun x -> x) "1"
314
	(run_test_eval "match [1; 2] : [Int] with
315
316
                     | (el : Int) :: (_ : [Int]) -> el
                     | [] -> 3");
Julien Lopez's avatar
Julien Lopez committed
317
318
      assert_equal ~msg:"Test CDuce.runtime.list.simple2 failed"
	~printer:(fun x -> x) "3"
319
320
321
	(run_test_eval "match [] : [Int] with
                     | (el : Int) :: (_ : [Int]) -> el
                     | [] -> 3");
Julien Lopez's avatar
Julien Lopez committed
322
      assert_equal ~msg:"Test CDuce.runtime.list.tail failed"
323
	~printer:(fun x -> x) "Abstraction(([ Int* ], [ Int* ]),{})"
324
	(run_test_eval "fun tail x : [Int] : [Int] -> match x : [Int] with
325
                     | (_ : Int) :: (rest : [Int]) -> rest");
326
      assert_equal ~msg:"Test CDuce.runtime.list.tail.eval failed"
327
	~printer:(fun x -> x) "(2, (5, Atom(nil), {}), {})"
328
	(run_test_eval "(fun tail x : [Int] : [Int] -> match x : [Int] with
329
                     | (_ : Int) :: (rest : [Int]) -> rest).[1; 2; 5]");
330
      assert_equal ~msg:"Test CDuce.runtime.list.last failed"
331
	~printer:(fun x -> x) "7"
332
	(run_test_eval "(fun f x : [Int] : [Int] -> match x : [Int] with
333
                     | (el : Int) :: [] -> el
334
                     | (_ : Int) :: (rest : [Int]) -> f.rest).[1; 2; 5; 4; 8; 7]");
335
336
337
      assert_equal ~msg:"Test CDuce.runtime.list.plusone failed"
	~printer:(fun x -> x) "(2, (3, (6, (5, (9, 8, {}), {}), {}), {}), {})"
	(run_test_eval "(fun f x : [Int] : [Int] -> match x : [Int] with
338
339
                     | (el : Int) :: [] -> el+1
                     | (el : Int) :: (rest : [Int]) -> ((el+1), (f.rest))).[1; 2; 5; 4; 8; 7]");
340
341
342
343
344
      assert_equal ~msg:"Test CDuce.runtime.list.concat failed"
	~printer:(fun x -> x) "(1, (2, (5, (4, (8, (7, (2, (3, (4, Atom(nil), {}), {}), {}), {}), {}), {}), {}), {}), {})"
	(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]]");
345
346
347
348
349
350
351
      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"
	~printer:(fun x -> x) "((6, 0, {}), 2, {})"
Julien Lopez's avatar
Julien Lopez committed
352
353
	(run_test_eval "let length : (['A[{A/Int},{A/Bool}]] -> Int) =
                          (fun f l : ['A[{A/Int},{A/Bool}]] : Int -> match l : ['A[{A/Int},{A/Bool}]] with
354
                             | [] -> 0
Julien Lopez's avatar
Julien Lopez committed
355
                             | (el : 'A[{A/Int},{A/Bool}]) :: (rest : ['A[{A/Int},{A/Bool}]]) -> f.rest + 1)
356
357
                        in
                        (length.[1; 2; 5; 4; 8; 7], length.[], length.[`true; 2]) : (Int*Int*Int)");
358
359
      assert_equal ~msg:"Test CDuce.runtime.list.nth failed"
	~printer:(fun x -> x) "5"
Julien Lopez's avatar
Julien Lopez committed
360
361
362
363
	(run_test_eval "(fun nth l : ['A[{A/(Int|Bool)}]] n : Int : 'A[{A/(Int|Bool)}] ->
                           match l : ['A[{A/(Int|Bool)}]] with
                             | (el : 'A[{A/(Int|Bool)}]) :: [] -> el
                             | (el : 'A[{A/(Int|Bool)}]) :: (rest : ['A[{A/(Int|Bool)}]]) ->
364
                               (if n = 0 then el else nth.rest.(n-1))).[1; 2; 5; `true; 2].2");
365
366
367
368
369
370
371
      assert_equal ~msg:"Test CDuce.runtime.list.rev failed"
	~printer:(fun x -> x) "(2, (Atom(true), (5, (2, (1, Atom(nil), {}), {}), {}), {}), {})"
	(run_test_eval "(fun rev l : ['A[{A/(Int|Bool)}]] : ['A[{A/(Int|Bool)}]] ->
                           match l : ['A[{A/(Int|Bool)}]] with
                             | (el : 'A[{A/(Int|Bool)}]) :: [] -> [el]
                             | (el : 'A[{A/(Int|Bool)}]) :: (rest : ['A[{A/(Int|Bool)}]]) ->
                               (rev.rest) @ [el]).[1; 2; 5; `true; 2]");
Julien Lopez's avatar
Julien Lopez committed
372
373
    );

374
375
    "union" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.union.identity failed"
376
	~printer:(fun x -> x) "Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
377
	(run_test_eval "fun f x : (Int | String) : (Int | String) -> x");
378
      assert_equal ~msg:"Test CDuce.runtime.union.match failed"
379
	~printer:(fun x -> x) "Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
380
	(run_test_eval "fun f x : (Int | String) : (Int | String) ->
381
                     match x : (Int | String) with
382
383
                       | _ : Int -> 2
                       | _ : String -> \"Piece of cake\"");
384
385
      assert_equal ~msg:"Test CDuce.runtime.union.match_applied failed"
	~printer:(fun x -> x) "2"
386
	(run_test_eval "(fun f x : (Int | String) : (Int | String) ->
387
                      match x : (Int | String) with
388
389
                        | _ : Int -> 2
                        | _ : String -> \"Piece of cake\").5");
390
391
      assert_equal ~msg:"Test CDuce.runtime.union.match_applied2 failed"
	~printer:(fun x -> x) "\"Piece of cake\""
392
	(run_test_eval "(fun f x : (Int | String) : (Int | String) ->
393
                      match x : (Int | String) with
394
395
                        | _ : Int -> 2
                        | _ : String -> \"Piece of cake\").\"test\"");
396
397
    );

398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
    "union_precise" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.union_precise.identity failed"
	~printer:(fun x -> x) "Abstraction((Int, Int) ,([ Char* ], [ Char* ]),{})"
	(run_test_eval "fun ((Int -> Int) & (String -> String))
                          | x : (Int | String) -> x");
      assert_equal ~msg:"Test CDuce.runtime.union_precise.match failed"
	~printer:(fun x -> x) "Abstraction((Int, Int) ,([ Char* ], [ Char* ]),{})"
	(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\"");
    );

420
    "poly" >:: ( fun test_ctxt ->
Julien Lopez's avatar
Julien Lopez committed
421
422
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_pure failed"
	~printer:(fun x -> x)
423
424
	"Abstraction((`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | Arrow, 
`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | Arrow),{})"
425
	(run_test_eval "fun f x : 'A[{}] : 'A[{}] -> x");
426
      assert_equal ~msg:"Test CDuce.runtime.poly.identity failed"
427
	~printer:(fun x -> x)
428
	"Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
Julien Lopez's avatar
Julien Lopez committed
429
430
	(run_test_eval "(fun f x : 'A[{A/Int},{A/String}] : 'A[{A/Int},{A/String}] -> x)
                   [{A/Int},{A/String}]");
431
432
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_applied failed"
	~printer:(fun x -> x) "2"
Julien Lopez's avatar
Julien Lopez committed
433
434
	(run_test_eval "((fun f x : 'A[{A/Int},{A/String}] : 'A[{A/Int},{A/String}] -> x)
                   [{A/Int},{A/String}]).2");
435
436
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_applied2 failed"
	~printer:(fun x -> x) "2"
Julien Lopez's avatar
Julien Lopez committed
437
	(run_test_eval "((fun f x : 'A[{A/String}] : 'A[{A/String}] -> x)[{A/String}]).2");
Julien Lopez's avatar
Julien Lopez committed
438
439
      assert_equal ~msg:"Test CDuce.runtime.poly.tail failed"
	~printer:(fun x -> x)
440
441
442
	"Abstraction(([ (`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any |
               Arrow)* ], [ (`$A & Int | Char | Atom | (Any,Any) |
                            <(Any) (Any)>Any | Arrow)* ]),{})"
443
444
	(run_test_eval "fun tail x : ['A[{}]] : ['A[{}]] -> match x : ['A[{}]] with
                     | (_ : 'A[{}]) :: (rest : ['A[{}]]) -> rest");
Julien Lopez's avatar
Julien Lopez committed
445
      assert_equal ~msg:"Test CDuce.runtime.poly.tail_applied failed"
446
	~printer:(fun x -> x) "(7, (8, (5, Atom(nil), {}), {}), {})"
447
448
	(run_test_eval "(fun tail x : ['A[{}]] : ['A[{}]] -> match x : ['A[{}]] with
                     | (_ : 'A[{}]) :: (rest : ['A[{}]]) -> rest).[3; 7; 8; 5]");
449

450
451
    );

452
453
  ]

Pietro Abate's avatar
Pietro Abate committed
454
455
456
457
let _ =
  run_test_tt_main (
    test_list
      [ tests_compile;
458
        tests_eval
Pietro Abate's avatar
Pietro Abate committed
459
460
461
      ]
  )
;;