Data_encoding: move cut_bytes into MBytes

This commit is contained in:
Grégoire Henry 2018-05-13 12:53:01 +02:00 committed by Benjamin Canou
parent cb28ca1cd5
commit 1f358b7f9a
7 changed files with 50 additions and 52 deletions

View File

@ -544,29 +544,6 @@ let to_bytes t v =
write_rec_buffer t v bytes ; write_rec_buffer t v bytes ;
MBytes_buffer.to_mbytes bytes MBytes_buffer.to_mbytes bytes
let to_bytes_list ?(copy_blocks=false) block_sz t v =
assert (block_sz > 0);
let bytes = to_bytes t v in (* call to generic function to_bytes *)
let length = MBytes.length bytes in
if length <= block_sz then
[bytes] (* if the result fits in the given block_sz *)
else
let may_copy = if copy_blocks then MBytes.copy else fun t -> t in
let nb_full = length / block_sz in (* nb of blocks of size block_sz *)
let sz_full = nb_full * block_sz in (* size of the full part *)
let acc = (* eventually init acc with a non-full block *)
if sz_full = length then []
else [may_copy (MBytes.sub bytes sz_full (length - sz_full))]
in
let rec split_full_blocks curr_upper_limit acc =
let start = curr_upper_limit - block_sz in
assert (start >= 0);
(* copy the block [ start, curr_upper_limit [ of size block_sz *)
let acc = (may_copy (MBytes.sub bytes start block_sz)) :: acc in
if start = 0 then acc else split_full_blocks start acc
in
split_full_blocks sz_full acc
(** Reader *) (** Reader *)
module Reader = struct module Reader = struct

View File

@ -16,6 +16,5 @@ val write : 'a Encoding.t -> 'a -> MBytes.t -> int -> int option
val to_bytes : 'a Encoding.t -> 'a -> MBytes.t val to_bytes : 'a Encoding.t -> 'a -> MBytes.t
val of_bytes : 'a Encoding.t -> MBytes.t -> 'a option val of_bytes : 'a Encoding.t -> MBytes.t -> 'a option
val of_bytes_exn : 'a Encoding.t -> MBytes.t -> 'a val of_bytes_exn : 'a Encoding.t -> MBytes.t -> 'a
val to_bytes_list : ?copy_blocks:bool -> int -> 'a Encoding.t -> 'a -> MBytes.t list
val fixed_length : 'a Encoding.t -> int option val fixed_length : 'a Encoding.t -> int option
val fixed_length_exn : 'a Encoding.t -> int val fixed_length_exn : 'a Encoding.t -> int

View File

@ -534,16 +534,6 @@ module Binary: sig
val of_bytes : 'a Encoding.t -> MBytes.t -> 'a option val of_bytes : 'a Encoding.t -> MBytes.t -> 'a option
val of_bytes_exn : 'a Encoding.t -> MBytes.t -> 'a val of_bytes_exn : 'a Encoding.t -> MBytes.t -> 'a
(** [to_bytes_list ?copy_blocks blocks_size encod data] encode the
given data as a list of successive blocks of length
'blocks_size' at most.
NB. If 'copy_blocks' is false (default), the blocks of the list
can be garbage-collected only when all the blocks are
unreachable (because of the 'optimized' implementation of
MBytes.sub used internally *)
val to_bytes_list : ?copy_blocks:bool -> int -> 'a Encoding.t -> 'a -> MBytes.t list
(** This type is used when decoding binary data incrementally. (** This type is used when decoding binary data incrementally.
- In case of 'Success', the decoded data, the size of used data - In case of 'Success', the decoded data, the size of used data
to decode the result, and the remaining data are returned to decode the result, and the remaining data are returned

View File

@ -28,7 +28,7 @@ let test_read_simple_bin_ko_invalid_data
let len_data = MBytes.length (Binary.to_bytes encoding value) in let len_data = MBytes.length (Binary.to_bytes encoding value) in
if classify encoding != `Variable && len_data > 0 then if classify encoding != `Variable && len_data > 0 then
for sz = 1 to len_data do for sz = 1 to len_data do
let l = (Binary.to_bytes_list sz encoding value) in let l = MBytes.cut sz (Binary.to_bytes encoding value) in
List.iter (fun b -> List.iter (fun b ->
for i = 0 to MBytes.length b - 1 do for i = 0 to MBytes.length b - 1 do
(* alter data *) (* alter data *)
@ -70,7 +70,7 @@ let test_read_simple_bin_ko_await encoding value =
let len_data = MBytes.length (Binary.to_bytes encoding value) in let len_data = MBytes.length (Binary.to_bytes encoding value) in
if classify encoding != `Variable && len_data > 0 then if classify encoding != `Variable && len_data > 0 then
for sz = 1 to len_data do for sz = 1 to len_data do
let l = Binary.to_bytes_list sz encoding value in let l = MBytes.cut sz (Binary.to_bytes encoding value) in
match List.rev l with match List.rev l with
| [] -> Assert.fail_msg "%s" (unexpected __LOC__) | [] -> Assert.fail_msg "%s" (unexpected __LOC__)
| _ :: r -> | _ :: r ->
@ -136,7 +136,7 @@ let test_read_simple_bin_ok ?msg ?(equal=Assert.equal) encoding value =
Assert.fail_msg "%s" (unexpected __LOC__) Assert.fail_msg "%s" (unexpected __LOC__)
end; end;
_done _done
)[] (Binary.to_bytes_list sz encoding value) )[] (MBytes.cut sz (Binary.to_bytes encoding value))
) )
done done
@ -145,7 +145,7 @@ let test_check_simple_bin_ko_invalid_data
let len_data = MBytes.length (Binary.to_bytes encoding value) in let len_data = MBytes.length (Binary.to_bytes encoding value) in
if classify encoding != `Variable && len_data > 0 then if classify encoding != `Variable && len_data > 0 then
for sz = 1 to len_data do for sz = 1 to len_data do
let l = (Binary.to_bytes_list sz encoding value) in let l = MBytes.cut sz (Binary.to_bytes encoding value) in
List.iter (fun b -> List.iter (fun b ->
for i = 0 to MBytes.length b - 1 do for i = 0 to MBytes.length b - 1 do
(* alter data *) (* alter data *)
@ -183,7 +183,7 @@ let test_check_simple_bin_ko_await encoding value =
let len_data = MBytes.length (Binary.to_bytes encoding value) in let len_data = MBytes.length (Binary.to_bytes encoding value) in
if classify encoding != `Variable && len_data > 0 then if classify encoding != `Variable && len_data > 0 then
for sz = 1 to len_data do for sz = 1 to len_data do
let l = Binary.to_bytes_list sz encoding value in let l = MBytes.cut sz (Binary.to_bytes encoding value) in
match List.rev l with match List.rev l with
| [] -> Assert.fail_msg "%s" (unexpected __LOC__) | [] -> Assert.fail_msg "%s" (unexpected __LOC__)
| _ :: r -> | _ :: r ->
@ -249,7 +249,7 @@ let test_check_simple_bin_ok encoding value =
Assert.fail_msg "%s" (unexpected __LOC__) Assert.fail_msg "%s" (unexpected __LOC__)
end; end;
_done _done
)[] (Binary.to_bytes_list sz encoding value) )[] (MBytes.cut sz (Binary.to_bytes encoding value))
) )
done done
@ -354,10 +354,10 @@ let test_union _ =
Assert.equal ~prn:prn_t ~msg:__LOC__ (B "2") (Json.destruct enc jsonB) ; 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__ (A 3) (Json.destruct enc jsonC) ;
Assert.equal ~prn:prn_t ~msg:__LOC__ (D "4") (Json.destruct enc jsonD) ; 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 binA = MBytes.cut 1 @@ Binary.to_bytes enc (A 1) in
let binB = Binary.to_bytes_list 1 enc (B "2") in let binB = MBytes.cut 1 @@ Binary.to_bytes enc (B "2") in
let binC = Binary.to_bytes_list 1 enc (C 3) in let binC = MBytes.cut 1 @@ Binary.to_bytes enc (C 3) in
let binD = Binary.to_bytes_list 1 enc (D "4") in let binD = MBytes.cut 1 @@ Binary.to_bytes enc (D "4") in
Assert.test_fail ~msg:__LOC__ (fun () -> Binary.to_bytes enc E) Assert.test_fail ~msg:__LOC__ (fun () -> Binary.to_bytes enc E)
(function (function
| No_case_matched -> true | No_case_matched -> true
@ -425,8 +425,8 @@ let test_splitted _ =
in in
let jsonA = Json.construct enc "41" in let jsonA = Json.construct enc "41" in
let jsonB = Json.construct s_enc {field = 42} in let jsonB = Json.construct s_enc {field = 42} in
let binA = Binary.to_bytes_list 1 enc "43" in let binA = MBytes.cut 1 @@ Binary.to_bytes enc "43" in
let binB = Binary.to_bytes_list 1 s_enc {field = 44} 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__ "41" (Json.destruct enc jsonA);
Assert.equal ~msg:__LOC__ "42" (Json.destruct enc jsonB); Assert.equal ~msg:__LOC__ "42" (Json.destruct enc jsonB);
Assert.equal ~msg:__LOC__ "43" (get_result ~msg:__LOC__ binA); Assert.equal ~msg:__LOC__ "43" (get_result ~msg:__LOC__ binA);

View File

@ -335,7 +335,9 @@ module Writer = struct
loop buf loop buf
let encode_message st msg = let encode_message st msg =
try ok (Data_encoding.Binary.to_bytes_list st.binary_chunks_size st.encoding msg) try ok (MBytes.cut
st.binary_chunks_size
(Data_encoding.Binary.to_bytes st.encoding msg))
with _ -> error P2p_errors.Encoding_error with _ -> error P2p_errors.Encoding_error
let rec worker_loop st = let rec worker_loop st =

View File

@ -12,11 +12,6 @@ include Bigstring
include EndianBigstring.BigEndian include EndianBigstring.BigEndian
module LE = EndianBigstring.LittleEndian module LE = EndianBigstring.LittleEndian
include Compare.Make(struct
type nonrec t = t
let compare = Pervasives.compare
end)
let make sz c = let make sz c =
let buf = create sz in let buf = create sz in
fill buf c ; fill buf c ;
@ -31,3 +26,29 @@ let of_hex hex =
let pp_hex ppf s = let pp_hex ppf s =
let `Hex hex = to_hex s in let `Hex hex = to_hex s in
Format.pp_print_string ppf hex Format.pp_print_string ppf hex
let cut ?(copy=false) sz bytes =
let length = length bytes in
if length <= sz then
[bytes] (* if the result fits in the given sz *)
else
let may_copy = if copy then Bigstring.copy else fun t -> t in
let nb_full = length / sz in (* nb of blocks of size sz *)
let sz_full = nb_full * sz in (* size of the full part *)
let acc = (* eventually init acc with a non-full block *)
if sz_full = length then []
else [may_copy (sub bytes sz_full (length - sz_full))]
in
let rec split_full_blocks curr_upper_limit acc =
let start = curr_upper_limit - sz in
assert (start >= 0);
(* copy the block [ start, curr_upper_limit [ of size sz *)
let acc = (may_copy (sub bytes start sz)) :: acc in
if start = 0 then acc else split_full_blocks start acc
in
split_full_blocks sz_full acc
include Compare.Make(struct
type nonrec t = t
let compare = Bigstring.compare
end)

View File

@ -22,3 +22,12 @@ val make : int -> char -> t
val of_hex : Hex.t -> t val of_hex : Hex.t -> t
val to_hex : t -> Hex.t val to_hex : t -> Hex.t
val pp_hex : Format.formatter -> t -> unit val pp_hex : Format.formatter -> t -> unit
(** [cut ?copy size bytes] cut [bytes] the in a list of successive
chunks of length [size] at most.
If [copy] is false (default), the blocks of the list
can be garbage-collected only when all the blocks are
unreachable (because of the 'optimized' implementation of
[sub] used internally. *)
val cut: ?copy:bool -> int -> t -> t list