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 ;
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 *)
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 of_bytes : 'a Encoding.t -> MBytes.t -> 'a option
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_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_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.
- In case of 'Success', the decoded data, the size of used data
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
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
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 *)
@ -70,7 +70,7 @@ 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
let l = MBytes.cut sz (Binary.to_bytes encoding value) in
match List.rev l with
| [] -> Assert.fail_msg "%s" (unexpected __LOC__)
| _ :: r ->
@ -136,7 +136,7 @@ let test_read_simple_bin_ok ?msg ?(equal=Assert.equal) encoding value =
Assert.fail_msg "%s" (unexpected __LOC__)
end;
_done
)[] (Binary.to_bytes_list sz encoding value)
)[] (MBytes.cut sz (Binary.to_bytes encoding value))
)
done
@ -145,7 +145,7 @@ let test_check_simple_bin_ko_invalid_data
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
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 *)
@ -183,7 +183,7 @@ 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
let l = MBytes.cut sz (Binary.to_bytes encoding value) in
match List.rev l with
| [] -> Assert.fail_msg "%s" (unexpected __LOC__)
| _ :: r ->
@ -249,7 +249,7 @@ let test_check_simple_bin_ok encoding value =
Assert.fail_msg "%s" (unexpected __LOC__)
end;
_done
)[] (Binary.to_bytes_list sz encoding value)
)[] (MBytes.cut sz (Binary.to_bytes encoding value))
)
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__ (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
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
@ -425,8 +425,8 @@ let test_splitted _ =
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
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);

View File

@ -335,7 +335,9 @@ module Writer = struct
loop buf
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
let rec worker_loop st =

View File

@ -12,11 +12,6 @@ include Bigstring
include EndianBigstring.BigEndian
module LE = EndianBigstring.LittleEndian
include Compare.Make(struct
type nonrec t = t
let compare = Pervasives.compare
end)
let make sz c =
let buf = create sz in
fill buf c ;
@ -31,3 +26,29 @@ let of_hex hex =
let pp_hex ppf s =
let `Hex hex = to_hex s in
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 to_hex : t -> Hex.t
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