diff --git a/src/lib_data_encoding/binary.ml b/src/lib_data_encoding/binary.ml index b7e1f124a..2441ebfdc 100644 --- a/src/lib_data_encoding/binary.ml +++ b/src/lib_data_encoding/binary.ml @@ -219,6 +219,7 @@ module Writer = struct ofs + Size.float let fixed_kind_bytes length s buf ofs = + if MBytes.length s <> length then invalid_arg "fixed_kind_bytes"; MBytes.blit s 0 buf ofs length; ofs + length @@ -325,6 +326,7 @@ module BufferedWriter = struct MBytes_buffer.write_double buf v let fixed_kind_bytes length s buf = + if MBytes.length s <> length then invalid_arg "fixed_kind_bytes"; MBytes_buffer.write_mbytes buf s 0 length let variable_length_bytes s buf = diff --git a/src/lib_data_encoding/binary_stream.ml b/src/lib_data_encoding/binary_stream.ml index adefb1f26..f3cd08f13 100644 --- a/src/lib_data_encoding/binary_stream.ml +++ b/src/lib_data_encoding/binary_stream.ml @@ -197,12 +197,12 @@ let rec data_checker | `Uint16 -> uint16 buf | `Uint30 -> uint30 buf in let ranged = if minimum > 0 then ranged + minimum else ranged in - assert (minimum < ranged && ranged < maximum) ; + assert (minimum <= ranged && ranged <= maximum) ; next_path path stream | Float -> next_path path (fst (float buf)) | RangedFloat { minimum ; maximum } -> let stream, float = float buf in - assert (minimum < float && maximum > float) ; + assert (minimum <= float && maximum >= float) ; next_path path stream | Bytes (`Fixed n) -> next_path path (fst (fixed_length_bytes n buf)) diff --git a/src/lib_data_encoding/data_encoding.mli b/src/lib_data_encoding/data_encoding.mli index d77cc53a8..183695457 100644 --- a/src/lib_data_encoding/data_encoding.mli +++ b/src/lib_data_encoding/data_encoding.mli @@ -567,3 +567,6 @@ val json: json Encoding.t type json_schema = Json.schema val json_schema: json_schema Encoding.t type bson = Bson.t + +exception Float_out_of_range of float * float * float +exception Int_out_of_range of int * int * int diff --git a/src/lib_data_encoding/test/assert.ml b/src/lib_data_encoding/test/assert.ml deleted file mode 100644 index 20e20a899..000000000 --- a/src/lib_data_encoding/test/assert.ml +++ /dev/null @@ -1,43 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -let fail expected given msg = - Format.kasprintf failwith - "@[%s@ expected: %s@ got: %s@]" msg expected given -let fail_msg fmt = Format.kasprintf (fail "" "") fmt - -let default_printer _ = "" - -let equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y = - if not (eq x y) then fail (prn x) (prn y) msg - -let not_equal ?(eq=(=)) ?(prn=default_printer) ?(msg="") x y = - if eq x y then fail (prn x) (prn y) msg - -let is_some ?(msg = "Assert.is_some: error.") a = - match a with - | None -> fail "Some _" "None" msg - | Some _ -> () -let is_true ?(msg="") x = - if not x then fail "true" "false" msg - -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 - -let test_fail ?(msg = "") ?(prn = default_printer) f may_fail = - try - let value = f () in - fail "any exception" ("no exception: " ^ prn value) msg - with exn -> - if not (may_fail exn) then - fail "exception" - (Printf.sprintf "unexpectec exception: %s" (Printexc.to_string exn)) - msg diff --git a/src/lib_data_encoding/test/helpers.ml b/src/lib_data_encoding/test/helpers.ml new file mode 100644 index 000000000..0a329382b --- /dev/null +++ b/src/lib_data_encoding/test/helpers.ml @@ -0,0 +1,60 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Data_encoding + +let no_exception f = + try f () + with + | Json_encoding.Cannot_destruct _ + | Json_encoding.Unexpected _ + | Json_encoding.No_case_matched _ + | Json_encoding.Bad_array_size _ + | Json_encoding.Missing_field _ + | Json_encoding.Unexpected_field _ + | Json_encoding.Bad_schema _ as exn -> + Alcotest.failf + "@[v 2>json failed:@ %a@]" + (fun ppf -> Json_encoding.print_error ppf) exn + | exn -> + Alcotest.failf + "@[v 2>unexpected exception:@ %s@]" + (Printexc.to_string exn) + +let check_raises expected f = + match f () with + | exception exn when expected exn -> () + | exception exn -> + Alcotest.failf "Unexpected exception: %s." (Printexc.to_string exn) + | _ -> Alcotest.failf "Expecting exception, got success." + +let chunked_read sz encoding bytes = + let status = + List.fold_left + (fun status chunk -> + match status with + | Binary.Await f -> f chunk + | Success _ when MBytes.length chunk <> 0 -> Error + | Success _ | Error -> status) + (Binary.read_stream_of_bytes encoding) + (MBytes.cut sz bytes) in + match status with + | Success { remaining ; _ } when + List.exists (fun b -> MBytes.length b <> 0) remaining -> + Binary.Error + | _ -> status + +let streamed_read encoding bytes = + List.fold_left + (fun (status, count as acc) chunk -> + match status with + | Binary.Await f -> (f chunk, succ count) + | Success _ | Error -> acc) + (Binary.read_stream_of_bytes encoding, 0) + (MBytes.cut 1 bytes) diff --git a/src/lib_data_encoding/test/invalid_encoding.ml b/src/lib_data_encoding/test/invalid_encoding.ml new file mode 100644 index 000000000..1b5bb95ec --- /dev/null +++ b/src/lib_data_encoding/test/invalid_encoding.ml @@ -0,0 +1,25 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Data_encoding +open Helpers + +let test ?(expected = fun _ -> true) name f = + name, `Quick, fun () -> check_raises expected f + +let tests = [ + test "multi_variable_tup" (fun () -> tup2 Variable.string Variable.string) ; + test "variable_in_list" (fun () -> list Variable.string) ; + test "nested_option" (fun () -> option (option int8)) ; + test "merge_non_objs" (fun () -> merge_objs int8 string) ; + test "empty_union" (fun () -> union []) ; + test "duplicated_tag" (fun () -> + union [ case (Tag 0) empty (fun () -> None) (fun () -> ()) ; + case (Tag 0) empty (fun () -> None) (fun () -> ()) ]) ; +] diff --git a/src/lib_data_encoding/test/randomized.ml b/src/lib_data_encoding/test/randomized.ml new file mode 100644 index 000000000..524f6a2c0 --- /dev/null +++ b/src/lib_data_encoding/test/randomized.ml @@ -0,0 +1,59 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +(** Various randomly generated data. *) + +open Data_encoding + +(** Generate encodings of the encoding and the randomized generator *) +let test_generator ?(iterations=50) ty encoding generator = + for _ = 0 to iterations - 1 do + let value = generator () in + Success.json ty encoding value () ; + Success.bson ty encoding value () ; + Success.binary ty encoding value () ; + Success.stream ty encoding value () ; + done + +let rec make_int_list acc len () = + if len = 0 then + acc + else + make_int_list (Random.int64 Int64.max_int :: acc) (len - 1) () + +let test_randomized_int_list () = + test_generator + Alcotest.(list int64) + (list int64) + (make_int_list [] 100) + +let test_randomized_string_list () = + test_generator + Alcotest.(list string) + (list string) + (fun () -> List.map Int64.to_string (make_int_list [] 20 ())) + +let test_randomized_variant_list () = + test_generator + Alcotest.(list (result (option string) string)) + (list (result (option string) (obj1 (req "failure" string)))) + (fun () -> + List.map + (fun x -> + let str = Int64.to_string x in + if Random.bool () + then if Random.bool () then Ok (Some str) else Ok None + else Error str) + (make_int_list [] 20 ())) + +let tests = [ + "int_list", `Quick, test_randomized_int_list ; + "string_list", `Quick, test_randomized_string_list ; + "variant_list", `Quick, test_randomized_variant_list ; +] diff --git a/src/lib_data_encoding/test/read_failure.ml b/src/lib_data_encoding/test/read_failure.ml new file mode 100644 index 000000000..b30627f09 --- /dev/null +++ b/src/lib_data_encoding/test/read_failure.ml @@ -0,0 +1,152 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +(** Test expected errors while deserializing data. *) + +open Data_encoding +open Helpers +open Types + +let not_enough_data = function + | Invalid_argument _ -> true + | _ -> false + +let extra_bytes = function + | Failure _ -> true + | _ -> false + +let trailing_zero = function + | Failure _ -> true + | _ -> false + +let invalid_int = function + | Data_encoding.Int_out_of_range _ -> true + | Json_encoding.Cannot_destruct ([] , Failure _) -> true + | _ -> false + +let invalid_string_length = function + | Json_encoding.Cannot_destruct + ([], Json_encoding.Unexpected ("string (len 9)", "string (len 4)")) -> true + | Json_encoding.Cannot_destruct + ([], Json_encoding.Unexpected ("bytes (len 9)", "bytes (len 4)")) -> true + | Failure _ -> true + | _ -> false + +let missing_case = function + | Json_encoding.Cannot_destruct ([], Json_encoding.No_case_matched _ ) -> true + | Unexpected_tag _ -> true + | _ -> false + +let missing_enum = function + | Json_encoding.Cannot_destruct ([], Json_encoding.Unexpected _ ) -> true + | No_case_matched -> true + | _ -> false + +let json ?(expected = fun _ -> true) read_encoding json () = + check_raises expected begin fun () -> + ignore (Json.destruct read_encoding json) + end + +let bson ?(expected = fun _ -> true) read_encoding bson () = + check_raises expected begin fun () -> + ignore (Bson.destruct read_encoding bson) + end + +let binary ?(expected = fun _ -> true) read_encoding bytes () = + check_raises expected begin fun () -> + ignore (Binary.of_bytes_exn read_encoding bytes) ; + end + +let stream read_encoding bytes () = + let len_data = MBytes.length bytes in + for sz = 1 to max 1 len_data do + let name = Format.asprintf "stream (%d)" sz in + match chunked_read sz read_encoding bytes with + | Binary.Success _ -> + Alcotest.failf "%s failed: expecting exception, got success." name + | Binary.Await _ -> + Alcotest.failf "%s failed: not enough data" name + | Error -> () + done + +let all ?expected name write_encoding read_encoding value = + let json_value = Json.construct write_encoding value in + let bson_value = Bson.construct write_encoding value in + let bytes_value = Binary.to_bytes write_encoding value in + [ name ^ ".json", `Quick, json ?expected read_encoding json_value ; + name ^ ".bson", `Quick, bson ?expected read_encoding bson_value ; + name ^ ".bytes", `Quick, binary ?expected read_encoding bytes_value ; + name ^ ".stream", `Quick, stream read_encoding bytes_value ; + ] + +let all_ranged_int minimum maximum = + let encoding = ranged_int minimum maximum in + let signed = + match Size.range_to_size ~minimum ~maximum with + | `Int31 | `Int8 | `Int16 -> true + | `Uint8 | `Uint16 | `Uint30 -> false in + let write_encoding = + splitted + ~json:(ranged_int (minimum - 1) (maximum + 1)) + ~binary: + (if signed then + (ranged_int (minimum - 1) (maximum + 1)) + else + ranged_int minimum (maximum + 1)) in + let name = Format.asprintf "ranged_int.%d" minimum in + all ~expected:invalid_int (name ^ ".max") write_encoding encoding (maximum + 1) @ + if signed then + all ~expected:invalid_int (name ^ ".min") write_encoding encoding (minimum - 1) + else + let json_value = Json.construct write_encoding (minimum - 1) in + let bson_value = Bson.construct write_encoding (minimum - 1) in + [ name ^ "min.json", `Quick, json ~expected:invalid_int encoding json_value ; + name ^ "min..bson", `Quick, bson ~expected:invalid_int encoding bson_value ] + +let all_ranged_float minimum maximum = + let encoding = ranged_float minimum maximum in + let name = Format.asprintf "ranged_float.%f" minimum in + all (name ^ ".min") float encoding (minimum -. 1.) @ + all (name ^ ".max") float encoding (maximum +. 1.) + +let tests = + all_ranged_int 100 400 @ + all_ranged_int 19000 19253 @ + all_ranged_int ~-100 300 @ + all_ranged_int ~-300_000_000 300_000_000 @ + all_ranged_float ~-. 100. 300. @ + all "string.fixed" ~expected:invalid_string_length + string (Fixed.string 4) "turlututu" @ + all "bytes.fixed" ~expected:invalid_string_length + bytes (Fixed.bytes 4) (MBytes.of_string "turlututu") @ + all "unknown_case.B" ~expected:missing_case union_enc mini_union_enc (B "2") @ + all "unknown_case.E" ~expected:missing_case union_enc mini_union_enc E @ + all "enum.missing" ~expected:missing_enum enum_enc mini_enum_enc 4 @ + [ "z.truncated", `Quick, + binary ~expected:not_enough_data z (MBytes.of_string "\x83") ; + "z.trailing_zero", `Quick, + binary ~expected:trailing_zero z (MBytes.of_string "\x83\x00") ; + "z.trailing_zero2", `Quick, + binary ~expected:trailing_zero z (MBytes.of_string "\x83\x80\x00") ; + "dynamic_size.empty", `Quick, + binary ~expected:not_enough_data (dynamic_size Variable.string) + (MBytes.of_string "") ; + "dynamic_size.partial_size", `Quick, + binary ~expected:not_enough_data (dynamic_size Variable.string) + (MBytes.of_string "\x00\x00") ; + "dynamic_size.incomplete_data", `Quick, + binary ~expected:not_enough_data (dynamic_size Variable.string) + (MBytes.of_string "\x00\x00\x00\x04\x00\x00") ; + "dynamic_size.outer-garbage", `Quick, + binary ~expected:extra_bytes (dynamic_size Variable.string) + (MBytes.of_string "\x00\x00\x00\x01\x00\x00") ; + "dynamic_size.inner-garbage", `Quick, + binary ~expected:extra_bytes (dynamic_size uint8) + (MBytes.of_string "\x00\x00\x00\x02\x00\x00") ; + ] diff --git a/src/lib_data_encoding/test/success.ml b/src/lib_data_encoding/test/success.ml new file mode 100644 index 000000000..80b51aa5b --- /dev/null +++ b/src/lib_data_encoding/test/success.ml @@ -0,0 +1,218 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +(** Trivial back-and-forth test: a value is serialized, then + unserialized and compared to the original value. All backend + (json, bson, binary, and streamed binary) are tested for each of + the basic encoding described here. No serialization or + deserialization failure are expected in these tests. *) + +(* TODO `varopt` ; `assoc` ; `Data_encoding.json` *) + +open Data_encoding +open Helpers +open Types +open Utils.Infix + +let json ty encoding value () = + no_exception begin fun () -> + let json = Json.construct encoding value in + let result = Json.destruct encoding json in + Alcotest.check ty "json" value result + end + +let bson ty encoding value () = + no_exception begin fun () -> + let json = Bson.construct encoding value in + let result = Bson.destruct encoding json in + Alcotest.check ty "bson" value result + end + +let binary ty encoding value () = + no_exception begin fun () -> + let bytes = Binary.to_bytes encoding value in + let result = Binary.of_bytes_exn encoding bytes in + Alcotest.check ty "binary" value result + end + +let stream ty encoding value () = + no_exception begin fun () -> + let bytes = Binary.to_bytes encoding value in + let len_data = MBytes.length bytes in + for sz = 1 to max 1 len_data do + let name = Format.asprintf "stream (%d)" sz in + match chunked_read sz encoding bytes with + | Binary.Success { res = result ; res_len = size ; remaining } -> + if size <> MBytes.length bytes || + List.exists (fun b -> MBytes.length b <> 0) remaining then + Alcotest.failf "%s failed: remaining data" name ; + Alcotest.check ty name value result + | Binary.Await _ -> + Alcotest.failf "%s failed: not enough data" name + | Binary.Error -> + Alcotest.failf "@[%s failed: read error@]" name + done ; + end + +let all name ty encoding value = + let stream_encoding = + match Data_encoding.classify encoding with + | `Variable -> dynamic_size encoding + | `Dynamic | `Fixed _ -> encoding in + [ name ^ ".json", `Quick, json ty encoding value ; + name ^ ".bson", `Quick, bson ty encoding value ; + name ^ ".binary", `Quick, binary ty encoding value ; + name ^ ".binary_stream", `Quick, stream ty stream_encoding value ] + +let all_int encoding size = + let name = Format.asprintf "int%d" size in + all (name ^ ".min") Alcotest.int encoding ~- (1 lsl (size - 1)) @ + all (name ^ ".mean") Alcotest.int encoding 0 @ + all (name ^ ".max") Alcotest.int encoding ((1 lsl (size - 1)) - 1) + +let all_uint encoding size = + let name = Format.asprintf "uint%d" size in + all (name ^ ".min") Alcotest.int encoding 0 @ + all (name ^ ".mean") Alcotest.int encoding (1 lsl (size - 1)) @ + all (name ^ ".max") Alcotest.int encoding ((1 lsl size) - 1) + +let all_ranged_int minimum maximum = + let encoding = ranged_int minimum maximum in + let name = Format.asprintf "ranged_int.%d" minimum in + all (name ^ ".min") Alcotest.int encoding minimum @ + all (name ^ ".mean") Alcotest.int encoding ((minimum + maximum) / 2) @ + all (name ^ ".max") Alcotest.int encoding maximum + +let all_ranged_float minimum maximum = + let encoding = ranged_float minimum maximum in + let name = Format.asprintf "ranged_float.%f" minimum in + all (name ^ ".min") Alcotest.float encoding minimum @ + all (name ^ ".mean") Alcotest.float encoding ((minimum +. maximum) /. 2.) @ + all (name ^ ".max") Alcotest.float encoding maximum + +let test_z_sequence () = + let test i = binary Alcotest.z z i () in + for i = -1_00_000 to 1_00_000 do test (Z.of_int i) done ; + for i = 100_000_000 to 100_100_000 do test (Z.of_int i) done ; + for i = -100_000_000 downto -100_100_000 do test (Z.of_int i) done + +let test_string_enum_boundary () = + let entries = List.rev_map (fun x -> string_of_int x, x) (0 -- 254) in + let run_test cases = + List.iter (fun (_, num) -> + let enc = string_enum cases in + json Alcotest.int enc num () ; + bson Alcotest.int enc num () ; + binary Alcotest.int enc num () ; + stream Alcotest.int enc num ()) + cases in + run_test entries ; + let entries2 = (("255", 255) :: entries) in + run_test entries2 ; + run_test (("256", 256) :: entries2) + +let tests = + all "null" Alcotest.pass null () @ + all "empty" Alcotest.pass empty () @ + all "constant" Alcotest.pass (constant "toto") () @ + all_int int8 8 @ + all_uint uint8 8 @ + all_int int16 16 @ + all_uint uint16 16 @ + all_int int31 31 @ + all "int32.min" Alcotest.int32 int32 Int32.min_int @ + all "int32.max" Alcotest.int32 int32 Int32.max_int @ + all "int64.min" Alcotest.int64 int64 Int64.min_int @ + all "int64.max" Alcotest.int64 int64 Int64.max_int @ + all_ranged_int 100 400 @ + all_ranged_int 19000 19254 @ + all_ranged_int ~-100 300 @ + all_ranged_int ~-300_000_000 300_000_000 @ + all "bool.true" Alcotest.bool bool true @ + all "bool.false" Alcotest.bool bool false @ + all "string" Alcotest.string string "tutu" @ + all "string.fixed" Alcotest.string (Fixed.string 4) "tutu" @ + all "string.variable" Alcotest.string Variable.string "tutu" @ + all "bytes" Alcotest.bytes bytes (MBytes.of_string "titi") @ + all "bytes.fixed" Alcotest.bytes (Fixed.bytes 4) + (MBytes.of_string "titi") @ + all "bytes.variable" Alcotest.bytes Variable.bytes + (MBytes.of_string "titi") @ + all "float" Alcotest.float float 42. @ + all "float.max" Alcotest.float float max_float @ + all "float.min" Alcotest.float float min_float @ + all "float.neg_zero" Alcotest.float float (-. 0.) @ + all "float.zero" Alcotest.float float (+. 0.) @ + all "float.infinity" Alcotest.float float infinity @ + all "float.neg_infity" Alcotest.float float neg_infinity @ + all "float.epsilon" Alcotest.float float epsilon_float @ + all "float.nan" Alcotest.float float nan @ + all_ranged_float ~-. 100. 300. @ + all "z.zero" Alcotest.z z (Z.zero) @ + all "z.one" Alcotest.z z (Z.one) @ + [ "z.sequence", `Quick, test_z_sequence ] @ + let rec fact n l = + if n < 1 then + [] + else + let l = Z.mul l (Z.of_int n) in + fact (n - 1) l @ + all (Format.asprintf "z.fact.%d" n) Alcotest.z z l in + fact 35 Z.one @ + all "z.a" Alcotest.z z + (Z.of_string "123574503164821730218493275982143254986574985328") @ + all "z.b" Alcotest.z z + (Z.of_string "8493275982143254986574985328") @ + all "z.c" Alcotest.z z + (Z.of_string "123574503164821730218474985328") @ + all "z.d" Alcotest.z z + (Z.of_string "10000000000100000000001000003050000000060600000000000777000008") @ + all "z.e" Alcotest.z z + (Z.of_string "-123574503164821730218493275982143254986574985328") @ + all "z.f" Alcotest.z z + (Z.of_string "-8493275982143254986574985328") @ + all "z.g" Alcotest.z z + (Z.of_string "-123574503164821730218474985328") @ + all "z.h" Alcotest.z z + (Z.of_string "-10000000000100000000001000003050000000060600000000000777000008") @ + all "none" Alcotest.(option string) (option string) None @ + all "some.string" Alcotest.(option string) (option string) + (Some "thing") @ + all "enum" Alcotest.int enum_enc 4 @ + all "obj" Alcotest.record record_obj_enc default_record @ + all "obj.dft" Alcotest.record record_obj_enc + { default_record with b = false } @ + all "obj.req" Alcotest.record record_obj_enc + { default_record with c = None } @ + all "tup" Alcotest.record record_tup_enc default_record @ + all "obj.variable" Alcotest.variable_record variable_record_obj_enc + default_variable_record @ + all "tup.variable" Alcotest.variable_record variable_record_tup_enc + default_variable_record @ + all "obj.variable_left" Alcotest.variable_left_record variable_left_record_obj_enc + default_variable_left_record @ + all "tup.variable_left" Alcotest.variable_left_record variable_left_record_tup_enc + default_variable_left_record @ + all "union.A" Alcotest.union union_enc (A 1) @ + all "union.B" Alcotest.union union_enc (B "2") @ + all "union.C" Alcotest.union union_enc (C 3) @ + all "union.D" Alcotest.union union_enc (D "4") @ + all "union.E" Alcotest.union union_enc E @ + all "variable_list.empty" Alcotest.(list int) (Variable.list int31) [] @ + all "variable_list" Alcotest.(list int) (Variable.list int31) [1;2;3;4;5] @ + all "variable_array.empty" Alcotest.(array int) (Variable.array int31) [||] @ + all "variable_array" Alcotest.(array int) (Variable.array int31) [|1;2;3;4;5|] @ + all "list.empty" Alcotest.(list int) (list int31) [] @ + all "list" Alcotest.(list int) (list int31) [1;2;3;4;5] @ + all "array.empty" Alcotest.(array int) (array int31) [||] @ + all "array" Alcotest.(array int) (array int31) [|1;2;3;4;5|] @ + all "mu_list.empty" Alcotest.(list int) (mu_list_enc int31) [] @ + all "mu_list" Alcotest.(list int) (mu_list_enc int31) [1;2;3;4;5] @ + [ "string_enum_boundary", `Quick, test_string_enum_boundary ; + ] diff --git a/src/lib_data_encoding/test/test.ml b/src/lib_data_encoding/test/test.ml index abc05e32f..803480260 100644 --- a/src/lib_data_encoding/test/test.ml +++ b/src/lib_data_encoding/test/test.ml @@ -10,6 +10,9 @@ let () = Random.init 100 ; Alcotest.run "tezos-data-encoding" [ - "data_encoding", Test_data_encoding.tests ; - "stream_data_encoding", Test_stream_data_encoding.tests ; + "success", Success.tests ; + "invalid_encoding", Invalid_encoding.tests ; + "read_failure", Read_failure.tests ; + "write_failure", Write_failure.tests ; + "randomized", Randomized.tests ; ] diff --git a/src/lib_data_encoding/test/test_data_encoding.ml b/src/lib_data_encoding/test/test_data_encoding.ml deleted file mode 100644 index d9401beab..000000000 --- a/src/lib_data_encoding/test/test_data_encoding.ml +++ /dev/null @@ -1,377 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Utils.Infix -open Data_encoding - -let is_invalid_arg = function - | Invalid_argument _ -> true - | _ -> false - -let test_simple_json ?msg ?(equal=Assert.equal) encoding value = - let result = try - let json = Json.construct encoding value in - Json.destruct encoding json - with exn -> - let trace = Printexc.get_backtrace () in - Assert.fail_msg "%s %s\n%s" - (match msg with Some msg -> msg | None -> "no message") - (Printexc.to_string exn) - trace in - equal ?msg value result - -let test_simple_bin ?msg ?(equal=Assert.equal) encoding value = - let opt = try - let bin = Binary.to_bytes encoding value in - Binary.of_bytes encoding bin - with exn -> - let trace = Printexc.get_backtrace () in - Assert.fail_msg "%s %s\n%s" - (match msg with Some msg -> msg | None -> "no message") - (Printexc.to_string exn) - trace in - Assert.is_some ?msg opt; - let result = match opt with None -> assert false | Some v -> v in - equal ?msg value result - -let test_simple_of_bin ?msg ?(equal=Assert.equal) encoding value bin = - let opt = Binary.of_bytes encoding bin in - equal ?msg value opt - -let test_json_exn ?msg encoding value fail = - let get_result () = - let bin = Json.construct encoding value in - Json.destruct encoding bin in - Assert.test_fail ?msg get_result fail - -let test_bin_exn ?msg encoding value fail = - let get_result () = - let bin = Binary.to_bytes encoding value in - Binary.of_bytes encoding bin in - Assert.test_fail ?msg get_result fail - -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) ; - test_bin_exn ~msg:(msg ^ ": json") enc value (fun _ -> true) - -let test_simple_int ~msg encoding i = - let range_min = - (1 lsl (i-1)) in - let range_max = (1 lsl (i-1)) - 1 in - let out_max = (1 lsl (i-1)) in - let out_min = - (1 lsl (i-1)) - 1 in - test_simple ~msg encoding range_min ; - test_simple ~msg encoding range_max ; - test_simple_exn ~msg encoding out_max ; - test_simple_exn ~msg encoding out_min - -let test_simple_uint ~msg encoding i = - let range_min = 0 in - let range_max = (1 lsl i) - 1 in - let out_max = 1 lsl i in - let out_min = - 1 in - test_simple ~msg encoding range_min ; - test_simple ~msg encoding range_max ; - test_simple_exn ~msg encoding out_max ; - test_simple_exn ~msg encoding out_min - -let test_simple_values _ = - test_simple ~msg:__LOC__ null (); - test_simple ~msg:__LOC__ empty (); - test_simple ~msg:__LOC__ (constant "toto") (); - test_simple_int ~msg:__LOC__ int8 8; - test_simple_uint ~msg:__LOC__ uint8 8; - test_simple_int ~msg:__LOC__ int16 16; - test_simple_uint ~msg:__LOC__ uint16 16; - test_simple_int ~msg:__LOC__ int31 31; - test_simple ~msg:__LOC__ int32 Int32.min_int; - test_simple ~msg:__LOC__ int32 Int32.max_int; - test_simple ~msg:__LOC__ int64 Int64.min_int; - test_simple ~msg:__LOC__ int64 Int64.max_int; - test_simple ~msg:__LOC__ (ranged_int 100 400) 399; - test_simple ~msg:__LOC__ (ranged_int 19000 19254) 19000; - test_simple ~msg:__LOC__ (ranged_int 19000 19254) 19254; - test_simple ~msg:__LOC__ (ranged_int ~-100 300) 200; - test_simple ~msg:__LOC__ (ranged_int ~-300_000_000 300_000_000) 200; - test_simple ~msg:__LOC__ (ranged_int ~-300_000_000 300_000_000) 200_000_000; - test_simple ~msg:__LOC__ (ranged_float 100. 200.) 150.; - test_simple ~msg:__LOC__ (ranged_float ~-.100. 200.) ~-.75.; - test_simple ~msg:__LOC__ bool true; - test_simple ~msg:__LOC__ bool false; - 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 = - ["one", 1; "two", 2; "three", 3; "four", 4; "five", 6; "six", 6] in - test_simple_bin ~msg:__LOC__ (string_enum enum_enc) 4; - test_json_exn ~msg:__LOC__ (string_enum enum_enc) 7 is_invalid_arg ; - test_bin_exn ~msg:__LOC__ (string_enum enum_enc) 7 - (function - | No_case_matched -> true - | _ -> false) -(* Should fail *) -(* test_bin_exn ~msg:__LOC__ (string_enum ["a", 1; "a", 2]) 2 (...duplicatate...); *) -(* test_json_exn ~msg:__LOC__ (string_enum ["a", 1; "a", 2]) 1 (... duplicate...); *) - -let test_zarith _ = - let test i = test_simple ~msg:("failed on Z number " ^ Z.to_string i) z i in - let test_of_bin bin exp name = test_simple_of_bin ~msg:("failed on " ^ name) z exp (MBytes.of_string bin) in - for i = -1_00_000 to 1_00_000 do test (Z.of_int i) done ; - for i = 100_000_000 to 100_100_000 do test (Z.of_int i) done ; - for i = -100_000_000 downto -100_100_000 do test (Z.of_int i) done ; - let rec fact n l = - if n > 1 then - let l = Z.mul l (Z.of_int n) in - test l ; - fact (n - 1) l in - fact 35 Z.one ; - test (Z.of_string "123574503164821730218493275982143254986574985328") ; - test (Z.of_string "8493275982143254986574985328") ; - test (Z.of_string "123574503164821730218474985328") ; - test (Z.of_string "10000000000100000000001000003050000000060600000000000777000008") ; - test (Z.of_string "-123574503164821730218493275982143254986574985328") ; - test (Z.of_string "-8493275982143254986574985328") ; - test (Z.of_string "-123574503164821730218474985328") ; - test (Z.of_string "-10000000000100000000001000003050000000060600000000000777000008") ; - test_of_bin "\x03" (Some (Z.of_int 3)) "3 (size OK)" ; - test_of_bin "\x83" None "3 (size + 1, truncated)" ; - test_of_bin "\x83\x00" None "3 (size + 1)" ; - test_of_bin "\x83\x80\x00" None "3 (size + 2)" ; - -type t = A of int | B of string | C of int | D of string | E - -let prn_t = function - | A i -> Printf.sprintf "A %d" i - | B s -> Printf.sprintf "B %s" s - | C i -> Printf.sprintf "C %d" i - | D s -> Printf.sprintf "D %s" s - | E -> "E" - -let test_tag_errors _ = - let duplicate_tag () = - union [ - case (Tag 1) - int8 - (fun i -> i) - (fun i -> Some i) ; - case (Tag 1) - int8 - (fun i -> i) - (fun i -> Some i)] in - Assert.test_fail ~msg:__LOC__ duplicate_tag - (function Duplicated_tag _ -> true - | _ -> false) ; - let invalid_tag () = - union [ - case (Tag (2 lsl 7)) - int8 - (fun i -> i) - (fun i -> Some i)] in - Assert.test_fail ~msg:__LOC__ invalid_tag - (function (Invalid_tag (_, `Uint8)) -> true - | _ -> false) - -let test_union _ = - let enc = - (union [ - case (Tag 1) - int8 - (function A i -> Some i | _ -> None) - (fun i -> A i) ; - case (Tag 2) - string - (function B s -> Some s | _ -> None) - (fun s -> B s) ; - case (Tag 3) - int8 - (function C i -> Some i | _ -> None) - (fun i -> C i) ; - case (Tag 4) - (obj2 - (req "kind" (constant "D")) - (req "data" (string))) - (function D s -> Some ((), s) | _ -> None) - (fun ((), s) -> D s) ; - ]) in - let jsonA = Json.construct enc (A 1) in - let jsonB = Json.construct enc (B "2") in - let jsonC = Json.construct enc (C 3) in - let jsonD = Json.construct enc (D "4") in - Assert.test_fail - ~msg:__LOC__ (fun () -> Json.construct enc E) is_invalid_arg ; - Assert.equal ~prn:prn_t ~msg:__LOC__ (A 1) (Json.destruct enc jsonA) ; - Assert.equal ~prn:prn_t ~msg:__LOC__ (B "2") (Json.destruct enc jsonB) ; - Assert.equal ~prn:prn_t ~msg:__LOC__ (A 3) (Json.destruct enc jsonC) ; - Assert.equal ~prn:prn_t ~msg:__LOC__ (D "4") (Json.destruct enc jsonD) ; - let binA = Binary.to_bytes enc (A 1) in - let binB = Binary.to_bytes enc (B "2") in - let binC = Binary.to_bytes enc (C 3) in - let binD = Binary.to_bytes enc (D "4") in - Assert.test_fail ~msg:__LOC__ (fun () -> Binary.to_bytes enc E) - (function - | No_case_matched -> true - | _ -> false) ; - let get_result ~msg bin = - match Binary.of_bytes enc bin with - | None -> Assert.fail_msg "%s" msg - | Some bin -> bin in - Assert.equal ~prn:prn_t ~msg:__LOC__ (A 1) (get_result ~msg:__LOC__ binA) ; - Assert.equal ~prn:prn_t ~msg:__LOC__ (B "2") (get_result ~msg:__LOC__ binB) ; - Assert.equal ~prn:prn_t ~msg:__LOC__ (C 3) (get_result ~msg:__LOC__ binC) ; - Assert.equal ~prn:prn_t ~msg:__LOC__ (D "4") (get_result ~msg:__LOC__ binD) - - -type s = { field : int } - -let test_splitted _ = - let s_enc = - def "s" @@ - describe - ~title:"testsuite encoding test" - ~description: "A human readable description" @@ - conv - (fun s -> string_of_int s.field) - (fun s -> { field = int_of_string s }) - string in - let enc = - (splitted - ~binary:string - ~json: - (union [ - case (Tag 1) - string - (fun _ -> None) - (fun s -> s) ; - case (Tag 2) - s_enc - (fun s -> Some { field = int_of_string s }) - (fun s -> string_of_int s.field) ; - ])) in - let get_result ~msg bin = - match Binary.of_bytes enc bin with - | None -> Assert.fail_msg "%s: Cannot parse." msg - | Some bin -> bin in - let jsonA = Json.construct enc "41" in - let jsonB = Json.construct s_enc {field = 42} in - let binA = Binary.to_bytes enc "43" in - let binB = Binary.to_bytes s_enc {field = 44} in - Assert.equal ~msg:__LOC__ "41" (Json.destruct enc jsonA); - Assert.equal ~msg:__LOC__ "42" (Json.destruct enc jsonB); - Assert.equal ~msg:__LOC__ "43" (get_result ~msg:__LOC__ binA); - Assert.equal ~msg:__LOC__ "44" (get_result ~msg:__LOC__ binB) - -let test_wrapped_binary _ = - let open Data_encoding in - let enc = union [ - case (Tag 0) - (obj1 (req "ok" string)) - (function Ok x -> Some x | _ -> None) - (fun x -> Ok x) ; - case (Tag 1) - (obj1 (req "error" string)) - (function Error x -> Some x | _ -> None) - (fun x -> Error x) ; - ] in - let data = (Ok "") in - let encoded = Data_encoding.Binary.to_bytes enc data in - let decoded = Data_encoding.Binary.of_bytes_exn enc encoded in - Assert.equal data decoded - -let test_out_of_range () = - let assert_exception ~msg enc x = - begin try - ignore (Data_encoding.Json.construct enc x : Data_encoding.json) ; - Assert.fail_msg "%s: json" msg - with Invalid_argument _ -> () - end ; - begin - try - ignore (Data_encoding.Binary.to_bytes enc x) ; - Assert.fail_msg "%s: binary" msg - with Invalid_argument _ -> () - end in - let enc_int = Data_encoding.ranged_int ~-30 100 in - let enc_float = Data_encoding.ranged_float ~-.30. 100. in - assert_exception ~msg: __LOC__ enc_int 101 ; - assert_exception ~msg: __LOC__ enc_int ~-32 ; - assert_exception ~msg: __LOC__ enc_float ~-.31. ; - assert_exception ~msg: __LOC__ enc_float 101. - -let test_string_enum_boundary _ = - let open Data_encoding in - let entries = List.rev_map (fun x -> string_of_int x, x) (0 -- 254) in - let run_test cases = - List.iter (fun (_, num) -> - let enc = string_enum cases in - let encoded = Data_encoding.Binary.to_bytes enc num in - let decoded = Data_encoding.Binary.of_bytes_exn enc encoded in - Assert.equal num decoded) cases in - run_test entries ; - let entries2 = (("255", 255) :: entries) in - run_test entries2 ; - run_test (("256", 256) :: entries2) - -(** Generate encodings of the encoding and the randomized generator *) -let test_generator ?(iterations=50) encoding generator = - for _ = 0 to iterations - 1 do - let encode = generator () in - let bytes = Data_encoding.Binary.to_bytes encoding encode in - let decode = Data_encoding.Binary.of_bytes_exn encoding bytes in - Assert.equal encode decode - done - -let rec make_int_list acc len () = - if len = 0 - then acc - else make_int_list (Random.int64 Int64.max_int :: acc) (len - 1) () - -let test_randomized_int_list _ = - test_generator Data_encoding.(list int64) (make_int_list [] 100) - -let test_randomized_string_list _ = - test_generator (list string) (fun () -> List.map Int64.to_string (make_int_list [] 100 ())) - -let test_randomized_variant_list _ = - test_generator (list (result (option string) string)) - (fun () -> - List.map - (fun x -> - let str = Int64.to_string x in - if Random.bool () - then if Random.bool () then Ok (Some str) else Ok None - else Error str) - (make_int_list [] 100 ())) - -let tests = [ - "zarith", `Quick, test_zarith ; - "simple", `Quick, test_simple_values ; - "union", `Quick, test_union ; - "splitted", `Quick, test_splitted ; - "tags", `Quick, test_tag_errors ; - "wrapped_binary", `Quick, test_wrapped_binary ; - "out_of_range", `Quick, test_out_of_range ; - "string_enum_boundary", `Quick, test_string_enum_boundary ; - "randomized_int_list", `Quick, test_randomized_int_list ; - "randomized_string_list", `Quick, test_randomized_string_list ; - "randomized_variant_list", `Quick, test_randomized_variant_list ; -] - diff --git a/src/lib_data_encoding/test/test_stream_data_encoding.ml b/src/lib_data_encoding/test/test_stream_data_encoding.ml deleted file mode 100644 index 45a9c7de4..000000000 --- a/src/lib_data_encoding/test/test_stream_data_encoding.ml +++ /dev/null @@ -1,460 +0,0 @@ -(**************************************************************************) -(* *) -(* Copyright (c) 2014 - 2018. *) -(* Dynamic Ledger Solutions, Inc. *) -(* *) -(* All rights reserved. No warranty, explicit or implicit, provided. *) -(* *) -(**************************************************************************) - -open Data_encoding - -let is_invalid_arg = function - | Invalid_argument _ -> true - | _ -> false - -let is_await = function Binary.Await _ -> true | _ -> false -let is_success = function Binary.Success _ -> true | _ -> false -let is_error = function Binary.Error -> true | _ -> false - - -let rec fold_left_pending f accu l = - match l with - | [] -> accu - | a::l -> fold_left_pending f (f accu a l) l - -let test_read_simple_bin_ko_invalid_data - ?(not_equal=Assert.not_equal) encoding value = - let len_data = MBytes.length (Binary.to_bytes encoding value) in - if classify encoding != `Variable && len_data > 0 then - for sz = 1 to len_data do - let l = MBytes.cut sz (Binary.to_bytes encoding value) in - List.iter (fun b -> - for i = 0 to MBytes.length b - 1 do - (* alter data *) - MBytes.set_int8 b i ((MBytes.get_int8 b i)+1) - done - )l; - ignore( - fold_left_pending - (fun _done e _todo -> - let _done = e :: _done in - begin - let status = - Binary.read_stream_of_bytes ~init:(List.rev _done) encoding in - let status = - List.fold_left - (fun status mbyte -> - match status with - | Binary.Await f -> f mbyte - | _ -> status - )status _todo - in - match status with - | Binary.Await _ -> () - | Binary.Error -> () - | Binary.Success {res; remaining} -> - (* should not have "Success" *) - Assert.equal ~msg:__LOC__ remaining []; - not_equal value res - end; - _done - )[] l - ) - done - -let unexpected loc = - loc ^ ": This case should not happen" - -let test_read_simple_bin_ko_await encoding value = - let len_data = MBytes.length (Binary.to_bytes encoding value) in - if classify encoding != `Variable && len_data > 0 then - for sz = 1 to len_data do - let l = MBytes.cut sz (Binary.to_bytes encoding value) in - match List.rev l with - | [] -> Assert.fail_msg "%s" (unexpected __LOC__) - | _ :: r -> - let l = List.rev r in (* last mbyte removed !! *) - ignore( - fold_left_pending - (fun _done e _todo -> - let _done = e :: _done in - begin - let status= - Binary.read_stream_of_bytes - ~init:(List.rev _done) encoding in - let status = - List.fold_left - (fun status mbyte -> - if not (is_await status) then - Assert.fail_msg "%s" (unexpected __LOC__); - match status with - | Binary.Await f -> f mbyte - | _ -> status - )status _todo - in - match status with - | Binary.Await _ -> () - | Binary.Error -> - if not (classify encoding == `Variable) then - Assert.fail_msg "%s" (unexpected __LOC__) - | Binary.Success _ -> - Assert.fail_msg "%s" (unexpected __LOC__) - end; - _done - )[] l - ) - done - -let test_read_simple_bin_ok ?msg ?(equal=Assert.equal) encoding value = - let len_data = max 1 (MBytes.length (Binary.to_bytes encoding value)) in - for sz = 1 to len_data do - ignore( - fold_left_pending - (fun _done e _todo -> - let _done = e :: _done in - begin - let status = - Binary.read_stream_of_bytes ~init:(List.rev _done) encoding in - let status = - List.fold_left - (fun status mbyte -> - if MBytes.length mbyte <> 0 && is_success status then - Assert.fail_msg "%s" (unexpected __LOC__); - match status with - | Binary.Await f -> f mbyte - | _ -> status - )status _todo - in - match status with - | Binary.Success {res; remaining} -> - Assert.equal ~msg:__LOC__ remaining []; - equal ?msg value res - | Binary.Await _ -> Assert.fail_msg "%s" (unexpected __LOC__) - | Binary.Error -> - if not (classify encoding == `Variable) then - Assert.fail_msg "%s" (unexpected __LOC__) - end; - _done - )[] (MBytes.cut sz (Binary.to_bytes encoding value)) - ) - done - -let test_check_simple_bin_ko_invalid_data - encoding value = - let len_data = MBytes.length (Binary.to_bytes encoding value) in - if classify encoding != `Variable && len_data > 0 then - for sz = 1 to len_data do - let l = MBytes.cut sz (Binary.to_bytes encoding value) in - List.iter (fun b -> - for i = 0 to MBytes.length b - 1 do - (* alter data *) - MBytes.set_int8 b i ((MBytes.get_int8 b i)+1) - done - )l; - ignore( - fold_left_pending - (fun _done e _todo -> - let _done = e :: _done in - begin - let status = - Binary.check_stream_of_bytes ~init:(List.rev _done) encoding in - let status = - List.fold_left - (fun status mbyte -> - match status with - | Binary.Await f -> f mbyte - | _ -> status - )status _todo - in - match status with - | Binary.Await _ -> () - | Binary.Error -> () - | Binary.Success { remaining } -> - Assert.equal ~msg:__LOC__ remaining []; - (* res is unit for check *) - end; - _done - )[] l - ) - done - -let test_check_simple_bin_ko_await encoding value = - let len_data = MBytes.length (Binary.to_bytes encoding value) in - if classify encoding != `Variable && len_data > 0 then - for sz = 1 to len_data do - let l = MBytes.cut sz (Binary.to_bytes encoding value) in - match List.rev l with - | [] -> Assert.fail_msg "%s" (unexpected __LOC__) - | _ :: r -> - let l = List.rev r in (* last mbyte removed !! *) - ignore( - fold_left_pending - (fun _done e _todo -> - let _done = e :: _done in - begin - let status= - Binary.check_stream_of_bytes - ~init:(List.rev _done) encoding in - let status = - List.fold_left - (fun status mbyte -> - if not (is_await status) then - Assert.fail_msg "%s" (unexpected __LOC__); - match status with - | Binary.Await f -> f mbyte - | _ -> status - )status _todo - in - match status with - | Binary.Await _ -> () - | Binary.Error -> - if not (classify encoding == `Variable) then - Assert.fail_msg "%s" (unexpected __LOC__) - | Binary.Success _ -> - Assert.fail_msg "%s" (unexpected __LOC__) - end; - _done - )[] l - ) - done - -let test_check_simple_bin_ok encoding value = - let len_data = max 1 (MBytes.length (Binary.to_bytes encoding value)) in - for sz = 1 to len_data do - ignore( - fold_left_pending - (fun _done e _todo -> - let _done = e :: _done in - begin - let status = - Binary.check_stream_of_bytes ~init:(List.rev _done) encoding in - let status = - List.fold_left - (fun status mbyte -> - if MBytes.length mbyte <> 0 && is_success status then - Assert.fail_msg "%s" (unexpected __LOC__); - match status with - | Binary.Await f -> f mbyte - | _ -> status - )status _todo - in - match status with - | Binary.Success { remaining } -> - Assert.equal ~msg:__LOC__ remaining []; - (* res is unit for check *) - | Binary.Await _ -> Assert.fail_msg "%s" (unexpected __LOC__) - | Binary.Error -> - if not (classify encoding == `Variable) then - Assert.fail_msg "%s" (unexpected __LOC__) - end; - _done - )[] (MBytes.cut sz (Binary.to_bytes encoding value)) - ) - done - -let test_simple - ~msg ?(equal=Assert.equal) ?(not_equal=Assert.not_equal) enc value - = - test_check_simple_bin_ok enc value; - test_check_simple_bin_ko_await enc value; - test_check_simple_bin_ko_invalid_data enc value; - - test_read_simple_bin_ok ~msg:(msg ^ ": binary-ok") ~equal enc value; - test_read_simple_bin_ko_await enc value; - test_read_simple_bin_ko_invalid_data - ~not_equal enc value - - - - -let test_simple_int ~msg encoding i = - let range_min = - (1 lsl (i-1)) in - let range_max = (1 lsl (i-1)) - 1 in - test_simple ~msg encoding range_min ; - test_simple ~msg encoding range_max - -let test_simple_uint ~msg encoding i = - let range_min = 0 in - let range_max = (1 lsl i) - 1 in - test_simple ~msg encoding range_min ; - test_simple ~msg encoding range_max - -let test_simple_values _ = - test_simple ~msg:__LOC__ null (); - test_simple ~msg:__LOC__ empty (); - test_simple ~msg:__LOC__ (constant "toto") (); - test_simple_int ~msg:__LOC__ int8 8; - test_simple_uint ~msg:__LOC__ uint8 8; - test_simple_int ~msg:__LOC__ int16 16; - test_simple_uint ~msg:__LOC__ uint16 16; - test_simple_int ~msg:__LOC__ int31 31; - test_simple ~msg:__LOC__ int32 Int32.min_int; - test_simple ~msg:__LOC__ int32 Int32.max_int; - test_simple ~msg:__LOC__ int64 Int64.min_int; - test_simple ~msg:__LOC__ int64 Int64.max_int; - test_simple ~msg:__LOC__ bool true; - test_simple ~msg:__LOC__ bool false; - 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 = - ["one", 1; "two", 2; "three", 3; "four", 4; "five", 6; "six", 6] in - test_simple ~msg:__LOC__ (string_enum enum_enc) 4; - - -type t = A of int | B of string | C of int | D of string | E - -let prn_t = function - | A i -> Printf.sprintf "A %d" i - | B s -> Printf.sprintf "B %s" s - | C i -> Printf.sprintf "C %d" i - | D s -> Printf.sprintf "D %s" s - | E -> "E" - -let test_union _ = - let enc = - (union [ - case (Tag 1) - int8 - (function A i -> Some i | _ -> None) - (fun i -> A i) ; - case (Tag 2) - string - (function B s -> Some s | _ -> None) - (fun s -> B s) ; - case (Tag 3) - int8 - (function C i -> Some i | _ -> None) - (fun i -> C i) ; - case (Tag 4) - (obj2 - (req "kind" (constant "D")) - (req "data" (string))) - (function D s -> Some ((), s) | _ -> None) - (fun ((), s) -> D s) ; - ]) in - let jsonA = Json.construct enc (A 1) in - let jsonB = Json.construct enc (B "2") in - let jsonC = Json.construct enc (C 3) in - let jsonD = Json.construct enc (D"4") in - Assert.test_fail - ~msg:__LOC__ (fun () -> Json.construct enc E) is_invalid_arg ; - Assert.equal ~prn:prn_t ~msg:__LOC__ (A 1) (Json.destruct enc jsonA) ; - Assert.equal ~prn:prn_t ~msg:__LOC__ (B "2") (Json.destruct enc jsonB) ; - Assert.equal ~prn:prn_t ~msg:__LOC__ (A 3) (Json.destruct enc jsonC) ; - Assert.equal ~prn:prn_t ~msg:__LOC__ (D "4") (Json.destruct enc jsonD) ; - let binA = MBytes.cut 1 @@ Binary.to_bytes enc (A 1) in - let binB = MBytes.cut 1 @@ Binary.to_bytes enc (B "2") in - let binC = MBytes.cut 1 @@ Binary.to_bytes enc (C 3) in - let binD = MBytes.cut 1 @@ Binary.to_bytes enc (D "4") in - Assert.test_fail ~msg:__LOC__ (fun () -> Binary.to_bytes enc E) - (function - | No_case_matched -> true - | _ -> false) ; - let get_result ~msg bin_l = - let status = Binary.read_stream_of_bytes enc in - let status = - List.fold_left - (fun status mbyte -> - match status with - | Binary.Await f -> f mbyte - | _ -> status - )status bin_l - in - match status with - | Binary.Error -> Assert.fail_msg "%s" msg - | Binary.Await _ -> Assert.fail_msg "%s" msg - | Binary.Success {res} -> res - in - Assert.equal ~prn:prn_t ~msg:__LOC__ (A 1) (get_result ~msg:__LOC__ binA) ; - Assert.equal ~prn:prn_t ~msg:__LOC__ (B "2") (get_result ~msg:__LOC__ binB) ; - Assert.equal ~prn:prn_t ~msg:__LOC__ (C 3) (get_result ~msg:__LOC__ binC) ; - Assert.equal ~prn:prn_t ~msg:__LOC__ (D "4") (get_result ~msg:__LOC__ binD) - -type s = { field : int } - -let test_splitted _ = - let s_enc = - def "s" @@ - describe - ~title:"testsuite encoding test" - ~description: "A human readable description" @@ - conv - (fun s -> string_of_int s.field) - (fun s -> { field = int_of_string s }) - string in - let enc = - (splitted - ~binary:string - ~json: - (union [ - case (Tag 1) - string - (fun _ -> None) - (fun s -> s) ; - case (Tag 2) - s_enc - (fun s -> Some { field = int_of_string s }) - (fun s -> string_of_int s.field) ; - ])) in - let get_result ~msg bin_l = - let status = Binary.read_stream_of_bytes enc in - let status = - List.fold_left - (fun status mbyte -> - match status with - | Binary.Await f -> f mbyte - | _ -> status - )status bin_l - in - match status with - | Binary.Error -> Assert.fail_msg "%s" msg - | Binary.Await _ -> Assert.fail_msg "%s" msg - | Binary.Success {res} -> res - in - let jsonA = Json.construct enc "41" in - let jsonB = Json.construct s_enc {field = 42} in - let binA = MBytes.cut 1 @@ Binary.to_bytes enc "43" in - let binB = MBytes.cut 1 @@ Binary.to_bytes s_enc {field = 44} in - Assert.equal ~msg:__LOC__ "41" (Json.destruct enc jsonA); - Assert.equal ~msg:__LOC__ "42" (Json.destruct enc jsonB); - Assert.equal ~msg:__LOC__ "43" (get_result ~msg:__LOC__ binA); - Assert.equal ~msg:__LOC__ "44" (get_result ~msg:__LOC__ binB) - -let test_zarith value = - let msg = "failed on Z number " ^ Z.to_string value in - test_check_simple_bin_ok z value; - test_check_simple_bin_ko_await z value; - test_read_simple_bin_ok ~msg ~equal:Assert.equal z value; - test_read_simple_bin_ko_await z value - -let test_zarith _ = - for i = -1_00_000 to 1_00_000 do test_zarith (Z.of_int i) done ; - for i = 100_000_000 to 100_100_000 do test_zarith (Z.of_int i) done ; - for i = -100_000_000 downto -100_100_000 do test_zarith (Z.of_int i) done ; - test_zarith (Z.of_string "123574503164821730218493275982143254986574985328") ; - test_zarith (Z.of_string "8493275982143254986574985328") ; - test_zarith (Z.of_string "123574503164821730218474985328") ; - test_zarith (Z.of_string "10000000000100000000001000003050000000060600000000000777000008") ; - test_zarith (Z.of_string "-123574503164821730218493275982143254986574985328") ; - test_zarith (Z.of_string "-8493275982143254986574985328") ; - test_zarith (Z.of_string "-123574503164821730218474985328") ; - test_zarith (Z.of_string "-10000000000100000000001000003050000000060600000000000777000008") - -let tests = [ - "zarith", `Quick, test_zarith ; - "simple", `Quick, test_simple_values ; - "union", `Quick, test_union ; - "splitted", `Quick, test_splitted ; -] diff --git a/src/lib_data_encoding/test/types.ml b/src/lib_data_encoding/test/types.ml new file mode 100644 index 000000000..2ff4e01b6 --- /dev/null +++ b/src/lib_data_encoding/test/types.ml @@ -0,0 +1,198 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +open Data_encoding + +type record = { + a : int ; + b : bool ; + c : Z.t option ; + d : float ; +} + +let default_record = { a = 32 ; b = true ; c = Some Z.one ; d = 12.34 } + +let record_obj_enc = + conv + (fun { a ; b ; c ; d } -> ((a, b), (c, d))) + (fun ((a, b), (c, d)) -> { a ; b ; c ; d }) + (merge_objs + (obj2 + (req "a" int31) + (dft "b" bool false)) + (obj2 + (opt "c" z) + (req "d" float))) + +let record_tup_enc = + conv + (fun { a ; b ; c ; d } -> ((a, b, c), d)) + (fun ((a, b, c), d) -> { a ; b ; c ; d }) + (merge_tups + (tup3 int31 bool (option z)) + (tup1 float)) + +let record_to_string { a ; b ; c ; d } = + let c = + match c with + | None -> "none" + | Some c -> Z.to_string c in + Format.asprintf "(%d, %B, %s, %f)" a b c d + +type variable_record = { + p : int ; + q : MBytes.t ; +} + +let default_variable_record = { p = 23 ; q = MBytes.of_string "wwwxxyyzzz" } + +let variable_record_obj_enc = + conv + (fun { p ; q } -> (p, q)) + (fun (p, q) -> { p ; q }) + (obj2 + (req "p" int31) + (req "q" Variable.bytes)) + +let variable_record_tup_enc = + conv + (fun { p ; q } -> (p, q)) + (fun (p, q) -> { p ; q }) + (tup2 int31 Variable.bytes) + +let variable_record_to_string { p ; q } = + Format.asprintf "(%d, %a)" p MBytes.pp_hex q + +type variable_left_record = { + x : int ; + y : MBytes.t ; + z : int ; +} + +let default_variable_left_record = + { x = 98 ; y = MBytes.of_string "765" ; z = 4321 } + +let variable_left_record_obj_enc = + conv + (fun { x ; y ; z } -> (x, y, z)) + (fun (x, y, z) -> { x ; y ; z }) + (obj3 + (req "x" int31) + (req "y" Variable.bytes) + (req "z" int31)) + +let variable_left_record_tup_enc = + conv + (fun { x ; y ; z } -> (x, y, z)) + (fun (x, y, z) -> { x ; y ; z }) + (tup3 int31 Variable.bytes int31) + +let variable_left_record_to_string { x ; y ; z } = + Format.asprintf "(%d, %a, %d)" x MBytes.pp_hex y z + +type union = A of int | B of string | C of int | D of string | E + +let union_enc = + union [ + case (Tag 1) + int8 + (function A i -> Some i | _ -> None) + (fun i -> A i) ; + case (Tag 2) + string + (function B s -> Some s | _ -> None) + (fun s -> B s) ; + case (Tag 3) + (obj1 (req "C" int8)) + (function C i -> Some i | _ -> None) + (fun i -> C i) ; + case (Tag 4) + (obj2 + (req "kind" (constant "D")) + (req "data" (string))) + (function D s -> Some ((), s) | _ -> None) + (fun ((), s) -> D s) ; + case (Tag 5) + empty + (function E -> Some () | _ -> None) + (fun () -> E) ; + ] + +let mini_union_enc = + union [ + case (Tag 1) + int8 + (function A i -> Some i | _ -> None) + (fun i -> A i) ; + ] + +let union_to_string = function + | A i -> Printf.sprintf "A %d" i + | B s -> Printf.sprintf "B %s" s + | C i -> Printf.sprintf "C %d" i + | D s -> Printf.sprintf "D %s" s + | E -> "E" + +let enum_enc = + string_enum + [ "one", 1 ; "two", 2 ; "three", 3 ; "four", 4 ; "five", 5 ; "six", 6 ] + +let mini_enum_enc = + string_enum + [ "one", 1 ; "two", 2 ] + +let mu_list_enc enc = + mu "list" @@ fun mu_list_enc -> + union [ + case (Tag 0) + empty + (function [] -> Some () | _ :: _ -> None) + (fun () -> []) ; + case (Tag 1) + (obj2 + (req "value" enc) + (req "next" mu_list_enc)) + (function x :: xs -> Some (x, xs) | [] -> None) + (fun (x, xs) -> x :: xs) ; + ] + +module Alcotest = struct + include Alcotest + let float = + testable + Fmt.float + (fun f1 f2 -> + match classify_float f1, classify_float f2 with + | FP_nan, FP_nan -> true + | _ -> f1 = f2) + let bytes = + testable + (Fmt.of_to_string (fun s -> let `Hex s = MBytes.to_hex s in s)) + MBytes.equal + let z = + testable + (Fmt.of_to_string Z.to_string) + Z.equal + let record = + testable + (Fmt.of_to_string record_to_string) + (=) + let variable_record = + testable + (Fmt.of_to_string variable_record_to_string) + (=) + let variable_left_record = + testable + (Fmt.of_to_string variable_left_record_to_string) + (=) + let union = + testable + (Fmt.of_to_string union_to_string) + (=) +end diff --git a/src/lib_data_encoding/test/write_failure.ml b/src/lib_data_encoding/test/write_failure.ml new file mode 100644 index 000000000..0d0b2197f --- /dev/null +++ b/src/lib_data_encoding/test/write_failure.ml @@ -0,0 +1,64 @@ +(**************************************************************************) +(* *) +(* Copyright (c) 2014 - 2018. *) +(* Dynamic Ledger Solutions, Inc. *) +(* *) +(* All rights reserved. No warranty, explicit or implicit, provided. *) +(* *) +(**************************************************************************) + +(** Test expected errors while serializing data. *) + +open Data_encoding +open Types + +let check_raises expected f = + match f () with + | exception exn when expected exn -> () + | exception exn -> + Alcotest.failf "Unexpected exception: %s." (Printexc.to_string exn) + | _ -> Alcotest.failf "Expecting exception, got success." + +let json ?(expected = fun _ -> true) encoding value () = + check_raises expected begin fun () -> + ignore (Json.construct encoding value : Json.t) ; + end + +let bson ?(expected = fun _ -> true) encoding value () = + check_raises expected begin fun () -> + ignore (Bson.construct encoding value : Bson.t) ; + end + +let binary ?(expected = fun _ -> true) encoding value () = + check_raises expected begin fun () -> + ignore (Binary.to_bytes encoding value : MBytes.t) ; + end + +let all name encoding value = + [ name ^ ".json", `Quick, json encoding value ; + name ^ ".bson", `Quick, bson encoding value ; + name ^ ".bytes", `Quick, binary encoding value ] + +let all_ranged_int minimum maximum = + let encoding = ranged_int minimum maximum in + let name = Format.asprintf "ranged_int.%d" minimum in + all (name ^ ".min") encoding (minimum - 1) @ + all (name ^ ".max") encoding (maximum + 1) + +let all_ranged_float minimum maximum = + let encoding = ranged_float minimum maximum in + let name = Format.asprintf "ranged_float.%f" minimum in + all (name ^ ".min") encoding (minimum -. 1.) @ + all (name ^ ".max") encoding (maximum +. 1.) + +let tests = + all_ranged_int 100 400 @ + all_ranged_int 19000 19254 @ + all_ranged_int ~-100 300 @ + all_ranged_int ~-300_000_000 300_000_000 @ + all_ranged_float ~-. 100. 300. @ + all "string.fixed" (Fixed.string 4) "turlututu" @ + all "bytes.fixed" (Fixed.bytes 4) (MBytes.of_string "turlututu") @ + all "unknown_case.B" mini_union_enc (B "2") @ + all "unknown_case.E" mini_union_enc E @ + []