lambdaTests.ml 25.8 KB
Newer Older
1
open OUnit2
2 3
open Camlp4.PreCast 

4
(* Typed -> Lambda *)
5
let run_test_compile msg expected totest =
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
10
      Format.printf "Computed Typed -> %a%!@." Typed.Print.pp_typed texpr;
11
      let lambdaexpr = Compile.compile env texpr in
12
      Lambda.Print.string_of_lambda lambdaexpr
13 14 15
    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
21 22
      | e -> Printf.eprintf "Runtime error.\n"; raise e
  in
23
  fun _ -> assert_equal ~msg:msg ~printer:(fun x -> x) expected (aux totest)
24 25

let tests_poly_abstr = [
26
  "Test CDuce.lambda.const_abstr failed",
27
  "Abstraction(Dummy,,,,Sel(,[(Int -> Int)],{}))",
28
  "fun f x : Int : Int -> 2";
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}]";
35 36

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

46
  "Test CDuce.runtime.poly.pair failed", "Abstraction(Dummy,,,,Sel(,[((`$A & Int | Char | Atom | (Any,Any) |
47 48
                           <(Any) (Any)>Any | Arrow,`$B & Int | Char | 
                           Atom | (Any,Any) | <(Any) (Any)>Any | Arrow) -> 
49
                             `$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
  "Test CDuce.runtime.poly.match_abstr failed", "Apply(Match(Abstraction(Dummy,,,,Sel(,[(`$A & Int | Char | Atom | (Any,Any) |
53 54 55 56 57
                                       <(Any) (Any)>Any | Arrow -> `$A & Int |
                                                                   Char |
                                                                   Atom |
                                                                   (Any,Any) |
                                                                   <(Any) (Any)>Any |
58
                                                                   Arrow)],{})), {accept_chars=false; brs_disp=<disp>; brs_rhs=[| (2, TVar(Local(0),Comp({},{ { `$A = 
59 60
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



65 66
]

