Skip to content

Commit

Permalink
Fix LDouble.to_int and add LDouble.mant_dig
Browse files Browse the repository at this point in the history
`long double` must be casted to `intnat` first, not to `uintnat`
directly. Otherwise the conversion is undefined behavior for nearly
all negative values, see:
http://c0x.coding-guidelines.com/6.3.1.4.html , Note 50. The code was
correct until
ocaml/ocaml@24c118d
  • Loading branch information
fdopen committed Dec 7, 2018
1 parent 066cf8f commit e698210
Show file tree
Hide file tree
Showing 4 changed files with 36 additions and 1 deletion.
2 changes: 2 additions & 0 deletions src/ctypes/lDouble.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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_ ()
2 changes: 2 additions & 0 deletions src/ctypes/lDouble.mli
Original file line number Diff line number Diff line change
Expand Up @@ -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 *)
8 changes: 7 additions & 1 deletion src/ctypes/ldouble_stubs.c
Original file line number Diff line number Diff line change
Expand Up @@ -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) \
Expand Down Expand Up @@ -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);
}
25 changes: 25 additions & 0 deletions tests/test-ldouble/test_ldouble.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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)))

Expand Down

0 comments on commit e698210

Please sign in to comment.