main.ml 20 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
  "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

  "Test CDuce.runtime.poly.tail failed",
35
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)* ]),{}))",
  "fun tail x : ['A{}] : ['A{}] -> match x : ['A{}] with | (el : 'A{}) :: (rest : ['A{}]) -> rest";
Pietro Abate's avatar
Pietro Abate committed
43

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

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



Pietro Abate's avatar
Pietro Abate committed
55
56
]

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

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

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

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

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

256
257
258
259
260
261
262
263
264
    "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");
    );

265
266
    "match" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.match.simple failed"
267
	~printer:(fun x -> x) "1"
268
	(run_test_eval "match 1 : Int with | 1 -> 1");
269
      assert_equal ~msg:"Test CDuce.runtime.match.simple_var failed"
270
	~printer:(fun x -> x) "2"
271
	(run_test_eval "(fun f x : Int : Int ->
272
                      match x : Int with | _ : Int -> x).2");
273
      assert_equal ~msg:"Test CDuce.runtime.match.medium failed"
274
	~printer:(fun x -> x) "2"
275
	(run_test_eval "(fun f x : Int : Int ->
276
                      match x : Int with | 1 -> 3 | _ : Int -> x).2");
277
      assert_equal ~msg:"Test CDuce.runtime.match.rec failed"
278
	~printer:(fun x -> x) "3"
279
	(run_test_eval "(fun f x : Int : Int ->
280
                      match x : Int with | 1 -> 3 | _ : Int -> f.1).2");
281
282
283
284
    );

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

Julien Lopez's avatar
Julien Lopez committed
289
290
291
    "list" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.list.simple failed"
	~printer:(fun x -> x) "1"
292
	(run_test_eval "match [1; 2] : [Int] with
293
294
                     | (el : Int) :: (_ : [Int]) -> el
                     | [] -> 3");
Julien Lopez's avatar
Julien Lopez committed
295
296
      assert_equal ~msg:"Test CDuce.runtime.list.simple2 failed"
	~printer:(fun x -> x) "3"
297
298
299
	(run_test_eval "match [] : [Int] with
                     | (el : Int) :: (_ : [Int]) -> el
                     | [] -> 3");
Julien Lopez's avatar
Julien Lopez committed
300
      assert_equal ~msg:"Test CDuce.runtime.list.tail failed"
301
	~printer:(fun x -> x) "Abstraction(([ Int* ], [ Int* ]),{})"
302
	(run_test_eval "fun tail x : [Int] : [Int] -> match x : [Int] with
303
                     | (_ : Int) :: (rest : [Int]) -> rest");
304
      assert_equal ~msg:"Test CDuce.runtime.list.tail.eval failed"
305
	~printer:(fun x -> x) "(2, (5, Atom(nil), {}), {})"
306
	(run_test_eval "(fun tail x : [Int] : [Int] -> match x : [Int] with
307
                     | (_ : Int) :: (rest : [Int]) -> rest).[1; 2; 5]");
308
      assert_equal ~msg:"Test CDuce.runtime.list.last failed"
309
	~printer:(fun x -> x) "7"
310
	(run_test_eval "(fun f x : [Int] : [Int] -> match x : [Int] with
311
                     | (el : Int) :: [] -> el
312
                     | (_ : Int) :: (rest : [Int]) -> f.rest).[1; 2; 5; 4; 8; 7]");
313
314
315
      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
316
317
                     | (el : Int) :: [] -> el+1
                     | (el : Int) :: (rest : [Int]) -> ((el+1), (f.rest))).[1; 2; 5; 4; 8; 7]");
Julien Lopez's avatar
Julien Lopez committed
318
319
    );

320
321
    "union" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.union.identity failed"
322
	~printer:(fun x -> x) "Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
323
	(run_test_eval "fun f x : (Int | String) : (Int | String) -> x");
324
      assert_equal ~msg:"Test CDuce.runtime.union.match failed"
325
	~printer:(fun x -> x) "Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
326
	(run_test_eval "fun f x : (Int | String) : (Int | String) ->
327
                     match x : (Int | String) with
328
329
                       | _ : Int -> 2
                       | _ : String -> \"Piece of cake\"");
330
331
      assert_equal ~msg:"Test CDuce.runtime.union.match_applied failed"
	~printer:(fun x -> x) "2"
332
	(run_test_eval "(fun f x : (Int | String) : (Int | String) ->
333
                      match x : (Int | String) with
334
335
                        | _ : Int -> 2
                        | _ : String -> \"Piece of cake\").5");
336
337
      assert_equal ~msg:"Test CDuce.runtime.union.match_applied2 failed"
	~printer:(fun x -> x) "\"Piece of cake\""
338
	(run_test_eval "(fun f x : (Int | String) : (Int | String) ->
339
                      match x : (Int | String) with
340
341
                        | _ : Int -> 2
                        | _ : String -> \"Piece of cake\").\"test\"");
342
343
    );

344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
    "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\"");
    );

366
    "poly" >:: ( fun test_ctxt ->
Julien Lopez's avatar
Julien Lopez committed
367
368
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_pure failed"
	~printer:(fun x -> x)
369
370
	"Abstraction((`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | Arrow, 
`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any | Arrow),{})"
371
	(run_test_eval "fun f x : 'A{} : 'A{} -> x");
372
      assert_equal ~msg:"Test CDuce.runtime.poly.identity failed"
373
	~printer:(fun x -> x)
374
	"Abstraction(([ Char* ] | Int, [ Char* ] | Int),{})"
375
	(run_test_eval "(fun f x : 'A{A/Int;A/String} : 'A{A/Int;A/String} -> x)
Julien Lopez's avatar
Julien Lopez committed
376
                   {A/Int;A/String}");
377
378
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_applied failed"
	~printer:(fun x -> x) "2"
379
	(run_test_eval "((fun f x : 'A{A/Int;A/String} : 'A{A/Int;A/String} -> x)
Julien Lopez's avatar
Julien Lopez committed
380
                   {A/Int;A/String}).2");
381
382
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_applied2 failed"
	~printer:(fun x -> x) "2"
383
	(run_test_eval "((fun f x : 'A{A/String} : 'A{A/String} -> x){A/String}).2");
Julien Lopez's avatar
Julien Lopez committed
384
385
      assert_equal ~msg:"Test CDuce.runtime.poly.tail failed"
	~printer:(fun x -> x)
386
387
388
	"Abstraction(([ (`$A & Int | Char | Atom | (Any,Any) | <(Any) (Any)>Any |
               Arrow)* ], [ (`$A & Int | Char | Atom | (Any,Any) |
                            <(Any) (Any)>Any | Arrow)* ]),{})"
389
	(run_test_eval "fun tail x : ['A{}] : ['A{}] -> match x : ['A{}] with
390
                     | (_ : 'A{}) :: (rest : ['A{}]) -> rest");
Julien Lopez's avatar
Julien Lopez committed
391
      assert_equal ~msg:"Test CDuce.runtime.poly.tail_applied failed"
392
	~printer:(fun x -> x) "(7, (8, (5, Atom(nil), {}), {}), {})"
393
	(run_test_eval "(fun tail x : ['A{}] : ['A{}] -> match x : ['A{}] with
394
                     | (_ : 'A{}) :: (rest : ['A{}]) -> rest).[3; 7; 8; 5]");
395

396
397
    );

398
399
  ]

Pietro Abate's avatar
Pietro Abate committed
400
401
402
403
let _ =
  run_test_tt_main (
    test_list
      [ tests_compile;
404
        tests_eval
Pietro Abate's avatar
Pietro Abate committed
405
406
407
408
      ]
  )
;;