67
let tests_poly_abstr = [
68
  (*
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",
Julien Lopez's avatar
Julien Lopez committed
75
  "Apply(PolyAbstraction([Dummy,Dummy],,{accept_chars=true; brs_disp=<disp>; brs_rhs=[| (1, Var(Local(0))) |]; brs_stack_pos=0},,Sel(Env(1),[(
76
`$A -> `$A)],{{`$A = Int
Julien Lopez's avatar
Julien Lopez committed
77
}})),Const(2))",
78
  "(fun f x : 'A : 'A -> x)[{A/Int}].2";
79 80
];;

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

84 85 86 87 88
(* 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
89 90
    let lambdaexpr,lsize = Compile.compile_expr env texpr in
    Format.printf "Input : %s\n" str;
91
    Format.printf "Lambda : %s\n" (Lambda.Print.string_of_lambda lambdaexpr);
92
    let evalexpr = Eval.expr lambdaexpr lsize in
93 94
    Format.printf "Eval : %a\n\n" Value.Print.pp_value evalexpr;
    Value.Print.string_of_value evalexpr
95 96 97 98 99 100
  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
101 102
      Printf.eprintf "File %s, line %d, characters %d-%d:\n" (Loc.file_name loc)
	l cbegin cend; raise exn
103
    | e -> Printf.eprintf "Runtime error.\n"; raise e
104

105
let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
106 107
  [
    "abstr" >:: ( fun test_ctxt ->
108 109 110
      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");
111 112 113
      assert_equal ~msg:"Test CDuce.runtime.abstr.let_sum failed"
	~printer:(fun x -> x) "5"
	(run_test_eval "let x : Int = 2 in (let y : Int = 3 in (x + y) : Int) : Int");
114 115 116 117 118 119 120 121 122 123 124 125 126 127
      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");
128
      assert_equal ~msg:"Test CDuce.runtime.abstr.simple failed"
Julien Lopez's avatar
Julien Lopez committed
129
	~printer:(fun x -> x) "Abstraction([(Int,Int)],Mono)"
130
	(run_test_eval "fun f x : Int : Int -> 2");
131
      assert_equal ~msg:"Test CDuce.runtime.abstr.medium failed"
132
	~printer:(fun x -> x)
Julien Lopez's avatar
Julien Lopez committed
133
	"Abstraction([(Int,[ Char* ] -> [ Int Char* ])],Mono)"
134
	(run_test_eval "fun f x : Int y : String : (Int*String) -> x,y");
135 136
      assert_equal ~msg:"Test CDuce.runtime.abstr.hard failed"
	~printer:(fun x -> x)
Julien Lopez's avatar
Julien Lopez committed
137
	"Abstraction([(Int -> Int -> Int,Int -> Int -> Int)],Mono)"
138
	(run_test_eval "fun (((Int -> Int) -> Int) -> (Int -> Int) -> Int) | x : ((Int -> Int) -> Int) -> (fun ((Int -> Int) -> Int) | y : (Int -> Int) -> x.y)");
139 140 141 142
    );

    "apply" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.apply.simple failed"
143
	~printer:(fun x -> x) "2"
144
	(run_test_eval "(fun f x : Int : Int -> x).2");
145
      assert_equal ~msg:"Test CDuce.runtime.apply.simple_pair failed"
146
	~printer:(fun x -> x) "(3,2,Mono)"
147
	(run_test_eval "(fun f x : (Int*Int) : (Int*Int) -> x).(3,2)");
148
      assert_equal ~msg:"Test CDuce.runtime.apply.medium failed"
149
	~printer:(fun x -> x) "(2,3,Mono)"
150
	(run_test_eval "((fun f x : Int y : Int : (Int*Int) -> x,y).2).3");
151 152 153
    );

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

307 308 309 310 311 312 313 314 315
    "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");
    );

316 317
    "match" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.match.simple failed"
318
	~printer:(fun x -> x) "1"
319
	(run_test_eval "match 1 : Int with | 1 -> 1");
320
      assert_equal ~msg:"Test CDuce.runtime.match.simple_var failed"
321
	~printer:(fun x -> x) "2"
322
	(run_test_eval "(fun f x : Int : Int ->
323
                      match x : Int with | _ : Int -> x).2");
324
      assert_equal ~msg:"Test CDuce.runtime.match.medium failed"
325
	~printer:(fun x -> x) "2"
326
	(run_test_eval "(fun f x : Int : Int ->
327
                      match x : Int with | 1 -> 3 | _ : Int -> x).2");
328
      assert_equal ~msg:"Test CDuce.runtime.match.rec failed"
329
	~printer:(fun x -> x) "3"
330
	(run_test_eval "(fun f x : Int : Int ->
331
                      match x : Int with | 1 -> 3 | _ : Int -> f.1).2");
332 333 334 335
      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");
336 337 338 339
    );

    "string" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.string.simple failed"
340
	~printer:(fun x -> x) "\"The cake is a lie\""
341
	(run_test_eval "\"The cake is a lie\"");
342 343 344
      assert_equal ~msg:"Test CDuce.runtime.string.char failed"
	~printer:(fun x -> x) "'c'"
	(run_test_eval "'c'");
345 346
    );

347 348 349
    "list" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.list.simple failed"
	~printer:(fun x -> x) "1"
350
	(run_test_eval "match [1; 2] : [Int] with
351 352
                     | (el : Int) :: (_ : [Int]) -> el
                     | [] -> 3");
353 354
      assert_equal ~msg:"Test CDuce.runtime.list.simple2 failed"
	~printer:(fun x -> x) "3"
355 356 357
	(run_test_eval "match [] : [Int] with
                     | (el : Int) :: (_ : [Int]) -> el
                     | [] -> 3");
358
      assert_equal ~msg:"Test CDuce.runtime.list.tail failed"
Julien Lopez's avatar
Julien Lopez committed
359
	~printer:(fun x -> x) "Abstraction([([ Int* ],[ Int* ])],Mono)"
360
	(run_test_eval "fun tail x : [Int] : [Int] -> match x : [Int] with
361
                     | (_ : Int) :: (rest : [Int]) -> rest");
362
      assert_equal ~msg:"Test CDuce.runtime.list.tail.eval failed"
363
	~printer:(fun x -> x) "(2,(5,Atom(nil),Mono),Mono)"
364
	(run_test_eval "(fun tail x : [Int] : [Int] -> match x : [Int] with
365
                     | (_ : Int) :: (rest : [Int]) -> rest).[1; 2; 5]");
366
      assert_equal ~msg:"Test CDuce.runtime.list.last failed"
367
	~printer:(fun x -> x) "7"
368
	(run_test_eval "(fun f x : [Int] : [Int] -> match x : [Int] with
369
                     | (el : Int) :: [] -> el
370
                     | (_ : Int) :: (rest : [Int]) -> f.rest).[1; 2; 5; 4; 8; 7]");
371
      assert_equal ~msg:"Test CDuce.runtime.list.plusone failed"
372
	~printer:(fun x -> x) "(2,(3,(6,(5,(9,8,Mono),Mono),Mono),Mono),Mono)"
373
	(run_test_eval "(fun f x : [Int] : [Int] -> match x : [Int] with
374 375
                     | (el : Int) :: [] -> el+1
                     | (el : Int) :: (rest : [Int]) -> ((el+1), (f.rest))).[1; 2; 5; 4; 8; 7]");
376
      assert_equal ~msg:"Test CDuce.runtime.list.concat failed"
377
	~printer:(fun x -> x) "(1,(2,(5,(4,(8,(7,(2,(3,(4,Atom(nil),Mono),Mono),Mono),Mono),Mono),Mono),Mono),Mono),Mono)"
378 379 380
	(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]]");
381 382 383 384 385 386
      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"
387
	~printer:(fun x -> x) "((6,0,Mono),2,Mono)"
388 389
	(run_test_eval "let length : (['A] -> Int) =
                          (fun f l : ['A] : Int -> match l : ['A] with
390
                             | [] -> 0
391
                             | (el : 'A) :: (rest : ['A]) -> f.rest + 1)[{A/Int},{A/Bool}]
392 393
                        in
                        (length.[1; 2; 5; 4; 8; 7], length.[], length.[`true; 2]) : (Int*Int*Int)");
394 395
      assert_equal ~msg:"Test CDuce.runtime.list.nth failed"
	~printer:(fun x -> x) "5"
396 397 398 399 400
	(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");
401
      assert_equal ~msg:"Test CDuce.runtime.list.rev failed"
402
	~printer:(fun x -> x) "(2,(Atom(true),(5,(2,(1,Atom(nil),Mono),Mono),Mono),Mono),Mono)"
403 404 405 406 407
	(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]");
408 409
    );

410 411
    "union" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.union.identity failed"
Julien Lopez's avatar
Julien Lopez committed
412
	~printer:(fun x -> x) "Abstraction([([ Char* ] | Int,[ Char* ] | Int)],Mono)"
413
	(run_test_eval "fun f x : (Int | String) : (Int | String) -> x");
414
      assert_equal ~msg:"Test CDuce.runtime.union.match failed"
Julien Lopez's avatar
Julien Lopez committed
415
	~printer:(fun x -> x) "Abstraction([([ Char* ] | Int,[ Char* ] | Int)],Mono)"
416
	(run_test_eval "fun f x : (Int | String) : (Int | String) ->
417
                     match x : (Int | String) with
418 419
                       | _ : Int -> 2
                       | _ : String -> \"Piece of cake\"");
420 421
      assert_equal ~msg:"Test CDuce.runtime.union.match_applied failed"
	~printer:(fun x -> x) "2"
422
	(run_test_eval "(fun f x : (Int | String) : (Int | String) ->
423
                      match x : (Int | String) with
424 425
                        | _ : Int -> 2
                        | _ : String -> \"Piece of cake\").5");
426 427
      assert_equal ~msg:"Test CDuce.runtime.union.match_applied2 failed"
	~printer:(fun x -> x) "\"Piece of cake\""
428
	(run_test_eval "(fun f x : (Int | String) : (Int | String) ->
429
                      match x : (Int | String) with
430 431
                        | _ : Int -> 2
                        | _ : String -> \"Piece of cake\").\"test\"");
432 433
    );

434 435
    "union_precise" >:: ( fun test_ctxt ->
      assert_equal ~msg:"Test CDuce.runtime.union_precise.identity failed"
Julien Lopez's avatar
Julien Lopez committed
436
	~printer:(fun x -> x) "Abstraction([(Int,Int),([ Char* ],[ Char* ])],Mono)"
437 438 439
	(run_test_eval "fun ((Int -> Int) & (String -> String))
                          | x : (Int | String) -> x");
      assert_equal ~msg:"Test CDuce.runtime.union_precise.match failed"
Julien Lopez's avatar
Julien Lopez committed
440
	~printer:(fun x -> x) "Abstraction([(Int,Int),([ Char* ],[ Char* ])],Mono)"
441 442 443 444 445 446 447 448 449 450 451 452 453 454 455
	(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\"");
    );

456
    "poly" >:: ( fun test_ctxt ->
457 458
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_pure failed"
	~printer:(fun x -> x)
Julien Lopez's avatar
Julien Lopez committed
459
	"Abstraction([(`$A,`$A)],Id)"
460
	(run_test_eval "fun f x : 'A : 'A -> x");
461

462
      assert_equal ~msg:"Test CDuce.runtime.poly.identity failed"
463
	~printer:(fun x -> x)
Julien Lopez's avatar
Julien Lopez committed
464 465
      "Abstraction([(`$A,`$A)],Sel(1,[(`$A -> `$A)],{{`$A = Int},{`$A = [ Char* ]
}}))"
466
	(run_test_eval "(fun f x : 'A : 'A -> x)[{A/Int},{A/String}]");
467

