From f96fbe7d3194ac324eca37ccc7139749c4d5bb33 Mon Sep 17 00:00:00 2001 From: OCamlPro-Iguernlala Date: Wed, 29 Mar 2017 18:02:19 +0200 Subject: [PATCH 1/4] [bugfix in data_encoding] When reading a float (from binary format), MBytes.get_double should be used instead of MBytes.get_float (Float _ encodes doubles in the encoding, not singles) --- src/minutils/data_encoding.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/minutils/data_encoding.ml b/src/minutils/data_encoding.ml index 17cb3f981..fc7e5d71b 100644 --- a/src/minutils/data_encoding.ml +++ b/src/minutils/data_encoding.ml @@ -1033,8 +1033,10 @@ let rec length : type x. x t -> x -> int = fun e -> let int64 buf ofs _len = ofs + Size.int64, MBytes.get_int64 buf ofs + (** read a float64 (double) **) let float buf ofs _len = - ofs + Size.float, MBytes.get_float buf ofs + (* Here, float means float64, which is read using MBytes.get_double !! *) + ofs + Size.float, MBytes.get_double buf ofs let int_of_int32 i = let i' = Int32.to_int i in From dc32decd0586ca4c9b402351d2c4be646be0dca7 Mon Sep 17 00:00:00 2001 From: OCamlPro-Iguernlala Date: Wed, 29 Mar 2017 18:32:46 +0200 Subject: [PATCH 2/4] [bugfix in data_encoding] When writing a float (to binary format), MBytes.set_double should be used instead of MBytes.set_float (Float _ encodes doubles in the encoding, not singles) --- src/minutils/data_encoding.ml | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/minutils/data_encoding.ml b/src/minutils/data_encoding.ml index fc7e5d71b..ed98dca1d 100644 --- a/src/minutils/data_encoding.ml +++ b/src/minutils/data_encoding.ml @@ -876,8 +876,10 @@ let rec length : type x. x t -> x -> int = fun e -> MBytes.set_int64 buf ofs v; ofs + Size.int64 + (** write a float64 (double) **) let float v buf ofs = - MBytes.set_float buf ofs v; + (*Here, float means float64, which is written using MBytes.set_double !!*) + MBytes.set_double buf ofs v; ofs + Size.float let fixed_kind_bytes length s buf ofs = @@ -1035,7 +1037,7 @@ let rec length : type x. x t -> x -> int = fun e -> (** read a float64 (double) **) let float buf ofs _len = - (* Here, float means float64, which is read using MBytes.get_double !! *) + (*Here, float means float64, which is read using MBytes.get_double !!*) ofs + Size.float, MBytes.get_double buf ofs let int_of_int32 i = From 669a0249caec75897ee2fcc8981786b233c6e139 Mon Sep 17 00:00:00 2001 From: OCamlPro-Iguernlala Date: Wed, 29 Mar 2017 18:33:39 +0200 Subject: [PATCH 3/4] add some asserts in data_encoding --- src/minutils/data_encoding.ml | 2 ++ 1 file changed, 2 insertions(+) diff --git a/src/minutils/data_encoding.ml b/src/minutils/data_encoding.ml index ed98dca1d..81e677034 100644 --- a/src/minutils/data_encoding.ml +++ b/src/minutils/data_encoding.ml @@ -1077,10 +1077,12 @@ let rec length : type x. x t -> x -> int = fun e -> let list read buf ofs len = let rec loop acc ofs len = + assert (len >= 0); if len <= 0 then ofs, List.rev acc else let ofs', v = read buf ofs len in + assert (ofs' > ofs); loop (v :: acc) ofs' (len - (ofs' - ofs)) in loop [] ofs len From ee554820c78d017f741ad56c267d5bc7232879b1 Mon Sep 17 00:00:00 2001 From: OCamlPro-Iguernlala Date: Thu, 30 Mar 2017 11:26:11 +0200 Subject: [PATCH 4/4] add more tests for "floats" in test_data_encoding ( +/- infinity, +/- 0., NaNs) --- test/lib/assert.ml | 4 ++++ test/lib/assert.mli | 4 ++++ test/test_data_encoding.ml | 16 ++++++++++++---- 3 files changed, 20 insertions(+), 4 deletions(-) diff --git a/test/lib/assert.ml b/test/lib/assert.ml index 946c13a85..112094555 100644 --- a/test/lib/assert.ml +++ b/test/lib/assert.ml @@ -128,3 +128,7 @@ let fail_msg fmt = let fail expected given fmt = Format.kasprintf (Assert.fail expected given) fmt +let equal_float ?eq ?prn ?msg f1 f2 = + match classify_float f1, classify_float f2 with + | FP_nan, FP_nan -> () + | _ -> equal ?eq ?prn ?msg f1 f2 diff --git a/test/lib/assert.mli b/test/lib/assert.mli index b8f1e47e8..a2917b304 100644 --- a/test/lib/assert.mli +++ b/test/lib/assert.mli @@ -66,3 +66,7 @@ val test_fail : (unit -> 'a) -> (exn -> bool) -> unit + +val equal_float: + ?eq:(float -> float -> bool) -> + ?prn:(float -> string) -> ?msg:string -> float -> float -> unit diff --git a/test/test_data_encoding.ml b/test/test_data_encoding.ml index 0ce07cee4..ddd6f1403 100644 --- a/test/test_data_encoding.ml +++ b/test/test_data_encoding.ml @@ -18,7 +18,7 @@ let is_invalid_arg = function | Invalid_argument _ -> true | _ -> false -let test_simple_json ?msg ?eq:(equal=Assert.equal) encoding value = +let test_simple_json ?msg ?(equal=Assert.equal) encoding value = let json = Json.construct encoding value in let result = Json.destruct encoding json in equal ?msg value result @@ -42,9 +42,9 @@ let test_bin_exn ?msg encoding value fail = Binary.of_bytes encoding bin in Assert.test_fail ?msg get_result fail -let test_simple ~msg enc value = - test_simple_json ~msg:(msg ^ ": json") enc value ; - test_simple_bin ~msg:(msg ^ ": binary") enc value +let test_simple ~msg ?(equal=Assert.equal) enc value = + test_simple_json ~msg:(msg ^ ": json") ~equal enc value ; + test_simple_bin ~msg:(msg ^ ": binary") ~equal enc value let test_simple_exn ~msg enc value = test_json_exn ~msg:(msg ^ ": json") enc value (fun _ -> true) ; @@ -88,6 +88,14 @@ let test_simple_values _ = test_simple ~msg:__LOC__ string "tutu"; test_simple ~msg:__LOC__ bytes (MBytes.of_string "titi"); test_simple ~msg:__LOC__ float 42.; + test_simple ~msg:__LOC__ float max_float; + test_simple ~msg:__LOC__ float min_float; + test_simple ~msg:__LOC__ float (-. 0.); + test_simple ~msg:__LOC__ float (+. 0.); + test_simple ~msg:__LOC__ float infinity; + test_simple ~msg:__LOC__ float neg_infinity; + test_simple ~msg:__LOC__ float epsilon_float; + test_simple ~msg:__LOC__ ~equal:Assert.equal_float float nan; test_simple ~msg:__LOC__ (option string) (Some "thing"); test_simple ~msg:__LOC__ (option string) None; let enum_enc =