1307 lines
48 KiB
OCaml
1307 lines
48 KiB
OCaml
open! Import
|
|
open! Float
|
|
open! Float.Private
|
|
|
|
let%expect_test ("hash coherence" [@tags "64-bits-only"]) =
|
|
check_hash_coherence [%here] (module Float) [ min_value; 0.; 37.; max_value ];
|
|
[%expect {| |}]
|
|
;;
|
|
|
|
let%expect_test "of_string_opt" =
|
|
print_s [%sexp (of_string_opt "1." : float option)];
|
|
[%expect "(1)"];
|
|
print_s [%sexp (of_string_opt "1.a" : float option)];
|
|
[%expect "()"];
|
|
print_s [%sexp (of_string_opt "1e10000" : float option)];
|
|
[%expect "(INF)"]
|
|
;;
|
|
|
|
let exponent_bits = 11
|
|
let mantissa_bits = 52
|
|
let exponent_mask64 = Int64.(shift_left one exponent_bits - one)
|
|
let exponent_mask = Int64.to_int_exn exponent_mask64
|
|
let mantissa_mask = Int63.(shift_left one mantissa_bits - one)
|
|
let _mantissa_mask64 = Int63.to_int64 mantissa_mask
|
|
|
|
let%test_unit "upper/lower_bound_for_int" =
|
|
assert (
|
|
[%compare.equal: (int * t * t) list]
|
|
([ 8; 16; 31; 32; 52; 53; 54; 62; 63; 64 ]
|
|
|> List.map ~f:(fun x -> x, lower_bound_for_int x, upper_bound_for_int x))
|
|
[ 8, -128.99999999999997, 127.99999999999999
|
|
; 16, -32768.999999999993, 32767.999999999996
|
|
; 31, -1073741824.9999998, 1073741823.9999999
|
|
; 32, -2147483648.9999995, 2147483647.9999998
|
|
; 52, -2251799813685248.5, 2251799813685247.8
|
|
; 53, -4503599627370496., 4503599627370495.5
|
|
; 54, -9007199254740992., 9007199254740991.
|
|
; 62, -2305843009213693952., 2305843009213693696.
|
|
; 63, -4611686018427387904., 4611686018427387392.
|
|
; 64, -9223372036854775808., 9223372036854774784.
|
|
])
|
|
;;
|
|
|
|
let%test_unit _ =
|
|
(* on 64-bit platform ppx_hash hashes floats exactly the same as polymorphic hash *)
|
|
match Word_size.word_size with
|
|
| W32 -> ()
|
|
| W64 ->
|
|
List.iter
|
|
~f:(fun float ->
|
|
let hash1 = Stdlib.Hashtbl.hash float in
|
|
let hash2 = [%hash: float] float in
|
|
let hash3 = specialized_hash float in
|
|
if not Int.(hash1 = hash2 && hash1 = hash3)
|
|
then
|
|
raise_s
|
|
[%message "bad" (hash1 : Int.Hex.t) (hash2 : Int.Hex.t) (hash3 : Int.Hex.t)])
|
|
[ 0.926038888360971146; 34.1638588598232076 ]
|
|
;;
|
|
|
|
let test_both_ways (a : t) (b : int64) =
|
|
Int64.( = ) (to_int64_preserve_order_exn a) b
|
|
&& Float.( = ) (of_int64_preserve_order b) a
|
|
;;
|
|
|
|
let%test _ = test_both_ways 0. 0L
|
|
let%test _ = test_both_ways (-0.) 0L
|
|
let%test _ = test_both_ways 1. Int64.(shift_left 1023L 52)
|
|
let%test _ = test_both_ways (-2.) Int64.(neg (shift_left 1024L 52))
|
|
let%test _ = test_both_ways infinity Int64.(shift_left 2047L 52)
|
|
let%test _ = test_both_ways neg_infinity Int64.(neg (shift_left 2047L 52))
|
|
let%test _ = one_ulp `Down infinity = max_finite_value
|
|
let%test _ = is_nan (one_ulp `Up infinity)
|
|
let%test _ = is_nan (one_ulp `Down neg_infinity)
|
|
let%test _ = one_ulp `Up neg_infinity = ~-.max_finite_value
|
|
|
|
(* Some tests to make sure that the compiler is generating code for handling subnormal
|
|
numbers at runtime accurately. *)
|
|
let x () = min_positive_subnormal_value
|
|
let y () = min_positive_normal_value
|
|
let%test _ = test_both_ways (x ()) 1L
|
|
let%test _ = test_both_ways (y ()) Int64.(shift_left 1L 52)
|
|
let%test _ = x () > 0.
|
|
let%test_unit _ = [%test_result: float] (x () /. 2.) ~expect:0.
|
|
let%test _ = one_ulp `Up 0. = x ()
|
|
let%test _ = one_ulp `Down 0. = ~-.(x ())
|
|
let are_one_ulp_apart a b = one_ulp `Up a = b
|
|
let%test _ = are_one_ulp_apart (x ()) (2. *. x ())
|
|
let%test _ = are_one_ulp_apart (2. *. x ()) (3. *. x ())
|
|
let one_ulp_below_y () = y () -. x ()
|
|
let%test _ = one_ulp_below_y () < y ()
|
|
let%test _ = y () -. one_ulp_below_y () = x ()
|
|
let%test _ = are_one_ulp_apart (one_ulp_below_y ()) (y ())
|
|
let one_ulp_above_y () = y () +. x ()
|
|
let%test _ = y () < one_ulp_above_y ()
|
|
let%test _ = one_ulp_above_y () -. y () = x ()
|
|
let%test _ = are_one_ulp_apart (y ()) (one_ulp_above_y ())
|
|
let%test _ = not (are_one_ulp_apart (one_ulp_below_y ()) (one_ulp_above_y ()))
|
|
|
|
(* [2 * min_positive_normal_value] is where the ulp increases for the first time. *)
|
|
let z () = 2. *. y ()
|
|
let one_ulp_below_z () = z () -. x ()
|
|
let%test _ = one_ulp_below_z () < z ()
|
|
let%test _ = z () -. one_ulp_below_z () = x ()
|
|
let%test _ = are_one_ulp_apart (one_ulp_below_z ()) (z ())
|
|
let one_ulp_above_z () = z () +. (2. *. x ())
|
|
let%test _ = z () < one_ulp_above_z ()
|
|
let%test _ = one_ulp_above_z () -. z () = 2. *. x ()
|
|
let%test _ = are_one_ulp_apart (z ()) (one_ulp_above_z ())
|
|
|
|
let%test_module "clamp" =
|
|
(module struct
|
|
let%test _ = clamp_exn 1.0 ~min:2. ~max:3. = 2.
|
|
let%test _ = clamp_exn 2.5 ~min:2. ~max:3. = 2.5
|
|
let%test _ = clamp_exn 3.5 ~min:2. ~max:3. = 3.
|
|
|
|
let%test_unit "clamp" =
|
|
[%test_result: float Or_error.t] (clamp 3.5 ~min:2. ~max:3.) ~expect:(Ok 3.)
|
|
;;
|
|
|
|
let%test_unit "clamp nan" =
|
|
[%test_result: float Or_error.t] (clamp nan ~min:2. ~max:3.) ~expect:(Ok nan)
|
|
;;
|
|
|
|
let%test "clamp bad" = Or_error.is_error (clamp 2.5 ~min:3. ~max:2.)
|
|
let%test "clamp also bad" = Or_error.is_error (clamp 2.5 ~min:nan ~max:3.)
|
|
let%test "clamp also bad 2" = Or_error.is_error (clamp 2.5 ~min:2. ~max:nan)
|
|
let%test "clamp also bad 3" = Or_error.is_error (clamp 2.5 ~min:nan ~max:nan)
|
|
let%test "clamp also bad 4" = Or_error.is_error (clamp nan ~min:nan ~max:nan)
|
|
|
|
let%test_unit "clamp_exn bad" =
|
|
Expect_test_helpers_base.require_does_raise [%here] (fun () ->
|
|
clamp_exn 2.5 ~min:3. ~max:2.)
|
|
;;
|
|
|
|
let%test_unit "clamp_exn also bad" =
|
|
Expect_test_helpers_base.require_does_raise [%here] (fun () ->
|
|
clamp_exn 2.5 ~min:nan ~max:3.)
|
|
;;
|
|
|
|
let%test_unit "clamp_exn also bad 2" =
|
|
Expect_test_helpers_base.require_does_raise [%here] (fun () ->
|
|
clamp_exn 2.5 ~min:2. ~max:nan)
|
|
;;
|
|
|
|
let%test_unit "clamp_exn also bad 3" =
|
|
Expect_test_helpers_base.require_does_raise [%here] (fun () ->
|
|
clamp_exn 2.5 ~min:nan ~max:nan)
|
|
;;
|
|
|
|
let%test_unit "clamp_exn also bad 4" =
|
|
Expect_test_helpers_base.require_does_raise [%here] (fun () ->
|
|
clamp_exn nan ~min:nan ~max:nan)
|
|
;;
|
|
end)
|
|
;;
|
|
|
|
let%test_unit _ =
|
|
[%test_result: Int64.t]
|
|
(Int64.bits_of_float 1.1235582092889474E+307)
|
|
~expect:0x7fb0000000000000L
|
|
;;
|
|
|
|
let%test_module "IEEE" =
|
|
(module struct
|
|
(* Note: IEEE 754 defines NaN values to be those where the exponent is all 1s and the
|
|
mantissa is nonzero. test_result<t> sees nan values as equal because it is based
|
|
on [compare] rather than [=]. (If [x] and [x'] are nan, [compare x x'] returns 0,
|
|
whereas [x = x'] returns [false]. This is the case regardless of whether or not
|
|
[x] and [x'] are bit-identical values of nan.) *)
|
|
let f (t : t) (negative : bool) (exponent : int) (mantissa : Int63.t) : unit =
|
|
let str = to_string t in
|
|
let is_nan = is_nan t in
|
|
(* the sign doesn't matter when nan *)
|
|
if not is_nan
|
|
then
|
|
[%test_result: bool]
|
|
~message:("ieee_negative " ^ str)
|
|
(ieee_negative t)
|
|
~expect:negative;
|
|
[%test_result: int]
|
|
~message:("ieee_exponent " ^ str)
|
|
(ieee_exponent t)
|
|
~expect:exponent;
|
|
if is_nan
|
|
then assert (Int63.(zero <> ieee_mantissa t))
|
|
else
|
|
[%test_result: Int63.t]
|
|
~message:("ieee_mantissa " ^ str)
|
|
(ieee_mantissa t)
|
|
~expect:mantissa;
|
|
[%test_result: t]
|
|
~message:
|
|
(Printf.sprintf
|
|
!"create_ieee ~negative:%B ~exponent:%d ~mantissa:%{Int63}"
|
|
negative
|
|
exponent
|
|
mantissa)
|
|
(create_ieee_exn ~negative ~exponent ~mantissa)
|
|
~expect:t
|
|
;;
|
|
|
|
let%test_unit _ =
|
|
let ( !! ) x = Int63.of_int x in
|
|
f zero false 0 !!0;
|
|
f min_positive_subnormal_value false 0 !!1;
|
|
f min_positive_normal_value false 1 !!0;
|
|
f epsilon_float false Int.(1023 - mantissa_bits) !!0;
|
|
f one false 1023 !!0;
|
|
f minus_one true 1023 !!0;
|
|
f max_finite_value false Int.(exponent_mask - 1) mantissa_mask;
|
|
f infinity false exponent_mask !!0;
|
|
f neg_infinity true exponent_mask !!0;
|
|
f nan false exponent_mask !!1
|
|
;;
|
|
|
|
(* test the normalized case, that is, 1 <= exponent <= 2046 *)
|
|
let%test_unit _ =
|
|
let g ~negative ~exponent ~mantissa =
|
|
assert (
|
|
create_ieee_exn ~negative ~exponent ~mantissa:(Int63.of_int64_exn mantissa)
|
|
= (if negative then -1. else 1.)
|
|
* (2. **. (Float.of_int exponent - 1023.))
|
|
* (1. + ((2. **. -52.) * Int64.to_float mantissa)))
|
|
in
|
|
g ~negative:false ~exponent:1 ~mantissa:147L;
|
|
g ~negative:true ~exponent:137 ~mantissa:13L;
|
|
g ~negative:false ~exponent:1015 ~mantissa:1370001L;
|
|
g ~negative:true ~exponent:2046 ~mantissa:137000100945L
|
|
;;
|
|
end)
|
|
;;
|
|
|
|
let%test_module _ =
|
|
(module struct
|
|
let test f expect =
|
|
let actual = to_padded_compact_string f in
|
|
if String.(actual <> expect)
|
|
then raise_s [%message "failure" (f : t) (expect : string) (actual : string)]
|
|
;;
|
|
|
|
let both f expect =
|
|
assert (f > 0.);
|
|
test f expect;
|
|
test ~-.f ("-" ^ expect)
|
|
;;
|
|
|
|
let decr = one_ulp `Down
|
|
let incr = one_ulp `Up
|
|
|
|
let boundary f ~closer_to_zero ~at =
|
|
assert (f > 0.);
|
|
(* If [f] looks like an odd multiple of 0.05, it might be slightly under-represented
|
|
as a float, e.g.
|
|
|
|
1. -. 0.95 = 0.0500000000000000444
|
|
|
|
In such case, sadly, the right way for [to_padded_compact_string], just as for
|
|
[sprintf "%.1f"], is to round it down. However, the next representable number
|
|
should be rounded up:
|
|
|
|
# let x = 0.95 in sprintf "%.0f / %.1f / %.2f / %.3f / %.20f" x x x x x;;
|
|
- : string = "1 / 0.9 / 0.95 / 0.950 / 0.94999999999999995559"
|
|
|
|
# let x = incr 0.95 in sprintf "%.0f / %.1f / %.2f / %.3f / %.20f" x x x x x ;;
|
|
- : string = "1 / 1.0 / 0.95 / 0.950 / 0.95000000000000006661"
|
|
*)
|
|
let f =
|
|
if f >= 1000.
|
|
then f
|
|
else (
|
|
let x = Printf.sprintf "%.20f" f in
|
|
let spot = String.index_exn x '.' in
|
|
(* the following condition is only meant to work for small multiples of 0.05 *)
|
|
let ( + ) = Int.( + ) in
|
|
let ( = ) = Char.( = ) in
|
|
if x.[spot + 2] = '4' && x.[spot + 3] = '9' && x.[spot + 4] = '9'
|
|
then (* something like 0.94999999999999995559 *)
|
|
incr f
|
|
else f)
|
|
in
|
|
both (decr f) closer_to_zero;
|
|
both f at
|
|
;;
|
|
|
|
let%test_unit _ = test nan "nan "
|
|
let%test_unit _ = test 0.0 "0 "
|
|
let%test_unit _ = both min_positive_subnormal_value "0 "
|
|
let%test_unit _ = both infinity "inf "
|
|
let%test_unit _ = boundary 0.05 ~closer_to_zero:"0 " ~at:"0.1"
|
|
let%test_unit _ = boundary 0.15 ~closer_to_zero:"0.1" ~at:"0.2"
|
|
|
|
(* glibc printf resolves ties to even, cf.
|
|
http://www.exploringbinary.com/inconsistent-rounding-of-printed-floating-point-numbers/
|
|
Ties are resolved differently in JavaScript - mark some tests as no running with JavaScript.
|
|
*)
|
|
let%test_unit (_ [@tags "no-js"]) =
|
|
boundary (* tie *) 0.25 ~closer_to_zero:"0.2" ~at:"0.2"
|
|
;;
|
|
|
|
let%test_unit (_ [@tags "no-js"]) =
|
|
boundary (incr 0.25) ~closer_to_zero:"0.2" ~at:"0.3"
|
|
;;
|
|
|
|
let%test_unit _ = boundary 0.35 ~closer_to_zero:"0.3" ~at:"0.4"
|
|
let%test_unit _ = boundary 0.45 ~closer_to_zero:"0.4" ~at:"0.5"
|
|
let%test_unit _ = both 0.50 "0.5"
|
|
let%test_unit _ = boundary 0.55 ~closer_to_zero:"0.5" ~at:"0.6"
|
|
let%test_unit _ = boundary 0.65 ~closer_to_zero:"0.6" ~at:"0.7"
|
|
|
|
(* this time tie-to-even means round away from 0 *)
|
|
let%test_unit _ = boundary (* tie *) 0.75 ~closer_to_zero:"0.7" ~at:"0.8"
|
|
let%test_unit _ = boundary 0.85 ~closer_to_zero:"0.8" ~at:"0.9"
|
|
let%test_unit _ = boundary 0.95 ~closer_to_zero:"0.9" ~at:"1 "
|
|
let%test_unit _ = boundary 1.05 ~closer_to_zero:"1 " ~at:"1.1"
|
|
let%test_unit (_ [@tags "no-js"]) = boundary 3.25 ~closer_to_zero:"3.2" ~at:"3.2"
|
|
|
|
let%test_unit (_ [@tags "no-js"]) =
|
|
boundary (incr 3.25) ~closer_to_zero:"3.2" ~at:"3.3"
|
|
;;
|
|
|
|
let%test_unit _ = boundary 3.75 ~closer_to_zero:"3.7" ~at:"3.8"
|
|
let%test_unit _ = boundary 9.95 ~closer_to_zero:"9.9" ~at:"10 "
|
|
let%test_unit _ = boundary 10.05 ~closer_to_zero:"10 " ~at:"10.1"
|
|
let%test_unit _ = boundary 100.05 ~closer_to_zero:"100 " ~at:"100.1"
|
|
|
|
let%test_unit (_ [@tags "no-js"]) =
|
|
boundary (* tie *) 999.25 ~closer_to_zero:"999.2" ~at:"999.2"
|
|
;;
|
|
|
|
let%test_unit (_ [@tags "no-js"]) =
|
|
boundary (incr 999.25) ~closer_to_zero:"999.2" ~at:"999.3"
|
|
;;
|
|
|
|
let%test_unit _ = boundary 999.75 ~closer_to_zero:"999.7" ~at:"999.8"
|
|
let%test_unit _ = boundary 999.95 ~closer_to_zero:"999.9" ~at:"1k "
|
|
let%test_unit _ = both 1000. "1k "
|
|
|
|
(* some ties which we resolve manually in [iround_ratio_exn] *)
|
|
let%test_unit _ = boundary 1050. ~closer_to_zero:"1k " ~at:"1k "
|
|
let%test_unit _ = boundary (incr 1050.) ~closer_to_zero:"1k " ~at:"1k1"
|
|
let%test_unit _ = boundary 1950. ~closer_to_zero:"1k9" ~at:"2k "
|
|
let%test_unit _ = boundary 3250. ~closer_to_zero:"3k2" ~at:"3k2"
|
|
let%test_unit _ = boundary (incr 3250.) ~closer_to_zero:"3k2" ~at:"3k3"
|
|
let%test_unit _ = boundary 9950. ~closer_to_zero:"9k9" ~at:"10k "
|
|
let%test_unit _ = boundary 33_250. ~closer_to_zero:"33k2" ~at:"33k2"
|
|
let%test_unit _ = boundary (incr 33_250.) ~closer_to_zero:"33k2" ~at:"33k3"
|
|
let%test_unit _ = boundary 33_350. ~closer_to_zero:"33k3" ~at:"33k4"
|
|
let%test_unit _ = boundary 33_750. ~closer_to_zero:"33k7" ~at:"33k8"
|
|
let%test_unit _ = boundary 333_250. ~closer_to_zero:"333k2" ~at:"333k2"
|
|
let%test_unit _ = boundary (incr 333_250.) ~closer_to_zero:"333k2" ~at:"333k3"
|
|
let%test_unit _ = boundary 333_750. ~closer_to_zero:"333k7" ~at:"333k8"
|
|
let%test_unit _ = boundary 999_850. ~closer_to_zero:"999k8" ~at:"999k8"
|
|
let%test_unit _ = boundary (incr 999_850.) ~closer_to_zero:"999k8" ~at:"999k9"
|
|
let%test_unit _ = boundary 999_950. ~closer_to_zero:"999k9" ~at:"1m "
|
|
let%test_unit _ = boundary 1_050_000. ~closer_to_zero:"1m " ~at:"1m "
|
|
let%test_unit _ = boundary (incr 1_050_000.) ~closer_to_zero:"1m " ~at:"1m1"
|
|
let%test_unit _ = boundary 999_950_000. ~closer_to_zero:"999m9" ~at:"1g "
|
|
let%test_unit _ = boundary 999_950_000_000. ~closer_to_zero:"999g9" ~at:"1t "
|
|
let%test_unit _ = boundary 999_950_000_000_000. ~closer_to_zero:"999t9" ~at:"1p "
|
|
|
|
let%test_unit _ =
|
|
boundary 999_950_000_000_000_000. ~closer_to_zero:"999p9" ~at:"1.0e+18"
|
|
;;
|
|
|
|
(* Test the boundary between the subnormals and the normals. *)
|
|
let%test_unit _ = boundary min_positive_normal_value ~closer_to_zero:"0 " ~at:"0 "
|
|
end)
|
|
;;
|
|
|
|
let%test "int_pow" =
|
|
let tol = 1e-15 in
|
|
let test (x, n) =
|
|
let reference_value = x **. of_int n in
|
|
let relative_error = (int_pow x n -. reference_value) /. reference_value in
|
|
abs relative_error < tol
|
|
in
|
|
List.for_all
|
|
~f:test
|
|
[ 1.5, 17
|
|
; 1.5, 42
|
|
; 0.99, 64
|
|
; 2., -5
|
|
; 2., -1
|
|
; -1.3, 2
|
|
; -1.3, -1
|
|
; -1.3, -2
|
|
; 5., 0
|
|
; nan, 0
|
|
; 0., 0
|
|
; infinity, 0
|
|
]
|
|
;;
|
|
|
|
let%test "int_pow misc" =
|
|
int_pow 0. (-1) = infinity
|
|
&& int_pow (-0.) (-1) = neg_infinity
|
|
&& int_pow (-0.) (-2) = infinity
|
|
&& int_pow 1.5 5000 = infinity
|
|
&& int_pow 1.5 (-5000) = 0.
|
|
&& int_pow (-1.) Int.max_value = -1.
|
|
&& int_pow (-1.) Int.min_value = 1.
|
|
;;
|
|
|
|
(* some ugly corner cases with extremely large exponents and some serious precision loss *)
|
|
let%test ("int_pow bad cases" [@tags "64-bits-only"]) =
|
|
let a = one_ulp `Down 1. in
|
|
let b = one_ulp `Up 1. in
|
|
let large = 1 lsl 61 in
|
|
let small = Int.neg large in
|
|
(* this huge discrepancy comes from the fact that [1 / a = b] but this is a very poor
|
|
approximation, and in particular [1 / b = one_ulp `Down a = a * a]. *)
|
|
a **. of_int small = 1.5114276650041252e+111
|
|
&& int_pow a small = 2.2844048619719663e+222
|
|
&& int_pow b large = 2.2844048619719663e+222
|
|
&& b **. of_int large = 2.2844135865396268e+222
|
|
;;
|
|
|
|
let%test_unit "sign_exn" =
|
|
List.iter
|
|
~f:(fun (input, expect) -> assert (Sign.equal (sign_exn input) expect))
|
|
[ 1e-30, Sign.Pos; -0., Zero; 0., Zero; neg_infinity, Neg ]
|
|
;;
|
|
|
|
let%test _ =
|
|
match sign_exn nan with
|
|
| Neg | Zero | Pos -> false
|
|
| exception _ -> true
|
|
;;
|
|
|
|
let%test_unit "sign_or_nan" =
|
|
List.iter
|
|
~f:(fun (input, expect) -> assert (Sign_or_nan.equal (sign_or_nan input) expect))
|
|
[ 1e-30, Sign_or_nan.Pos; -0., Zero; 0., Zero; neg_infinity, Neg; nan, Nan ]
|
|
;;
|
|
|
|
let%test_module _ =
|
|
(module struct
|
|
(* Some of the following tests used to live in lib_test/core_float_test.ml. *)
|
|
|
|
let () = Random.init 137
|
|
|
|
(* round:
|
|
... <-)[-><-)[-><-)[-><-)[-><-)[-><-)[-> ...
|
|
... -+-----+-----+-----+-----+-----+-----+- ...
|
|
... -3 -2 -1 0 1 2 3 ...
|
|
so round x -. x should be in (-0.5,0.5]
|
|
*)
|
|
let round_test x =
|
|
let y = round x in
|
|
-0.5 < y -. x && y -. x <= 0.5
|
|
;;
|
|
|
|
let iround_up_vs_down_test x =
|
|
let expected_difference = if Parts.fractional (modf x) = 0. then 0 else 1 in
|
|
match iround_up x, iround_down x with
|
|
| Some x, Some y -> Int.(x - y = expected_difference)
|
|
| _, _ -> true
|
|
;;
|
|
|
|
let test_all_six
|
|
x
|
|
~specialized_iround
|
|
~specialized_iround_exn
|
|
~float_rounding
|
|
~dir
|
|
~validate
|
|
=
|
|
let result1 = iround x ~dir in
|
|
let result2 = Option.try_with (fun () -> iround_exn x ~dir) in
|
|
let result3 = specialized_iround x in
|
|
let result4 = Option.try_with (fun () -> specialized_iround_exn x) in
|
|
let result5 = Option.try_with (fun () -> Int.of_float (float_rounding x)) in
|
|
let result6 = Option.try_with (fun () -> Int.of_float (round ~dir x)) in
|
|
let ( = ) = Stdlib.( = ) in
|
|
if result1 = result2
|
|
&& result2 = result3
|
|
&& result3 = result4
|
|
&& result4 = result5
|
|
&& result5 = result6
|
|
then validate result1
|
|
else false
|
|
;;
|
|
|
|
(* iround ~dir:`Nearest built so this should always be true *)
|
|
let iround_nearest_test x =
|
|
test_all_six
|
|
x
|
|
~specialized_iround:iround_nearest
|
|
~specialized_iround_exn:iround_nearest_exn
|
|
~float_rounding:round_nearest
|
|
~dir:`Nearest
|
|
~validate:(function
|
|
| None -> true
|
|
| Some y ->
|
|
let y = of_int y in
|
|
-0.5 < y -. x && y -. x <= 0.5)
|
|
;;
|
|
|
|
(* iround_down:
|
|
... )[<---)[<---)[<---)[<---)[<---)[<---)[ ...
|
|
... -+-----+-----+-----+-----+-----+-----+- ...
|
|
... -3 -2 -1 0 1 2 3 ...
|
|
so x -. iround_down x should be in [0,1)
|
|
*)
|
|
let iround_down_test x =
|
|
test_all_six
|
|
x
|
|
~specialized_iround:iround_down
|
|
~specialized_iround_exn:iround_down_exn
|
|
~float_rounding:round_down
|
|
~dir:`Down
|
|
~validate:(function
|
|
| None -> true
|
|
| Some y ->
|
|
let y = of_int y in
|
|
0. <= x -. y && x -. y < 1.)
|
|
;;
|
|
|
|
(* iround_up:
|
|
... ](--->](--->](--->](--->](--->](--->]( ...
|
|
... -+-----+-----+-----+-----+-----+-----+- ...
|
|
... -3 -2 -1 0 1 2 3 ...
|
|
so iround_up x -. x should be in [0,1)
|
|
*)
|
|
let iround_up_test x =
|
|
test_all_six
|
|
x
|
|
~specialized_iround:iround_up
|
|
~specialized_iround_exn:iround_up_exn
|
|
~float_rounding:round_up
|
|
~dir:`Up
|
|
~validate:(function
|
|
| None -> true
|
|
| Some y ->
|
|
let y = of_int y in
|
|
0. <= y -. x && y -. x < 1.)
|
|
;;
|
|
|
|
(* iround_towards_zero:
|
|
... ](--->](--->](---><--->)[<---)[<---)[ ...
|
|
... -+-----+-----+-----+-----+-----+-----+- ...
|
|
... -3 -2 -1 0 1 2 3 ...
|
|
so abs x -. abs (iround_towards_zero x) should be in [0,1)
|
|
*)
|
|
let iround_towards_zero_test x =
|
|
test_all_six
|
|
x
|
|
~specialized_iround:iround_towards_zero
|
|
~specialized_iround_exn:iround_towards_zero_exn
|
|
~float_rounding:round_towards_zero
|
|
~dir:`Zero
|
|
~validate:(function
|
|
| None -> true
|
|
| Some y ->
|
|
let x = abs x in
|
|
let y = abs (of_int y) in
|
|
0. <= x -. y && x -. y < 1. && (Sign.(sign_exn x = sign_exn y) || y = 0.0))
|
|
;;
|
|
|
|
(* Easy cases that used to live inline with the code above. *)
|
|
let%test_unit _ = [%test_result: int option] (iround_up (-3.4)) ~expect:(Some (-3))
|
|
let%test_unit _ = [%test_result: int option] (iround_up 0.0) ~expect:(Some 0)
|
|
let%test_unit _ = [%test_result: int option] (iround_up 3.4) ~expect:(Some 4)
|
|
let%test_unit _ = [%test_result: int] (iround_up_exn (-3.4)) ~expect:(-3)
|
|
let%test_unit _ = [%test_result: int] (iround_up_exn 0.0) ~expect:0
|
|
let%test_unit _ = [%test_result: int] (iround_up_exn 3.4) ~expect:4
|
|
let%test_unit _ = [%test_result: int option] (iround_down (-3.4)) ~expect:(Some (-4))
|
|
let%test_unit _ = [%test_result: int option] (iround_down 0.0) ~expect:(Some 0)
|
|
let%test_unit _ = [%test_result: int option] (iround_down 3.4) ~expect:(Some 3)
|
|
let%test_unit _ = [%test_result: int] (iround_down_exn (-3.4)) ~expect:(-4)
|
|
let%test_unit _ = [%test_result: int] (iround_down_exn 0.0) ~expect:0
|
|
let%test_unit _ = [%test_result: int] (iround_down_exn 3.4) ~expect:3
|
|
|
|
let%test_unit _ =
|
|
[%test_result: int option] (iround_towards_zero (-3.4)) ~expect:(Some (-3))
|
|
;;
|
|
|
|
let%test_unit _ =
|
|
[%test_result: int option] (iround_towards_zero 0.0) ~expect:(Some 0)
|
|
;;
|
|
|
|
let%test_unit _ =
|
|
[%test_result: int option] (iround_towards_zero 3.4) ~expect:(Some 3)
|
|
;;
|
|
|
|
let%test_unit _ = [%test_result: int] (iround_towards_zero_exn (-3.4)) ~expect:(-3)
|
|
let%test_unit _ = [%test_result: int] (iround_towards_zero_exn 0.0) ~expect:0
|
|
let%test_unit _ = [%test_result: int] (iround_towards_zero_exn 3.4) ~expect:3
|
|
|
|
let%test_unit _ =
|
|
[%test_result: int option] (iround_nearest (-3.6)) ~expect:(Some (-4))
|
|
;;
|
|
|
|
let%test_unit _ =
|
|
[%test_result: int option] (iround_nearest (-3.5)) ~expect:(Some (-3))
|
|
;;
|
|
|
|
let%test_unit _ =
|
|
[%test_result: int option] (iround_nearest (-3.4)) ~expect:(Some (-3))
|
|
;;
|
|
|
|
let%test_unit _ = [%test_result: int option] (iround_nearest 0.0) ~expect:(Some 0)
|
|
let%test_unit _ = [%test_result: int option] (iround_nearest 3.4) ~expect:(Some 3)
|
|
let%test_unit _ = [%test_result: int option] (iround_nearest 3.5) ~expect:(Some 4)
|
|
let%test_unit _ = [%test_result: int option] (iround_nearest 3.6) ~expect:(Some 4)
|
|
let%test_unit _ = [%test_result: int] (iround_nearest_exn (-3.6)) ~expect:(-4)
|
|
let%test_unit _ = [%test_result: int] (iround_nearest_exn (-3.5)) ~expect:(-3)
|
|
let%test_unit _ = [%test_result: int] (iround_nearest_exn (-3.4)) ~expect:(-3)
|
|
let%test_unit _ = [%test_result: int] (iround_nearest_exn 0.0) ~expect:0
|
|
let%test_unit _ = [%test_result: int] (iround_nearest_exn 3.4) ~expect:3
|
|
let%test_unit _ = [%test_result: int] (iround_nearest_exn 3.5) ~expect:4
|
|
let%test_unit _ = [%test_result: int] (iround_nearest_exn 3.6) ~expect:4
|
|
|
|
let special_values_test () =
|
|
[%test_result: float] (round (-1.50001)) ~expect:(-2.);
|
|
[%test_result: float] (round (-1.5)) ~expect:(-1.);
|
|
[%test_result: float] (round (-0.50001)) ~expect:(-1.);
|
|
[%test_result: float] (round (-0.5)) ~expect:0.;
|
|
[%test_result: float] (round 0.49999) ~expect:0.;
|
|
[%test_result: float] (round 0.5) ~expect:1.;
|
|
[%test_result: float] (round 1.49999) ~expect:1.;
|
|
[%test_result: float] (round 1.5) ~expect:2.;
|
|
[%test_result: int] (iround_exn ~dir:`Up (-2.)) ~expect:(-2);
|
|
[%test_result: int] (iround_exn ~dir:`Up (-1.9999)) ~expect:(-1);
|
|
[%test_result: int] (iround_exn ~dir:`Up (-1.)) ~expect:(-1);
|
|
[%test_result: int] (iround_exn ~dir:`Up (-0.9999)) ~expect:0;
|
|
[%test_result: int] (iround_exn ~dir:`Up 0.) ~expect:0;
|
|
[%test_result: int] (iround_exn ~dir:`Up 0.00001) ~expect:1;
|
|
[%test_result: int] (iround_exn ~dir:`Up 1.) ~expect:1;
|
|
[%test_result: int] (iround_exn ~dir:`Up 1.00001) ~expect:2;
|
|
[%test_result: int] (iround_up_exn (-2.)) ~expect:(-2);
|
|
[%test_result: int] (iround_up_exn (-1.9999)) ~expect:(-1);
|
|
[%test_result: int] (iround_up_exn (-1.)) ~expect:(-1);
|
|
[%test_result: int] (iround_up_exn (-0.9999)) ~expect:0;
|
|
[%test_result: int] (iround_up_exn 0.) ~expect:0;
|
|
[%test_result: int] (iround_up_exn 0.00001) ~expect:1;
|
|
[%test_result: int] (iround_up_exn 1.) ~expect:1;
|
|
[%test_result: int] (iround_up_exn 1.00001) ~expect:2;
|
|
[%test_result: int] (iround_exn ~dir:`Down (-1.00001)) ~expect:(-2);
|
|
[%test_result: int] (iround_exn ~dir:`Down (-1.)) ~expect:(-1);
|
|
[%test_result: int] (iround_exn ~dir:`Down (-0.00001)) ~expect:(-1);
|
|
[%test_result: int] (iround_exn ~dir:`Down 0.) ~expect:0;
|
|
[%test_result: int] (iround_exn ~dir:`Down 0.99999) ~expect:0;
|
|
[%test_result: int] (iround_exn ~dir:`Down 1.) ~expect:1;
|
|
[%test_result: int] (iround_exn ~dir:`Down 1.99999) ~expect:1;
|
|
[%test_result: int] (iround_exn ~dir:`Down 2.) ~expect:2;
|
|
[%test_result: int] (iround_down_exn (-1.00001)) ~expect:(-2);
|
|
[%test_result: int] (iround_down_exn (-1.)) ~expect:(-1);
|
|
[%test_result: int] (iround_down_exn (-0.00001)) ~expect:(-1);
|
|
[%test_result: int] (iround_down_exn 0.) ~expect:0;
|
|
[%test_result: int] (iround_down_exn 0.99999) ~expect:0;
|
|
[%test_result: int] (iround_down_exn 1.) ~expect:1;
|
|
[%test_result: int] (iround_down_exn 1.99999) ~expect:1;
|
|
[%test_result: int] (iround_down_exn 2.) ~expect:2;
|
|
[%test_result: int] (iround_exn ~dir:`Zero (-2.)) ~expect:(-2);
|
|
[%test_result: int] (iround_exn ~dir:`Zero (-1.99999)) ~expect:(-1);
|
|
[%test_result: int] (iround_exn ~dir:`Zero (-1.)) ~expect:(-1);
|
|
[%test_result: int] (iround_exn ~dir:`Zero (-0.99999)) ~expect:0;
|
|
[%test_result: int] (iround_exn ~dir:`Zero 0.99999) ~expect:0;
|
|
[%test_result: int] (iround_exn ~dir:`Zero 1.) ~expect:1;
|
|
[%test_result: int] (iround_exn ~dir:`Zero 1.99999) ~expect:1;
|
|
[%test_result: int] (iround_exn ~dir:`Zero 2.) ~expect:2
|
|
;;
|
|
|
|
let is_64_bit_platform = of_int Int.max_value >= 2. **. 60.
|
|
|
|
(* Tests for values close to [iround_lbound] and [iround_ubound]. *)
|
|
let extremities_test ~round =
|
|
let ( + ) = Int.( + ) in
|
|
let ( - ) = Int.( - ) in
|
|
if is_64_bit_platform
|
|
then (
|
|
(* 64 bits *)
|
|
[%test_result: int option]
|
|
(round ((2.0 **. 62.) -. 512.))
|
|
~expect:(Some (Int.max_value - 511));
|
|
[%test_result: int option]
|
|
(round ((2.0 **. 62.) -. 1024.))
|
|
~expect:(Some (Int.max_value - 1023));
|
|
[%test_result: int option] (round (-.(2.0 **. 62.))) ~expect:(Some Int.min_value);
|
|
[%test_result: int option]
|
|
(round (-.((2.0 **. 62.) -. 512.)))
|
|
~expect:(Some (Int.min_value + 512));
|
|
[%test_result: int option] (round (2.0 **. 62.)) ~expect:None;
|
|
[%test_result: int option] (round (-.((2.0 **. 62.) +. 1024.))) ~expect:None)
|
|
else (
|
|
let int_size_minus_one = of_int (Int.num_bits - 1) in
|
|
(* 32 bits *)
|
|
[%test_result: int option]
|
|
(round ((2.0 **. int_size_minus_one) -. 1.))
|
|
~expect:(Some Int.max_value);
|
|
[%test_result: int option]
|
|
(round ((2.0 **. int_size_minus_one) -. 2.))
|
|
~expect:(Some (Int.max_value - 1));
|
|
[%test_result: int option]
|
|
(round (-.(2.0 **. int_size_minus_one)))
|
|
~expect:(Some Int.min_value);
|
|
[%test_result: int option]
|
|
(round (-.((2.0 **. int_size_minus_one) -. 1.)))
|
|
~expect:(Some (Int.min_value + 1));
|
|
[%test_result: int option] (round (2.0 **. int_size_minus_one)) ~expect:None;
|
|
[%test_result: int option]
|
|
(round (-.((2.0 **. int_size_minus_one) +. 1.)))
|
|
~expect:None)
|
|
;;
|
|
|
|
let%test_unit _ = extremities_test ~round:iround_down
|
|
let%test_unit _ = extremities_test ~round:iround_up
|
|
let%test_unit _ = extremities_test ~round:iround_nearest
|
|
let%test_unit _ = extremities_test ~round:iround_towards_zero
|
|
|
|
(* test values beyond the integers range *)
|
|
let large_value_test x =
|
|
[%test_result: int option] (iround_down x) ~expect:None;
|
|
[%test_result: int option] (iround ~dir:`Down x) ~expect:None;
|
|
[%test_result: int option] (iround_up x) ~expect:None;
|
|
[%test_result: int option] (iround ~dir:`Up x) ~expect:None;
|
|
[%test_result: int option] (iround_towards_zero x) ~expect:None;
|
|
[%test_result: int option] (iround ~dir:`Zero x) ~expect:None;
|
|
[%test_result: int option] (iround_nearest x) ~expect:None;
|
|
[%test_result: int option] (iround ~dir:`Nearest x) ~expect:None;
|
|
assert (Exn.does_raise (fun () -> iround_down_exn x));
|
|
assert (Exn.does_raise (fun () -> iround_exn ~dir:`Down x));
|
|
assert (Exn.does_raise (fun () -> iround_up_exn x));
|
|
assert (Exn.does_raise (fun () -> iround_exn ~dir:`Up x));
|
|
assert (Exn.does_raise (fun () -> iround_towards_zero_exn x));
|
|
assert (Exn.does_raise (fun () -> iround_exn ~dir:`Zero x));
|
|
assert (Exn.does_raise (fun () -> iround_nearest_exn x));
|
|
assert (Exn.does_raise (fun () -> iround_exn ~dir:`Nearest x));
|
|
[%test_result: float] (round_down x) ~expect:x;
|
|
[%test_result: float] (round ~dir:`Down x) ~expect:x;
|
|
[%test_result: float] (round_up x) ~expect:x;
|
|
[%test_result: float] (round ~dir:`Up x) ~expect:x;
|
|
[%test_result: float] (round_towards_zero x) ~expect:x;
|
|
[%test_result: float] (round ~dir:`Zero x) ~expect:x;
|
|
[%test_result: float] (round_nearest x) ~expect:x;
|
|
[%test_result: float] (round ~dir:`Nearest x) ~expect:x
|
|
;;
|
|
|
|
let large_numbers =
|
|
let ( + ) = Int.( + ) in
|
|
let ( - ) = Int.( - ) in
|
|
List.concat
|
|
(List.init (1024 - 64) ~f:(fun x ->
|
|
let x = of_int (x + 64) in
|
|
let y =
|
|
[ 2. **. x
|
|
; (2. **. x) -. (2. **. (x -. 53.))
|
|
; (* one ulp down *)
|
|
(2. **. x) +. (2. **. (x -. 52.))
|
|
]
|
|
(* one ulp up *)
|
|
in
|
|
y @ List.map y ~f:neg))
|
|
@ [ infinity; neg_infinity ]
|
|
;;
|
|
|
|
let%test_unit _ = List.iter large_numbers ~f:large_value_test
|
|
|
|
let numbers_near_powers_of_two =
|
|
List.concat
|
|
(List.init 64 ~f:(fun i ->
|
|
let pow2 = 2. **. of_int i in
|
|
let x =
|
|
[ pow2
|
|
; one_ulp `Down (pow2 +. 0.5)
|
|
; pow2 +. 0.5
|
|
; one_ulp `Down (pow2 +. 1.0)
|
|
; pow2 +. 1.0
|
|
; one_ulp `Down (pow2 +. 1.5)
|
|
; pow2 +. 1.5
|
|
; one_ulp `Down (pow2 +. 2.0)
|
|
; pow2 +. 2.0
|
|
; one_ulp `Down ((pow2 *. 2.0) -. 1.0)
|
|
; one_ulp `Down pow2
|
|
; one_ulp `Up pow2
|
|
]
|
|
in
|
|
x @ List.map x ~f:neg))
|
|
;;
|
|
|
|
let%test _ = List.for_all numbers_near_powers_of_two ~f:iround_up_vs_down_test
|
|
let%test _ = List.for_all numbers_near_powers_of_two ~f:iround_nearest_test
|
|
let%test _ = List.for_all numbers_near_powers_of_two ~f:iround_down_test
|
|
let%test _ = List.for_all numbers_near_powers_of_two ~f:iround_up_test
|
|
let%test _ = List.for_all numbers_near_powers_of_two ~f:iround_towards_zero_test
|
|
let%test _ = List.for_all numbers_near_powers_of_two ~f:round_test
|
|
|
|
(* code for generating random floats on which to test functions *)
|
|
let rec absirand () =
|
|
let open Int.O in
|
|
let rec aux acc cnt =
|
|
if cnt = 0
|
|
then acc
|
|
else (
|
|
let bit = if Random.bool () then 1 else 0 in
|
|
aux ((2 * acc) + bit) (cnt - 1))
|
|
in
|
|
let result = aux 0 (if is_64_bit_platform then 62 else 30) in
|
|
if result >= Int.max_value - 255
|
|
then
|
|
(* On a 64-bit box, [float x > Int.max_value] when [x >= Int.max_value - 255], so
|
|
[iround (float x)] would be out of bounds. So we try again. This branch of code
|
|
runs with probability 6e-17 :-) As such, we have some fixed tests in
|
|
[extremities_test] above, to ensure that we do always check some examples in
|
|
that range. *)
|
|
absirand ()
|
|
else result
|
|
;;
|
|
|
|
(* -Int.max_value <= frand () <= Int.max_value *)
|
|
let frand () =
|
|
let x = of_int (absirand ()) +. Random.float 1.0 in
|
|
if Random.bool () then -1.0 *. x else x
|
|
;;
|
|
|
|
let randoms = List.init ~f:(fun _ -> frand ()) 10_000
|
|
let%test _ = List.for_all randoms ~f:iround_up_vs_down_test
|
|
let%test _ = List.for_all randoms ~f:iround_nearest_test
|
|
let%test _ = List.for_all randoms ~f:iround_down_test
|
|
let%test _ = List.for_all randoms ~f:iround_up_test
|
|
let%test _ = List.for_all randoms ~f:iround_towards_zero_test
|
|
let%test _ = List.for_all randoms ~f:round_test
|
|
let%test_unit _ = special_values_test ()
|
|
let%test _ = iround_nearest_test (of_int Int.max_value)
|
|
let%test _ = iround_nearest_test (of_int Int.min_value)
|
|
end)
|
|
;;
|
|
|
|
module Test_bounds (I : sig
|
|
type t
|
|
|
|
val num_bits : int
|
|
val of_float : float -> t
|
|
val to_int64 : t -> Int64.t
|
|
val max_value : t
|
|
val min_value : t
|
|
end) =
|
|
struct
|
|
open I
|
|
|
|
let float_lower_bound = lower_bound_for_int num_bits
|
|
let float_upper_bound = upper_bound_for_int num_bits
|
|
let%test_unit "lower bound is valid" = ignore (of_float float_lower_bound : t)
|
|
let%test_unit "upper bound is valid" = ignore (of_float float_upper_bound : t)
|
|
|
|
let%test "smaller than lower bound is not valid" =
|
|
Exn.does_raise (fun () -> of_float (one_ulp `Down float_lower_bound))
|
|
;;
|
|
|
|
let%test "bigger than upper bound is not valid" =
|
|
Exn.does_raise (fun () -> of_float (one_ulp `Up float_upper_bound))
|
|
;;
|
|
|
|
(* We use [Caml.Int64.of_float] in the next two tests because [Int64.of_float] rejects
|
|
out-of-range inputs, whereas [Caml.Int.of_float] simply overflows (returns
|
|
[Int64.min_int]). *)
|
|
|
|
let%test "smaller than lower bound overflows" =
|
|
let lower_bound = Int64.of_float float_lower_bound in
|
|
let lower_bound_minus_epsilon =
|
|
Stdlib.Int64.of_float (one_ulp `Down float_lower_bound)
|
|
in
|
|
let min_value = to_int64 min_value in
|
|
if Int.( = ) num_bits 64
|
|
(* We cannot detect overflow because on Intel overflow results in min_value. *)
|
|
then true
|
|
else (
|
|
assert (Int64.( <= ) lower_bound_minus_epsilon lower_bound);
|
|
(* a value smaller than min_value would overflow if converted to [t] *)
|
|
Int64.( < ) lower_bound_minus_epsilon min_value)
|
|
;;
|
|
|
|
let%test "bigger than upper bound overflows" =
|
|
let upper_bound = Int64.of_float float_upper_bound in
|
|
let upper_bound_plus_epsilon =
|
|
Stdlib.Int64.of_float (one_ulp `Up float_upper_bound)
|
|
in
|
|
let max_value = to_int64 max_value in
|
|
if Int.( = ) num_bits 64
|
|
(* upper_bound_plus_epsilon is not representable as a Int64.t, it has overflowed *)
|
|
then Int64.( < ) upper_bound_plus_epsilon upper_bound
|
|
else (
|
|
assert (Int64.( >= ) upper_bound_plus_epsilon upper_bound);
|
|
(* a value greater than max_value would overflow if converted to [t] *)
|
|
Int64.( > ) upper_bound_plus_epsilon max_value)
|
|
;;
|
|
end
|
|
|
|
let%test_module "Int" = (module Test_bounds (Int))
|
|
let%test_module "Int32" = (module Test_bounds (Int32))
|
|
let%test_module "Int63" = (module Test_bounds (Int63))
|
|
let%test_module "Int63_emul" = (module Test_bounds (Base.Int63.Private.Emul))
|
|
let%test_module "Int64" = (module Test_bounds (Int64))
|
|
let%test_module "Nativeint" = (module Test_bounds (Nativeint))
|
|
let%test_unit _ = [%test_result: string] (to_string 3.14) ~expect:"3.14"
|
|
let%test_unit _ = [%test_result: string] (to_string 3.1400000000000001) ~expect:"3.14"
|
|
|
|
let%test_unit _ =
|
|
[%test_result: string] (to_string 3.1400000000000004) ~expect:"3.1400000000000006"
|
|
;;
|
|
|
|
let%test_unit _ =
|
|
[%test_result: string] (to_string 8.000000000000002) ~expect:"8.0000000000000018"
|
|
;;
|
|
|
|
let%test_unit _ = [%test_result: string] (to_string 9.992) ~expect:"9.992"
|
|
|
|
let%test_unit _ =
|
|
[%test_result: string]
|
|
(to_string ((2. **. 63.) *. (1. +. (2. **. -52.))))
|
|
~expect:"9.2233720368547779e+18"
|
|
;;
|
|
|
|
let%test_unit _ = [%test_result: string] (to_string (-3.)) ~expect:"-3."
|
|
let%test_unit _ = [%test_result: string] (to_string nan) ~expect:"nan"
|
|
let%test_unit _ = [%test_result: string] (to_string infinity) ~expect:"inf"
|
|
let%test_unit _ = [%test_result: string] (to_string neg_infinity) ~expect:"-inf"
|
|
let%test_unit _ = [%test_result: string] (to_string 3e100) ~expect:"3e+100"
|
|
|
|
let%test_unit _ =
|
|
[%test_result: string] (to_string max_finite_value) ~expect:"1.7976931348623157e+308"
|
|
;;
|
|
|
|
let%test_unit _ =
|
|
[%test_result: string]
|
|
(to_string min_positive_subnormal_value)
|
|
~expect:"4.94065645841247e-324"
|
|
;;
|
|
|
|
let%test _ = epsilon_float = one_ulp `Up 1. -. 1.
|
|
let%test _ = one_ulp_less_than_half = 0.49999999999999994
|
|
let%test _ = round_down 3.6 = 3. && round_down (-3.6) = -4.
|
|
let%test _ = round_up 3.6 = 4. && round_up (-3.6) = -3.
|
|
let%test _ = round_towards_zero 3.6 = 3. && round_towards_zero (-3.6) = -3.
|
|
let%test _ = round_nearest_half_to_even 0. = 0.
|
|
let%test _ = round_nearest_half_to_even 0.5 = 0.
|
|
let%test _ = round_nearest_half_to_even (-0.5) = 0.
|
|
let%test _ = round_nearest_half_to_even (one_ulp `Up 0.5) = 1.
|
|
let%test _ = round_nearest_half_to_even (one_ulp `Down 0.5) = 0.
|
|
let%test _ = round_nearest_half_to_even (one_ulp `Up (-0.5)) = 0.
|
|
let%test _ = round_nearest_half_to_even (one_ulp `Down (-0.5)) = -1.
|
|
let%test _ = round_nearest_half_to_even 3.5 = 4.
|
|
let%test _ = round_nearest_half_to_even 4.5 = 4.
|
|
let%test _ = round_nearest_half_to_even (one_ulp `Up (-5.5)) = -5.
|
|
let%test _ = round_nearest_half_to_even 5.5 = 6.
|
|
let%test _ = round_nearest_half_to_even 6.5 = 6.
|
|
let%test _ = round_nearest_half_to_even (one_ulp `Up (-.(2. **. 52.))) = -.(2. **. 52.)
|
|
let%test _ = round_nearest (one_ulp `Up (-.(2. **. 52.))) = 1. -. (2. **. 52.)
|
|
let%test _ = is_integer 1.
|
|
let%test _ = is_integer 0.
|
|
let%test _ = is_integer (-0.)
|
|
let%test _ = is_integer (-1.)
|
|
let%test _ = is_integer 8.98e307
|
|
let%test _ = is_integer ((2. ** 53.) -. 0.5)
|
|
let%test _ = not (is_integer ((2. ** 52.) -. 0.5))
|
|
let%test _ = not (is_integer 0.0000000000000001)
|
|
let%test _ = not (is_integer (-0.0000000000000001))
|
|
let%test _ = not (is_integer 0.9999999999999999)
|
|
let%test _ = not (is_integer nan)
|
|
let%test _ = not (is_integer infinity)
|
|
let%test _ = not (is_integer neg_infinity)
|
|
|
|
let%test_module _ =
|
|
(module struct
|
|
(* check we raise on invalid input *)
|
|
let must_fail f x = Exn.does_raise (fun () -> f x)
|
|
|
|
let must_succeed f x =
|
|
ignore (f x : _);
|
|
true
|
|
;;
|
|
|
|
let%test _ = must_fail int63_round_nearest_portable_alloc_exn nan
|
|
let%test _ = must_fail int63_round_nearest_portable_alloc_exn max_value
|
|
let%test _ = must_fail int63_round_nearest_portable_alloc_exn min_value
|
|
let%test _ = must_fail int63_round_nearest_portable_alloc_exn (2. **. 63.)
|
|
let%test _ = must_fail int63_round_nearest_portable_alloc_exn ~-.(2. **. 63.)
|
|
let%test _ = must_succeed int63_round_nearest_portable_alloc_exn ((2. **. 62.) -. 512.)
|
|
let%test _ = must_fail int63_round_nearest_portable_alloc_exn (2. **. 62.)
|
|
|
|
let%test _ =
|
|
must_fail int63_round_nearest_portable_alloc_exn (~-.(2. **. 62.) -. 1024.)
|
|
;;
|
|
|
|
let%test _ = must_succeed int63_round_nearest_portable_alloc_exn ~-.(2. **. 62.)
|
|
end)
|
|
;;
|
|
|
|
let%test _ = round_nearest 3.6 = 4. && round_nearest (-3.6) = -4.
|
|
|
|
(* The redefinition of [sexp_of_t] in float.ml assumes sexp conversion uses E rather than
|
|
e. *)
|
|
let%test_unit "e vs E" =
|
|
[%test_result: Sexp.t] [%sexp (1.4e100 : t)] ~expect:(Atom "1.4E+100")
|
|
;;
|
|
|
|
let%test_module _ =
|
|
(module struct
|
|
let test ?delimiter ~decimals f s s_strip_zero =
|
|
let s' = to_string_hum ?delimiter ~decimals ~strip_zero:false f in
|
|
if String.(s' <> s)
|
|
then
|
|
raise_s
|
|
[%message
|
|
"to_string_hum ~strip_zero:false"
|
|
~input:(f : float)
|
|
(decimals : int)
|
|
~got:(s' : string)
|
|
~expected:(s : string)];
|
|
let s_strip_zero' = to_string_hum ?delimiter ~decimals ~strip_zero:true f in
|
|
if String.(s_strip_zero' <> s_strip_zero)
|
|
then
|
|
raise_s
|
|
[%message
|
|
"to_string_hum ~strip_zero:true"
|
|
~input:(f : float)
|
|
(decimals : int)
|
|
~got:(s_strip_zero : string)
|
|
~expected:(s_strip_zero' : string)]
|
|
;;
|
|
|
|
let%test_unit _ = test ~decimals:3 0.99999 "1.000" "1"
|
|
let%test_unit _ = test ~decimals:3 0.00001 "0.000" "0"
|
|
let%test_unit _ = test ~decimals:3 ~-.12345.1 "-12_345.100" "-12_345.1"
|
|
let%test_unit _ = test ~delimiter:',' ~decimals:3 ~-.12345.1 "-12,345.100" "-12,345.1"
|
|
let%test_unit _ = test ~decimals:0 0.99999 "1" "1"
|
|
let%test_unit _ = test ~decimals:0 0.00001 "0" "0"
|
|
let%test_unit _ = test ~decimals:0 ~-.12345.1 "-12_345" "-12_345"
|
|
let%test_unit _ = test ~decimals:0 (5.0 /. 0.0) "inf" "inf"
|
|
let%test_unit _ = test ~decimals:0 (-5.0 /. 0.0) "-inf" "-inf"
|
|
let%test_unit _ = test ~decimals:0 (0.0 /. 0.0) "nan" "nan"
|
|
let%test_unit _ = test ~decimals:2 (5.0 /. 0.0) "inf" "inf"
|
|
let%test_unit _ = test ~decimals:2 (-5.0 /. 0.0) "-inf" "-inf"
|
|
let%test_unit _ = test ~decimals:2 (0.0 /. 0.0) "nan" "nan"
|
|
let%test_unit _ = test ~decimals:5 (10_000.0 /. 3.0) "3_333.33333" "3_333.33333"
|
|
let%test_unit _ = test ~decimals:2 ~-.0.00001 "-0.00" "-0"
|
|
|
|
let rand_test n =
|
|
let go () =
|
|
let f = Random.float 1_000_000.0 -. 500_000.0 in
|
|
let repeatable to_str =
|
|
let s = to_str f in
|
|
if String.( <> )
|
|
(String.split s ~on:',' |> String.concat |> of_string |> to_str)
|
|
s
|
|
then raise_s [%message "failed" (f : t)]
|
|
in
|
|
repeatable (to_string_hum ~decimals:3 ~strip_zero:false)
|
|
in
|
|
try
|
|
for _ = 0 to Int.( - ) n 1 do
|
|
go ()
|
|
done;
|
|
true
|
|
with
|
|
| e ->
|
|
eprintf "%s\n%!" (Exn.to_string e);
|
|
false
|
|
;;
|
|
|
|
let%test _ = rand_test 10_000
|
|
end)
|
|
;;
|
|
|
|
let%test_module "Hexadecimal syntax" =
|
|
(module struct
|
|
let should_fail str = Exn.does_raise (fun () -> Stdlib.float_of_string str)
|
|
let test_equal str g = Stdlib.float_of_string str = g
|
|
let%test _ = should_fail "0x"
|
|
let%test _ = should_fail "0x.p0"
|
|
let%test _ = test_equal "0x0" 0.
|
|
let%test _ = test_equal "0x1.b7p-1" 0.857421875
|
|
let%test _ = test_equal "0x1.999999999999ap-4" 0.1
|
|
end)
|
|
;;
|
|
|
|
let%expect_test "square" =
|
|
printf "%f\n" (square 1.5);
|
|
printf "%f\n" (square (-2.5));
|
|
[%expect {|
|
|
2.250000
|
|
6.250000
|
|
|}]
|
|
;;
|
|
|
|
let%expect_test "mathematical constants" =
|
|
(* Compare to the from-string conversion of numbers from Wolfram Alpha *)
|
|
let eq x s = assert (x = of_string s) in
|
|
eq pi "3.141592653589793238462643383279502884197169399375105820974";
|
|
eq sqrt_pi "1.772453850905516027298167483341145182797549456122387128213";
|
|
eq sqrt_2pi "2.506628274631000502415765284811045253006986740609938316629";
|
|
eq euler "0.577215664901532860606512090082402431042159335939923598805";
|
|
(* Check size of diff from ordinary computation. *)
|
|
printf "sqrt pi diff : %.20f\n" (sqrt_pi - sqrt pi);
|
|
printf "sqrt 2pi diff : %.20f\n" (sqrt_2pi - sqrt (2. * pi));
|
|
[%expect
|
|
{|
|
|
sqrt pi diff : 0.00000000000000022204
|
|
sqrt 2pi diff : 0.00000000000000044409
|
|
|}]
|
|
;;
|
|
|
|
let%test _ = not (is_negative Float.nan)
|
|
let%test _ = not (is_non_positive Float.nan)
|
|
let%test _ = is_non_negative (-0.)
|
|
|
|
let%test_unit "int to float conversion consistency" =
|
|
let test_int63 x =
|
|
[%test_result: float] (Float.of_int63 x) ~expect:(Float.of_int64 (Int63.to_int64 x))
|
|
in
|
|
let test_int x =
|
|
[%test_result: float] (Float.of_int x) ~expect:(Float.of_int63 (Int63.of_int x));
|
|
test_int63 (Int63.of_int x)
|
|
in
|
|
test_int 0;
|
|
test_int 35;
|
|
test_int (-1);
|
|
test_int Int.max_value;
|
|
test_int Int.min_value;
|
|
test_int63 Int63.zero;
|
|
test_int63 Int63.min_value;
|
|
test_int63 Int63.max_value;
|
|
let rand = Random.State.make [| Hashtbl.hash "int to float conversion consistency" |] in
|
|
for _i = 0 to 100 do
|
|
let x = Random.State.int rand Int.max_value in
|
|
test_int x
|
|
done;
|
|
()
|
|
;;
|
|
|
|
let%expect_test "min and max" =
|
|
let nan = Float.nan in
|
|
let inf = Float.infinity in
|
|
let ninf = Float.neg_infinity in
|
|
List.iter
|
|
[ 0.1, 0.3; 71., -7.; nan, 0.3; nan, ninf; nan, inf; nan, nan; ninf, inf; 0., -0. ]
|
|
~f:(fun (a, b) ->
|
|
printf
|
|
"%5g%5g%5g%5g%5g%5g\n"
|
|
a
|
|
b
|
|
(Float.min a b)
|
|
(Float.min b a)
|
|
(Float.max a b)
|
|
(Float.max b a));
|
|
[%expect
|
|
{|
|
|
0.1 0.3 0.1 0.1 0.3 0.3
|
|
71 -7 -7 -7 71 71
|
|
nan 0.3 nan nan nan nan
|
|
nan -inf nan nan nan nan
|
|
nan inf nan nan nan nan
|
|
nan nan nan nan nan nan
|
|
-inf inf -inf -inf inf inf
|
|
0 -0 -0 0 -0 0
|
|
|}]
|
|
;;
|
|
|
|
let%expect_test "is_nan, is_inf, and is_finite" =
|
|
List.iter
|
|
~f:(fun x ->
|
|
printf
|
|
!"%24s %5s %5s %5s\n"
|
|
(to_string x)
|
|
(Bool.to_string (is_nan x))
|
|
(Bool.to_string (is_inf x))
|
|
(Bool.to_string (is_finite x)))
|
|
[ nan
|
|
; neg_infinity
|
|
; -.max_finite_value
|
|
; -1.
|
|
; -.min_positive_subnormal_value
|
|
; -0.
|
|
; 0.
|
|
; min_positive_subnormal_value
|
|
; 1.
|
|
; max_finite_value
|
|
; infinity
|
|
];
|
|
[%expect
|
|
{|
|
|
nan true false false
|
|
-inf false true false
|
|
-1.7976931348623157e+308 false false true
|
|
-1. false false true
|
|
-4.94065645841247e-324 false false true
|
|
-0. false false true
|
|
0. false false true
|
|
4.94065645841247e-324 false false true
|
|
1. false false true
|
|
1.7976931348623157e+308 false false true
|
|
inf false true false
|
|
|}]
|
|
;;
|
|
|
|
let%expect_test "nan" =
|
|
require [%here] (Float.is_nan (Float.min 1. Float.nan));
|
|
require [%here] (Float.is_nan (Float.min Float.nan 0.));
|
|
require [%here] (Float.is_nan (Float.min Float.nan Float.nan));
|
|
require [%here] (Float.is_nan (Float.max 1. Float.nan));
|
|
require [%here] (Float.is_nan (Float.max Float.nan 0.));
|
|
require [%here] (Float.is_nan (Float.max Float.nan Float.nan));
|
|
require_equal [%here] (module Float) 1. (Float.min_inan 1. Float.nan);
|
|
require_equal [%here] (module Float) 0. (Float.min_inan Float.nan 0.);
|
|
require [%here] (Float.is_nan (Float.min_inan Float.nan Float.nan));
|
|
require_equal [%here] (module Float) 1. (Float.max_inan 1. Float.nan);
|
|
require_equal [%here] (module Float) 0. (Float.max_inan Float.nan 0.);
|
|
require [%here] (Float.is_nan (Float.max_inan Float.nan Float.nan))
|
|
;;
|
|
|
|
let%expect_test "iround_exn" =
|
|
require_equal [%here] (module Int) 0 (Float.iround_exn ~dir:`Nearest 0.2);
|
|
require_equal [%here] (module Int) 0 (Float.iround_exn ~dir:`Nearest (-0.2));
|
|
require_equal [%here] (module Int) 3 (Float.iround_exn ~dir:`Nearest 3.4);
|
|
require_equal [%here] (module Int) (-3) (Float.iround_exn ~dir:`Nearest (-3.4))
|
|
;;
|
|
|
|
let%expect_test "log" =
|
|
let test float =
|
|
let log2 = Float.log2 float in
|
|
let log10 = Float.log10 float in
|
|
let ratio = log2 /. log10 in
|
|
let ratio =
|
|
(* NAN behavior differs in js_of_ocaml *)
|
|
if Float.is_nan ratio
|
|
then Float.nan
|
|
else (
|
|
assert (Float.(abs ratio - (1. / log10 2.) < 1e-15));
|
|
ratio)
|
|
in
|
|
print_s [%sexp { log2 : float; log10 : float; ratio : float }]
|
|
in
|
|
test (-1.);
|
|
[%expect {|
|
|
((log2 NAN)
|
|
(log10 NAN)
|
|
(ratio NAN))
|
|
|}];
|
|
test 0.;
|
|
[%expect {|
|
|
((log2 -INF)
|
|
(log10 -INF)
|
|
(ratio NAN))
|
|
|}];
|
|
test 1.;
|
|
[%expect {|
|
|
((log2 0)
|
|
(log10 0)
|
|
(ratio NAN))
|
|
|}];
|
|
test 2.;
|
|
[%expect
|
|
{|
|
|
((log2 1)
|
|
(log10 0.3010299956639812)
|
|
(ratio 3.3219280948873622))
|
|
|}];
|
|
test 10.;
|
|
[%expect
|
|
{|
|
|
((log2 3.3219280948873622)
|
|
(log10 1)
|
|
(ratio 3.3219280948873622))
|
|
|}];
|
|
test Float.min_positive_subnormal_value;
|
|
[%expect
|
|
{|
|
|
((log2 -1074)
|
|
(log10 -323.30621534311581)
|
|
(ratio 3.3219280948873622))
|
|
|}];
|
|
test Float.epsilon_float;
|
|
[%expect
|
|
{|
|
|
((log2 -52)
|
|
(log10 -15.653559774527022)
|
|
(ratio 3.3219280948873626))
|
|
|}];
|
|
test Float.pi;
|
|
[%expect
|
|
{|
|
|
((log2 1.6514961294723187)
|
|
(log10 0.4971498726941338)
|
|
(ratio 3.3219280948873626))
|
|
|}];
|
|
test Float.max_finite_value;
|
|
[%expect
|
|
{|
|
|
((log2 1024)
|
|
(log10 308.25471555991675)
|
|
(ratio 3.3219280948873622))
|
|
|}];
|
|
test Float.infinity;
|
|
[%expect {|
|
|
((log2 INF)
|
|
(log10 INF)
|
|
(ratio NAN))
|
|
|}]
|
|
;;
|
|
|
|
let%expect_test "float comparisons permit both local and global arguments" =
|
|
let (_ : float -> float -> bool) = Float.( < ) in
|
|
let (_ : float -> float -> bool) = Float.( < ) in
|
|
[%expect {| |}]
|
|
;;
|