unikernel/duniverse/Zarith/tests/bi.ml

@@ -0,0 +1,198 @@
+(* stress test, using random and corner cases 
+   compares Big_int_Z, a Big_int compatible interface for Z, to OCaml's
+   reference Big_int library
+
+   This file is part of the Zarith library 
+   http://forge.ocamlcore.org/projects/zarith .
+   It is distributed under LGPL 2 licensing, with static linking exception.
+   See the LICENSE file included in the distribution.
+
+   Copyright (c) 2010-2011 Antoine Miné, Abstraction project.
+   Abstraction is part of the LIENS (Laboratoire d'Informatique de l'ENS),
+   a joint laboratory by:
+   CNRS (Centre national de la recherche scientifique, France),
+   ENS (École normale supérieure, Paris, France),
+   INRIA Rocquencourt (Institut national de recherche en informatique, France).
+
+*)
+
+
+module B = Big_int (* reference library *)
+
+module T = Big_int_Z  (* tested library *)
+
+
+(* randomness *)
+
+let _ = Random.init 42
+
+let random_int64 () =
+  let a,b,c = Random.bits(), Random.bits(), Random.bits () in
+  let a,b,c = Int64.of_int a, Int64.of_int b, Int64.of_int c in
+  let a,b,c = Int64.shift_left a 60, Int64.shift_left b 30, c in
+  Int64.logor a (Int64.logor b c)
+
+let random_int () = Int64.to_int (random_int64 ())
+
+let random_string () =
+  let l = 1 + Random.int 200 in
+  let s = Buffer.create l in
+  let st = if l > 1 && Random.bool () then begin
+      Buffer.add_char s '-';
+      1
+    end else 0 in
+  for i = st to l - 1 do
+   Buffer.add_char s (Char.chr (48 + Random.int 10))
+  done;
+  Buffer.contents s
+
+
+(* list utility *)
+
+let list_make n f =
+  let rec doit i acc = if i < 0 then acc else doit (i-1) ((f i)::acc) in
+  doit (n-1) []
+
+
+(* interesting numbers, as big_int *)
+
+let p = (list_make 128 (B.shift_left_big_int B.unit_big_int))
+let pn = p @ (List.map B.minus_big_int p)
+let g_list = 
+  [B.zero_big_int] @ 
+  pn @ (List.map B.succ_big_int pn) @ (List.map B.pred_big_int pn) @
+  (list_make 128 (fun _ -> B.big_int_of_int (random_int ()))) @
+  (list_make 128 (fun _ -> B.big_int_of_string (random_string())))
+
+let sh_list = list_make 256 (fun x -> x)
+let pow_list = [1;2;3;4;5;6;7;8;9;10;20;55]
+
+(* conversion to Z *)
+
+let g_t_list =
+  Printf.printf "converting %i numbers\n%!" (List.length g_list);
+  List.map
+    (fun g -> 
+      let t = T.big_int_of_string (B.string_of_big_int g) in
+      let g' = B.big_int_of_string (T.string_of_big_int t) in
+      if B.compare_big_int g g' <> 0 then failwith (Printf.sprintf "string_of_big_int failure: %s" (B.string_of_big_int g));
+      g, t
+    )
+    g_list
+
+let rec cut_list n l =
+  if n <= 0 then [] else match l with [] -> [] | h :: t -> h :: cut_list (n-1) t
+
+let small_g_t_list = cut_list 256 g_t_list
+
+(* operator tests *)
+
+let test_un msg filt gf tf =
+  Printf.printf "testing %s on %i numbers\n%!" msg (List.length g_t_list);
+  List.iter
+    (fun (g,t) ->
+      try
+        if filt g then (
+          let g' = gf g and t' = tf t in
+          if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg=%s Bresult=%s Tresult=%s" msg (B.string_of_big_int g) (B.string_of_big_int g') (T.string_of_big_int t'))
+         )
+      with Failure _ -> ()
+    ) g_t_list
+
+let test_bin_gen msg filt gf tf l =
+  Printf.printf "testing %s on %i x %i numbers\n%!" msg (List.length l) (List.length l);
+  List.iter
+    (fun (g1,t1) ->
+      List.iter
+        (fun (g2,t2) ->
+          if filt (g1,g2) then (
+            let g' = gf g1 g2 and t' = tf t1 t2 in
+            if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg1=%s arg2=%s Bresult=%s Tresult=%s" msg (B.string_of_big_int g1) (B.string_of_big_int g2) (B.string_of_big_int g') (T.string_of_big_int t'))
+           )
+        ) l
+    ) l
+
+let test_bin msg filt gf tf = test_bin_gen msg filt gf tf g_t_list
+let test_bin_small msg filt gf tf = test_bin_gen msg filt gf tf small_g_t_list
+
+let test_shift msg gf tf =
+  Printf.printf "testing %s on %i numbers\n%!" msg (List.length g_t_list);
+  List.iter
+    (fun s ->
+      List.iter
+        (fun (g,t) ->
+          let g' = gf g s and t' = tf t s in
+          if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg1=%s arg2=%i Bresult=%s Tresult=%s" msg (B.string_of_big_int g) s (B.string_of_big_int g') (T.string_of_big_int t'))
+        ) g_t_list
+    ) sh_list
+
+let test_pow msg gf tf =
+  Printf.printf "testing %s on %i numbers\n%!" msg (List.length g_t_list);
+  List.iter
+    (fun s ->
+      List.iter
+        (fun (g,t) ->
+          let g' = gf g s and t' = tf t s in
+          if B.string_of_big_int g' <> T.string_of_big_int t' then failwith (Printf.sprintf "%s failure: arg1=%s arg2=%i Bresult=%s Tresult=%s" msg (B.string_of_big_int g) s (B.string_of_big_int g') (T.string_of_big_int t'))
+        ) g_t_list
+    ) pow_list
+
+let test_comparison msg gf tf l =
+  Printf.printf "testing %s on %i x %i numbers\n%!" msg (List.length l) (List.length l);
+  List.iter
+    (fun (g1,t1) ->
+      List.iter
+        (fun (g2,t2) ->
+            let g' = gf g1 g2 and t' = tf t1 t2 in
+            if g' <> t' then failwith (Printf.sprintf "%s failure: arg1=%s arg2=%s" msg (B.string_of_big_int g1) (B.string_of_big_int g2))
+        ) l
+    ) l
+
+let filt_none _ = true
+let filt_pos x = B.sign_big_int x >= 0
+let filt_nonzero2 (_,d) = B.sign_big_int d <> 0
+let filt_pos2 (x,y) = B.sign_big_int x >= 0 && B.sign_big_int y >= 0
+let filt_nonzero22 (x,y) = B.sign_big_int x <> 0 && B.sign_big_int y <> 0
+
+let ffst f x = fst (f x)
+let fsnd f x = snd (f x)
+let ffst2 f x y = fst (f x y)
+let fsnd2 f x y = snd (f x y)
+
+let _ = test_un "int_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_int (T.int_of_big_int x))
+let _ = test_un "int32_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_int32 (T.int32_of_big_int x))
+let _ = test_un "int64_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_int64 (T.int64_of_big_int x))
+let _ = test_un "nativeint_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_nativeint (T.nativeint_of_big_int x))
+let _ = test_un "string_of_big_int" filt_none (fun x -> x) (fun x -> T.big_int_of_string (T.string_of_big_int x))
+
+let _ = test_un "minus_big_int" filt_none B.minus_big_int T.minus_big_int
+let _ = test_un "abs_big_int" filt_none B.abs_big_int T.abs_big_int
+let _ = test_un "succ_big_int"filt_none  B.succ_big_int T.succ_big_int
+let _ = test_un "pred_big_int" filt_none B.pred_big_int T.pred_big_int
+let _ = test_un "sqrt_big_int" filt_pos B.sqrt_big_int T.sqrt_big_int
+
+let _ = test_bin "add_big_int" filt_none B.add_big_int T.add_big_int
+let _ = test_bin "sub_big_int" filt_none B.sub_big_int T.sub_big_int
+let _ = test_bin "mult_big_int" filt_none B.mult_big_int T.mult_big_int
+let _ = test_bin_small "div_big_int" filt_nonzero2 B.div_big_int T.div_big_int
+let _ = test_bin_small "quomod_big_int #1" filt_nonzero2 (ffst2 B.quomod_big_int) (ffst2 T.quomod_big_int)
+let _ = test_bin_small "quomod_big_int #2" filt_nonzero2 (fsnd2 B.quomod_big_int) (fsnd2 T.quomod_big_int)
+let _ = test_bin_small "mod_big_int" filt_nonzero2 B.mod_big_int T.mod_big_int
+let _ = test_bin_small "gcd_big_int" filt_nonzero22 B.gcd_big_int T.gcd_big_int
+
+let _ = test_bin "and_big_int" filt_pos2 B.and_big_int T.and_big_int
+let _ = test_bin "or_big_int" filt_pos2 B.or_big_int T.or_big_int
+let _ = test_bin "xor_big_int" filt_pos2 B.xor_big_int T.xor_big_int
+
+let _ = test_shift "shift_left_big_int" B.shift_left_big_int T.shift_left_big_int
+let _ = test_shift "shift_right_big_int" B.shift_right_big_int T.shift_right_big_int
+let _ = test_shift "shift_right_towards_zero_big_int" B.shift_right_towards_zero_big_int T.shift_right_towards_zero_big_int
+
+let _ = test_pow "power_big_int_positive_int" B.power_big_int_positive_int T.power_big_int_positive_int
+
+let _ = test_comparison "compare" B.compare_big_int Z.compare g_t_list
+let _ = test_comparison "equal" B.eq_big_int Z.equal g_t_list
+let _ = test_comparison "lt" B.lt_big_int (fun x y -> x < y) g_t_list
+let _ = test_comparison "ge" B.ge_big_int (fun x y -> x >= y) g_t_list
+
+let _ = Printf.printf "All tests passed!\n"