Merge pull request #583 from fdopen/ldouble-to-int

Fix LDouble.to_int
yallop · Dec 7, 2018 · 5315981 · 5315981
2 parents 612b533 + e698210
commit 5315981
Show file tree

Hide file tree

Showing 4 changed files with 36 additions and 1 deletion.
diff --git a/src/ctypes/lDouble.ml b/src/ctypes/lDouble.ml
@@ -77,3 +77,5 @@ let one = of_int 1
 external size_ : unit -> (int * int) = "ctypes_ldouble_size"
 let byte_sizes = size_ ()
 
+external mant_dig_ : unit -> int = "ctypes_ldouble_mant_dig" "noalloc"
+let mant_dig = mant_dig_ ()
diff --git a/src/ctypes/lDouble.mli b/src/ctypes/lDouble.mli
@@ -178,3 +178,5 @@ val byte_sizes : int * int
     and the actual number of bytes used by the value.
     (unused bytes may contain undefined values) *)
 
+val mant_dig : int
+(** size of mantissa *)
diff --git a/src/ctypes/ldouble_stubs.c b/src/ctypes/ldouble_stubs.c
@@ -213,7 +213,9 @@ CAMLprim value ctypes_ldouble_of_int(value a) {
 }
 CAMLprim value ctypes_ldouble_to_int(value a) {
   CAMLparam1(a);
-  CAMLreturn(Val_long(ldouble_custom_val(a)));
+  long double b = ldouble_custom_val(a);
+  intnat c = b;
+  CAMLreturn(Val_long(c));
 }
 
 #define OP2(OPNAME, OP)                                                               \
@@ -563,3 +565,7 @@ value ldouble_init(value unit) {
   return Val_unit;
 }
 
+CAMLprim value ctypes_ldouble_mant_dig(value unit) {
+  intnat r = LDBL_MANT_DIG;
+  return Val_long(r);
+}
diff --git a/tests/test-ldouble/test_ldouble.ml b/tests/test-ldouble/test_ldouble.ml
@@ -116,6 +116,31 @@ let test_conv _ =
   List.iter (fun a -> assert_bool "to/of_float" (a = LDouble.(to_float (of_float a)))) flts;
   assert_bool "to_int" (3 = LDouble.(to_int (of_float 3.45)));
   assert_bool "to_int" (-34 = LDouble.(to_int (of_float (-34.999))));
+  assert_bool "mant_dig" (LDouble.mant_dig >= 53);
+  if Sys.word_size = 32 then (
+    let max = float_of_int max_int in
+    let min = float_of_int min_int in
+    assert_bool "to_int" (max_int = LDouble.(to_int (of_float max)));
+    assert_bool "to_int" (min_int = LDouble.(to_int (of_float min)));
+    assert_bool "to_int_max" (max_int = LDouble.(to_int (of_int max_int)));
+    assert_bool "to_int_min" (min_int = LDouble.(to_int (of_int min_int)));
+  )
+  else (
+    let max =  9007199254740991. in (* 2^53 - 1. Largest integer that fits into the mantissa of a double *)
+    let min = -9007199254740991. in
+    assert_bool "to_int" (Int64.to_int (-9007199254740991L) = LDouble.(to_int (of_float min)));
+    assert_bool "to_int" (Int64.to_int 9007199254740991L = LDouble.(to_int (of_float max)));
+    let max,min =
+      if LDouble.mant_dig >= 62 then
+        max_int,(-max_int)
+      else
+        let rec iter ac i = if i = 0 then ac else iter (ac * 2) (pred i) in
+        let max = (iter 1 LDouble.mant_dig) - 1 in
+        max,(max * (-1))
+    in
+    assert_bool "to_int_max" (max = LDouble.(to_int (of_int max)));
+    assert_bool "to_int_min" (min = LDouble.(to_int (of_int min)));
+  );
   assert_bool "of_string" (3.5 = LDouble.(to_float (of_string "3.5")));
   assert_bool "to_string" ("3.500000" = LDouble.(to_string (of_float 3.5)))