Commit 7730d3f9 authored by Julien Lopez's avatar Julien Lopez

[TESTS] Progress in stdlib/list

parent 40740c72
......@@ -336,7 +336,7 @@ and token2toplevel = lexer
let s = get_stored_string () in
return_loc start (L.lexeme_end lexbuf) (STRING s)
| "'" "\\"? _ "'--'" "\\"? _ "'"
| "'" [^ "\n\'"]+ "'" not_xml_letter ->
| "'" [^ "\n'"]+ "'" not_xml_letter ->
L.rollback lexbuf;
(fun _ -> lexer
| "'" -> let start = L.lexeme_start lexbuf in
......
......@@ -134,7 +134,7 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
(run_test_eval "fun f x : Int y : String : (Int*String) -> x,y");
assert_equal ~msg:"Test CDuce.runtime.abstr.hard failed"
~printer:(fun x -> x)
"Abstraction([(Int -> Int -> Int,Int -> Int -> Int)],Mono)"
"Abstraction([((Int -> Int) -> Int,(Int -> Int) -> Int)],Mono)"
(run_test_eval "fun (((Int -> Int) -> Int) -> (Int -> Int) -> Int) | x : ((Int -> Int) -> Int) -> (fun ((Int -> Int) -> Int) | y : (Int -> Int) -> x.y)");
);
......@@ -185,7 +185,7 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
| x : (!Int) -> x).[2; 3]");
assert_equal ~msg:"Test CDuce.runtime.misc.is_int failed"
~printer:(fun x -> x)
"Abstraction([(Int,Bool),(Bool,Bool),(Any \\ (Int | Bool),Any \\ (Int | Bool))],Mono)"
"Abstraction([(Int,Bool),(Bool,Bool),(Any \\ (Bool | Int),Any \\ (Bool | Int))],Mono)"
(run_test_eval "fun ((Int -> Bool) & (Bool -> Bool) & ((!(Int|Bool)) -> (!(Int|Bool))))
| x : Int -> `true
| x : Bool -> `false
......@@ -285,7 +285,7 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
| x : (!(Int|Bool)) -> x).[`true; 3; `true]");
assert_equal ~msg:"Test CDuce.runtime.misc.firsts failed"
~printer:(fun x -> x)
"Abstraction([((Int,Int),(Int,Int) -> (Int,Int))],Mono)"
"Abstraction([((Int,Int),X1 -> X1 where X1 = (Int,Int))],Mono)"
(run_test_eval "fun firsts x : (Int*Int) y : (Int*Int) : (Int*Int) ->
match x,y : ((Int*Int)*(Int*Int)) with
| (a : Int,_ : Int),(b : Int,_ : Int) -> a,b");
......@@ -296,7 +296,7 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
| (a : Int,_ : Int),(b : Int,_ : Int) -> a,b)
.(5, 3)).(1, 4)");
assert_equal ~msg:"Test CDuce.runtime.misc.applier failed"
~printer:(fun x -> x) "Abstraction([(Int,Int -> Int -> Int)],Mono)"
~printer:(fun x -> x) "Abstraction([(Int,(Int -> Int) -> Int)],Mono)"
(run_test_eval "fun applier x : Int f : (Int->Int) : Int -> f.x");
assert_equal ~msg:"Test CDuce.runtime.misc.applier_applied failed"
~printer:(fun x -> x) "2"
......@@ -409,10 +409,10 @@ let tests_eval = "CDuce runtime tests (Typed -> Lambda -> Value)" >:::
"union" >:: ( fun test_ctxt ->
assert_equal ~msg:"Test CDuce.runtime.union.identity failed"
~printer:(fun x -> x) "Abstraction([([ Char* ] | Int,[ Char* ] | Int)],Mono)"
~printer:(fun x -> x) "Abstraction([(Int | [ Char* ],Int | [ Char* ])],Mono)"
(run_test_eval "fun f x : (Int | String) : (Int | String) -> x");
assert_equal ~msg:"Test CDuce.runtime.union.match failed"
~printer:(fun x -> x) "Abstraction([([ Char* ] | Int,[ Char* ] | Int)],Mono)"
~printer:(fun x -> x) "Abstraction([(Int | [ Char* ],Int | [ Char* ])],Mono)"
(run_test_eval "fun f x : (Int | String) : (Int | String) ->
match x : (Int | String) with
| _ : Int -> 2
......
let length (l : [('a)*]) : Int =
let aux (l : [('a)*])(res : Int) : Int = match l with
let length (l : ['a*]) : Int =
let aux (l : ['a*])(res : Int) : Int = match l with
| [] -> res
| [_; rest] -> aux rest (res + 1) in
aux l 0
let hd ([('a)+] -> 'a) [el _*] -> el
let hd (['a+] -> 'a) [el _*] -> el
let tl ([('a)+] -> [('a)*])
let tl (['a+] -> ['a*])
| [el] -> [el]
| [_; rest] -> rest
let nth (l : [('a)*])(n : Int) : 'a =
let aux (l : [('a)*])(n : Int) : 'a = match l with
let nth (l : ['a*])(n : Int) : 'a =
let aux (l : ['a*])(n : Int) : 'a = match l with
| [] -> raise "Failure \"List.nth\""
| [el; rest] -> if n >> 0 then aux rest (n - 1) else el in
if n << 0 then raise "Invalid_argument \"List.nth\"" else aux l n
let rev (l : [('a)*]) : [('a)*] =
let aux (l : [('a)*])(res : [('a)*]) : [('a)*] = match l with
let rev (l : ['a*]) : ['a*] =
let aux (l : ['a*])(res : ['a*]) : ['a*] = match l with
| [] -> res
| [el; rest] -> aux rest ([el] @ res) in
aux l []
let append (l1 : ['a*])(l2 : ['a*]) : ['a*] = l1 @ l2
let rev_append (l1 : ['a*])(l2 : ['a*]) : ['a*] = (rev l1) @ l2
let concat (l : [['a*]*]) : ['a*] =
let aux (l : [['a*]*])(res : ['a*]) : ['a*] = match l with
| [] -> res
| [el; rest] -> aux rest (res @ el) in
aux l []
let flatten = concat
(* Iterators *)
let iter (f : ('a -> []))(l : [('a)*]) : [] = match l with
let iter (f : ('a -> []))(l : ['a*]) : [] = match l with
| [] -> []
| [el; rest] -> f el; iter f rest
let iteri (f : (Int -> 'a -> []))(l : [('a)*]) : [] =
let aux (f : (Int -> 'a -> []))(l : [('a)*])(pos : Int) : [] = match l with
let iteri (f : (Int -> 'a -> []))(l : ['a*]) : [] =
let aux (f : (Int -> 'a -> []))(l : ['a*])(pos : Int) : [] = match l with
| [] -> []
| [el; rest] -> f pos el; aux f rest (pos + 1)
in
aux f l 0
(*
let mapf (f : 'a -> 'b)(l : [('a)*]) : [('b)*] =
let aux (f : 'a -> 'b)(l : [('a)*])(acc : [('b)*]) : [('b)*] = match l with
let mapf (f : 'a -> 'b)(l : ['a*]) : ['b*] =
let aux (f : 'a -> 'b)(l : ['a*])(acc : ['b*]) : ['b*] = match l with
| [] -> acc
| [el; rest] -> aux f rest (acc @ [(f el)]) in
aux f l []
*)
(* List scanning *)
......@@ -4,19 +4,20 @@ let nb_success = ref Int (0)
let nb_tests = ref Int (0)
(* Note: We are using List.iter here *)
(* let run_test_suite (l : [(Latin1, ('a), ('a)) *]) : [] =
(* TODO: Bugfix: it works here if you replace 'a with 'b *)
(* let run_test_suite (l : [(Latin1, 'a, 'a)*]) : [] =
iter (fun ((Latin1, 'a, 'a) -> []) (_, x, y) -> nb_tests := !nb_tests + 1;
if x = y then nb_success := !nb_success + 1 else []) l *)
let run_test_suite (l : [(Latin1, ('a), ('a)) *]) : [] = match l with
let run_test_suite (l : [(Latin1, 'a, 'a)*]) : [] = match l with
| [] -> []
| [(_, x, y) rest::(Latin1, ('a), ('a))*] -> nb_tests := !nb_tests + 1;
| [(_, x, y) rest::(Latin1, 'a, 'a)*] -> nb_tests := !nb_tests + 1;
(if x = y then nb_success := !nb_success + 1 else []);
run_test_suite rest
let run_test_suite_debug (l : [(Latin1, ('a), ('a)) *]) : [] = match l with
let run_test_suite_debug (l : [(Latin1, 'a, 'a)*]) : [] = match l with
| [] -> []
| [(msg, x, y) rest::(Latin1, ('a), ('a))*] -> nb_tests := !nb_tests + 1;
| [(msg, x, y) rest::(Latin1, 'a, 'a)*] -> nb_tests := !nb_tests + 1;
(if not (x = y) then print msg; print "\nExpected: "; print (string_of y);
print "\nGot:"; print (string_of x); print "\n"
else nb_success := !nb_success + 1); run_test_suite rest
......@@ -47,12 +48,30 @@ let nth_tests = [
"Invalid_argument \"List.nth\"")
] in
(*
let rev_tests = [
("Test stdlib.list.rev.1 failed", rev [], [])
("Test stdlib.list.rev.2 failed", rev [1 7 5 2], [2 5 7 1])
] in
*)
let append_tests = [
("Test stdlib.list.append.1 failed", append [] [], [])
("Test stdlib.list.append.2 failed", append [1 7 5 2] [], [1 7 5 2])
("Test stdlib.list.append.3 failed", append [] [1 7 5 2], [1 7 5 2])
("Test stdlib.list.append.4 failed", append [1 7 5 2] [2 4 3], [1 7 5 2 2 4 3])
] in
let rev_append_tests = [
("Test stdlib.list.rev_append.1 failed", rev_append [] [], [])
("Test stdlib.list.rev_append.2 failed", rev_append [1 7 5 2] [], [2 5 7 1])
("Test stdlib.list.rev_append.3 failed", rev_append [] [1 7 5 2], [1 7 5 2])
("Test stdlib.list.rev_append.4 failed", rev_append [1 7 5 2] [2 4 3], [2 5 7 1 2 4 3])
] in
let concat_tests = [
("Test stdlib.list.concat.1 failed", concat [], [])
("Test stdlib.list.concat.2 failed", concat [[]], [])
("Test stdlib.list.concat.3 failed", flatten [[] [1 7 5 2] [] [2 4 7 4] [1]], [1 7 5 2 2 4 7 4 1])
] in
(* Run tests *)
......@@ -60,5 +79,8 @@ run_test_suite length_tests;
run_test_suite hd_tests;
run_test_suite tl_tests;
run_test_suite nth_tests;
(* run_test_suite rev_tests; *)
run_test_suite rev_tests;
run_test_suite append_tests;
run_test_suite rev_append_tests;
run_test_suite concat_tests;
print (string_of !nb_success); print " / "; print (string_of !nb_tests)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment