134 lines
4.3 KiB
OCaml
134 lines
4.3 KiB
OCaml
(* Testing Z.to_float *)
|
|
|
|
open Printf
|
|
|
|
type rounding_mode =
|
|
FE_DOWNWARD | FE_TONEAREST | FE_TOWARDZERO | FE_UPWARD
|
|
|
|
external setround: rounding_mode -> bool = "caml_ztest_setround"
|
|
|
|
external format_float: string -> float -> string = "caml_format_float"
|
|
|
|
let hex_of_float f = format_float "%a" f
|
|
|
|
(* For testing, we use randomly-generated integers of the form
|
|
<signed 64-bit integer> * 2^<exponent>
|
|
We can predict their FP value by converting the integer part to FP,
|
|
then scale by the exponent using ldexp. *)
|
|
|
|
let test1 (mant: int64) (exp: int) =
|
|
let expected = ldexp (Int64.to_float mant) exp in
|
|
let actual = Z.to_float (Z.shift_left (Z.of_int64 mant) exp) in
|
|
if actual = expected then true else begin
|
|
printf "%Ld * 2^%d: expected %s, got %s\n"
|
|
mant exp (hex_of_float expected) (hex_of_float actual);
|
|
false
|
|
end
|
|
|
|
let rnd64 () =
|
|
let m1 = Random.bits() in (* 30 bits *)
|
|
let m2 = Random.bits() in (* 30 bits *)
|
|
let m3 = Random.bits() in
|
|
Int64.(logor (of_int m1)
|
|
(logor (shift_left (of_int m2) 30)
|
|
(shift_left (of_int m3) 60)))
|
|
|
|
let testN numrounds =
|
|
printf " (%d tests)... %!" numrounds;
|
|
let errors = ref 0 in
|
|
(* Some random int64 values *)
|
|
for i = 1 to numrounds do
|
|
let m = Random.int64 Int64.max_int in
|
|
if not (test1 m 0) then incr errors;
|
|
if not (test1 (Int64.neg m) 0) then incr errors
|
|
done;
|
|
(* Some random int64 values scaled by some random power of 2 *)
|
|
for i = 1 to numrounds do
|
|
let m = rnd64() in
|
|
let exp = Random.int 1100 in (* sometimes +inf will result *)
|
|
if not (test1 m exp) then incr errors
|
|
done;
|
|
(* Special test close to a rounding point *)
|
|
for i = 0 to 15 do
|
|
let m = Int64.(add 0xfffffffffffff0L (of_int i)) in
|
|
if not (test1 m 32) then incr errors;
|
|
if not (test1 (Int64.neg m) 32) then incr errors
|
|
done;
|
|
if !errors = 0
|
|
then printf "passed\n%!"
|
|
else printf "FAILED (%d errors)\n%!" !errors
|
|
|
|
let testQ1 (mant1: int64) (exp1: int) (mant2: int64) (exp2: int) =
|
|
let expected =
|
|
ldexp (Int64.to_float mant1) exp1 /. ldexp (Int64.to_float mant2) exp2 in
|
|
let actual =
|
|
Q.to_float (Q.make (Z.shift_left (Z.of_int64 mant1) exp1)
|
|
(Z.shift_left (Z.of_int64 mant2) exp2)) in
|
|
if compare actual expected = 0 then true else begin
|
|
printf "%Ld * 2^%d / %Ld * 2^%d : expected %s, got %s\n"
|
|
mant1 exp1 mant2 exp2 (hex_of_float expected) (hex_of_float actual);
|
|
false
|
|
end
|
|
|
|
let testQN numrounds =
|
|
printf " (%d tests)... %!" numrounds;
|
|
let errors = ref 0 in
|
|
(* Some special values *)
|
|
if not (testQ1 0L 0 1L 0) then incr errors;
|
|
if not (testQ1 1L 0 0L 0) then incr errors;
|
|
if not (testQ1 (-1L) 0 0L 0) then incr errors;
|
|
if not (testQ1 0L 0 0L 0) then incr errors;
|
|
(* Some random fractions *)
|
|
for i = 1 to numrounds do
|
|
let m1 = Random.int64 0x20000000000000L in
|
|
let m1 = if Random.bool() then m1 else Int64.neg m1 in
|
|
let exp1 = Random.int 500 in
|
|
let m2 = Random.int64 0x20000000000000L in
|
|
let exp2 = Random.int 500 in
|
|
if not (testQ1 m1 exp1 m2 exp2) then incr errors
|
|
done;
|
|
if !errors = 0
|
|
then printf "passed\n%!"
|
|
else printf "FAILED (%d errors)\n%!" !errors
|
|
|
|
let _ =
|
|
let numrounds =
|
|
if Array.length Sys.argv >= 2
|
|
then int_of_string Sys.argv.(1)
|
|
else 100_000 in
|
|
printf "Default rounding mode (Z)";
|
|
testN numrounds;
|
|
printf "Default rounding mode (Q)";
|
|
testQN numrounds;
|
|
if setround FE_TOWARDZERO then begin
|
|
printf "Round toward zero (Z)";
|
|
testN numrounds;
|
|
printf "Round toward zero (Q)";
|
|
testQN numrounds
|
|
end else begin
|
|
printf "Round toward zero not supported, skipping\n"
|
|
end;
|
|
if setround FE_DOWNWARD then begin
|
|
printf "Round downward (Z)";
|
|
testN numrounds;
|
|
printf "Round downward (Q)";
|
|
testQN numrounds
|
|
end else begin
|
|
printf "Round downward not supported, skipping\n"
|
|
end;
|
|
if setround FE_UPWARD then begin
|
|
printf "Round upward (Z)";
|
|
testN numrounds;
|
|
printf "Round upward (Q)";
|
|
testQN numrounds
|
|
end else begin
|
|
printf "Round upward not supported, skipping\n"
|
|
end;
|
|
if setround FE_TONEAREST then begin
|
|
printf "Round to nearest (Z)";
|
|
testN numrounds;
|
|
printf "Round to nearest (Q)";
|
|
testQN numrounds
|
|
end else begin
|
|
printf "Round to nearest not supported, skipping\n"
|
|
end
|