468 469
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_applied failed"
	~printer:(fun x -> x) "2"
470
	(run_test_eval "((fun f x : 'A : 'A -> x)[{A/Int},{A/String}]).2");
471

472 473
      assert_equal ~msg:"Test CDuce.runtime.poly.identity_applied2 failed"
	~printer:(fun x -> x) "2"
474
	(run_test_eval "((fun f x : 'A : 'A -> x)[{A/Int}]).2");
475

476 477
      assert_equal ~msg:"Test CDuce.runtime.poly.tail failed"
	~printer:(fun x -> x)
Julien Lopez's avatar
Julien Lopez committed
478
      "Abstraction([([ `$A* ],[ `$A* ])],Id)"
479 480
	(run_test_eval "fun tail x : ['A] : ['A] -> match x : ['A] with
                     | (_ : 'A) :: (rest : ['A]) -> rest");
481

482
      assert_equal ~msg:"Test CDuce.runtime.poly.tail_applied failed"
483
	~printer:(fun x -> x) "(7,(8,(5,Atom(nil),Mono),Mono),Mono)"
484 485
	(run_test_eval "(fun tail x : ['A] : ['A] -> match x : ['A] with
                     | (_ : 'A) :: (rest : ['A]) -> rest).[3; 7; 8; 5]");
486

487
      assert_equal ~msg:"Test CDuce.runtime.poly.multicomp failed"
Julien Lopez's avatar
Julien Lopez committed
488 489
      ~printer:(fun x -> x) "Abstraction([(`$A,`$A)],Sel(1,[(`$A -> `$A)],{{`$A = Int
}}))"
Julien Lopez's avatar
Julien Lopez committed
490
	(run_test_eval "(((fun f x : 'A : 'A -> x)[{A/Int}])[{A/String}])[{A/Bool}]");
491

492
      assert_equal ~msg:"Test CDuce.runtime.poly.multicomp.2 failed"
Julien Lopez's avatar
Julien Lopez committed
493 494 495
      ~printer:(fun x -> x) "Abstraction([(`$A,`$A)],Sel(1,[(`$A -> `$A)],Comp(Comp({{`$A = `$B
}},{{`$B = `$A}}),{{`$A = `$B
}})))"
496 497
	(run_test_eval "(((fun f x : 'A : 'A -> x)[{A/'B}])[{B/'A}])[{A/'B}]");

Julien Lopez's avatar
Julien Lopez committed
498
      assert_equal ~msg:"Test CDuce.runtime.poly.multicomp.3 failed"
Julien Lopez's avatar
Julien Lopez committed
499 500 501
      ~printer:(fun x -> x) "Abstraction([(`$A,`$A)],Sel(1,[(`$A -> `$A)],Comp(Comp(Comp({{`$B = `$A
}},{{`$A = `$B}}),{{`$B = `$A}}),{{`$A = `$B
}})))"
Julien Lopez's avatar
Julien Lopez committed
502 503 504
	(run_test_eval "((((fun f x : 'A : 'A -> x)[{A/'B}])[{B/'A}])[{A/'B}])[{B/'A}]");

      assert_equal ~msg:"Test CDuce.runtime.poly.multicomp.4 failed"
Julien Lopez's avatar
Julien Lopez committed
505
      ~printer:(fun x -> x) "Abstraction([(`$A,`$A)],Sel(1,[(`$A -> `$A)],Comp({{`$B = Int}},{{`$A = 
Julien Lopez's avatar
Julien Lopez committed
506
`$B
Julien Lopez's avatar
Julien Lopez committed
507
}})))"
Julien Lopez's avatar
Julien Lopez committed
508 509
	(run_test_eval "(((((fun f x : 'A : 'A -> x)[{A/'B}])[{A/Int}])[{B/Int}])[{B/Int}])[{B/'A}]");

510
      assert_equal ~msg:"Test CDuce.runtime.poly.multicomp.5 failed"
Julien Lopez's avatar
Julien Lopez committed
511 512 513
      ~printer:(fun x -> x) "Abstraction([(`$A,`$A)],Sel(1,[(`$A -> `$A)],Comp(Comp({{`$D = `$C
},{`$C = `$B}},{{`$B = `$C}}),{{`$A = `$B},{`$C = `$D
}})))"
514 515
	(run_test_eval "((((fun f x : 'A : 'A -> x)[{A/'B},{C/'D}])[{B/'C}])[{B/'D}])[{D/'C},{C/'B}]");

516 517
    );

518 519
  ]

520 521 522 523
let _ =
  run_test_tt_main (
    test_list
      [ tests_compile;
524
        tests_eval
525 526 527
      ]
  )
;;