balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Data_encoding: drop module Assert

Browse Source 
- drop the quick-and-dirty `Assert` introduced when we switched from
  `Kaputt` and use `Alcotest.check` instead.

- split tests in multiple files:
  - success.ml
  - write_failure.ml
  - read_failture.ml
  - invalid_encoding.ml
  - randomized.ml
This commit is contained in:
Grégoire Henry 2018-05-13 20:20:20 +02:00 committed by Benjamin Canou
parent a0cae2af57
commit b164dd6cc5
14 changed files with 788 additions and 884 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/lib_data_encoding/binary.ml
View File

@ -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 =

4
src/lib_data_encoding/binary_stream.ml
View File

@ -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))

3
src/lib_data_encoding/data_encoding.mli
View File

@ -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

43
src/lib_data_encoding/test/assert.ml
View File

@ -1,43 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

60
src/lib_data_encoding/test/helpers.ml Normal file
View File

@ -0,0 +1,60 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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)

25
src/lib_data_encoding/test/invalid_encoding.ml Normal file
View File

@ -0,0 +1,25 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 () -> ()) ]) ;
]

59
src/lib_data_encoding/test/randomized.ml Normal file
View File

@ -0,0 +1,59 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 ;
]

152
src/lib_data_encoding/test/read_failure.ml Normal file
View File

@ -0,0 +1,152 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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") ;
]

218
src/lib_data_encoding/test/success.ml Normal file
View File

@ -0,0 +1,218 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 "@[<v 2>%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 ;
]

7
src/lib_data_encoding/test/test.ml
View File

@ -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 ;
]

377
src/lib_data_encoding/test/test_data_encoding.ml
View File

@ -1,377 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 ;
]

460
src/lib_data_encoding/test/test_stream_data_encoding.ml
View File

@ -1,460 +0,0 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 ;
]

198
src/lib_data_encoding/test/types.ml Normal file
View File

@ -0,0 +1,198 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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

64
src/lib_data_encoding/test/write_failure.ml Normal file
View File

@ -0,0 +1,64 @@
(**************************************************************************)
(* *)
(* Copyright (c) 2014 - 2018. *)
(* Dynamic Ledger Solutions, Inc. <contact@tezos.com> *)
(* *)
(* 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 @
[]