diff --git a/src/minutils/data_encoding.ml b/src/minutils/data_encoding.ml index 17cb3f981..81e677034 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 = @@ -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 diff --git a/test/lib/assert.ml b/test/lib/assert.ml index 0e459a5d5..9a1925f9f 100644 --- a/test/lib/assert.ml +++ b/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 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 =