198 lines
7.9 KiB
OCaml
198 lines
7.9 KiB
OCaml
(* 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"
|