ligo/test/utils/test_stream_data_encoding.ml

449 lines
15 KiB
OCaml
Raw Normal View History

open Data_encoding
let (>>=) = Lwt.bind
let (>|=) = Lwt.(>|=)
let (//) = Filename.concat
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
2017-11-13 17:29:28 +04:00
?(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 = (Binary.to_bytes_list sz 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"
2017-11-13 17:29:28 +04:00
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 = Binary.to_bytes_list sz encoding value in
match List.rev l with
| [] -> Assert.fail_msg "%s" (unexpected __LOC__)
2017-11-13 17:29:28 +04:00
| _ :: 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__)
2017-11-13 17:29:28 +04:00
| 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
)[] (Binary.to_bytes_list sz encoding value)
)
done
let test_check_simple_bin_ko_invalid_data
2017-11-13 17:29:28 +04:00
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 = (Binary.to_bytes_list sz 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 -> ()
2017-11-13 17:29:28 +04:00
| Binary.Success { remaining } ->
Assert.equal ~msg:__LOC__ remaining [];
(* res is unit for check *)
end;
_done
)[] l
)
done
2017-11-13 17:29:28 +04:00
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 = Binary.to_bytes_list sz encoding value in
match List.rev l with
| [] -> Assert.fail_msg "%s" (unexpected __LOC__)
2017-11-13 17:29:28 +04:00
| _ :: 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__)
2017-11-13 17:29:28 +04:00
| Binary.Success _ ->
Assert.fail_msg "%s" (unexpected __LOC__)
end;
_done
)[] l
)
done
2017-11-13 17:29:28 +04:00
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
2017-11-13 17:29:28 +04:00
| 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
)[] (Binary.to_bytes_list sz encoding value)
)
done
let test_simple
~msg ?(equal=Assert.equal) ?(not_equal=Assert.not_equal) enc value
=
2017-11-13 17:29:28 +04:00
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;
2017-11-13 17:29:28 +04:00
test_read_simple_bin_ko_await enc value;
test_read_simple_bin_ko_invalid_data
2017-11-13 17:29:28 +04:00
~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;
Lwt.return_unit
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 = Binary.to_bytes_list 1 enc (A 1) in
let binB = Binary.to_bytes_list 1 enc (B "2") in
let binC = Binary.to_bytes_list 1 enc (C 3) in
let binD = Binary.to_bytes_list 1 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) ;
Lwt.return_unit
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 = Binary.to_bytes_list 1 enc "43" in
let binB = Binary.to_bytes_list 1 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);
Lwt.return_unit
2017-10-27 23:08:10 +04:00
let wrap_test f base_dir =
f base_dir >>= fun result ->
return result
let tests = [
"simple", test_simple_values ;
"union", test_union ;
"splitted", test_splitted ;
]
let () =
Test.run "stream_data_encoding."
(List.map (fun (s, f) -> s, wrap_test f) tests)