Merge remote-tracking branch 'ocp/bugfix-in-data-encoding'

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 =
@@ -1033,8 +1035,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
@@ -1073,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

test/lib/assert.ml

@@ -126,3 +126,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

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

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 =
+let test_simple ~msg ?(equal=Assert.equal) enc value =
-  test_simple_json ~msg:(msg ^ ": json") enc value ;
+  test_simple_json ~msg:(msg ^ ": json") ~equal enc value ;
-  test_simple_bin ~msg:(msg ^ ": binary") 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 =