mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 11:15:31 -05:00
add random test to CCByte_buffer
This commit is contained in:
parent
d7214345e5
commit
826381690c
2 changed files with 122 additions and 0 deletions
|
|
@ -17,6 +17,13 @@ let[@inline] length self = self.sz
|
||||||
let[@inline] is_empty self = self.sz = 0
|
let[@inline] is_empty self = self.sz = 0
|
||||||
let[@inline] clear self = self.sz <- 0
|
let[@inline] clear self = self.sz <- 0
|
||||||
|
|
||||||
|
(*$T
|
||||||
|
(let b = create() in is_empty b)
|
||||||
|
(let b = create ~cap:32 () in is_empty b)
|
||||||
|
(let b = create() in length b = 0)
|
||||||
|
(let b = create ~cap:32 () in length b = 0)
|
||||||
|
*)
|
||||||
|
|
||||||
let grow_cap_ self =
|
let grow_cap_ self =
|
||||||
min Sys.max_string_length
|
min Sys.max_string_length
|
||||||
(let n = capacity self in n + n lsl 1 + 5)
|
(let n = capacity self in n + n lsl 1 + 5)
|
||||||
|
|
@ -76,6 +83,9 @@ let[@inline] set self i c =
|
||||||
if i < 0 || i >= self.sz then invalid_arg "Byte_buf.set";
|
if i < 0 || i >= self.sz then invalid_arg "Byte_buf.set";
|
||||||
unsafe_set self i c
|
unsafe_set self i c
|
||||||
|
|
||||||
|
let[@inline] contents self = Bytes.sub_string self.bytes 0 self.sz
|
||||||
|
let[@inline] contents_bytes self = Bytes.sub self.bytes 0 self.sz
|
||||||
|
|
||||||
let[@inline] append_iter self i = i (add_char self)
|
let[@inline] append_iter self i = i (add_char self)
|
||||||
let[@inline] append_seq self seq = Seq.iter (add_char self) seq
|
let[@inline] append_seq self seq = Seq.iter (add_char self) seq
|
||||||
|
|
||||||
|
|
@ -112,3 +122,106 @@ let to_seq self =
|
||||||
else Seq.Cons (Bytes.unsafe_get bytes i, s (i+1))
|
else Seq.Cons (Bytes.unsafe_get bytes i, s (i+1))
|
||||||
in
|
in
|
||||||
s 0
|
s 0
|
||||||
|
|
||||||
|
(* TODO: unicode operators.*)
|
||||||
|
|
||||||
|
(*$inject
|
||||||
|
let test_count = 2_500
|
||||||
|
|
||||||
|
open QCheck
|
||||||
|
|
||||||
|
type op =
|
||||||
|
| Add_char of char
|
||||||
|
| Add_string of string
|
||||||
|
| Get_contents
|
||||||
|
| Get of int
|
||||||
|
| Clear
|
||||||
|
|
||||||
|
let spf = Printf.sprintf
|
||||||
|
|
||||||
|
let str_op = function
|
||||||
|
| Add_char c -> spf "add_char %C" c
|
||||||
|
| Add_string s -> spf "add_string %S" s
|
||||||
|
| Get_contents -> "contents"
|
||||||
|
| Get i -> spf "get %d" i
|
||||||
|
| Clear -> "clear"
|
||||||
|
|
||||||
|
let gen_op size : (_*_) Gen.t =
|
||||||
|
let open Gen in
|
||||||
|
let base = if size>0 then
|
||||||
|
[1, ((0--size) >|= fun x -> Get x, size);
|
||||||
|
]
|
||||||
|
else []
|
||||||
|
in
|
||||||
|
frequency (base @ [
|
||||||
|
1, return (Get_contents, size);
|
||||||
|
1, return (Clear, 0);
|
||||||
|
3, (printable >|= fun c -> Add_char c, size+1);
|
||||||
|
1, (string_size (0 -- 100) ~gen:printable >|= fun s ->
|
||||||
|
Add_string s, size+String.length s);
|
||||||
|
])
|
||||||
|
|
||||||
|
let rec gen_l acc sz n =
|
||||||
|
let open Gen in
|
||||||
|
if n=0 then return (List.rev acc)
|
||||||
|
else (
|
||||||
|
gen_op sz >>= fun (op, sz) ->
|
||||||
|
gen_l (op::acc) sz (n-1)
|
||||||
|
)
|
||||||
|
|
||||||
|
let gen : op list Gen.t = Gen.sized (gen_l [] 0)
|
||||||
|
|
||||||
|
let is_valid ops =
|
||||||
|
let rec loop sz = function
|
||||||
|
| [] -> true
|
||||||
|
| Add_char _ :: tl -> loop (sz+1) tl
|
||||||
|
| Clear :: tl -> loop 0 tl
|
||||||
|
| Add_string s :: tl -> loop (sz+String.length s) tl
|
||||||
|
| Get n :: tl -> n < sz && loop sz tl
|
||||||
|
| Get_contents :: tl -> loop sz tl
|
||||||
|
in loop 0 ops
|
||||||
|
|
||||||
|
let shrink_op = Iter.(function
|
||||||
|
| Get_contents | Clear -> empty
|
||||||
|
| Get n -> Shrink.int n >|= fun n->Get n
|
||||||
|
| Add_char c -> Shrink.char c >|= fun c -> Add_char c
|
||||||
|
| Add_string s -> Shrink.string s >|= fun s -> Add_string s
|
||||||
|
)
|
||||||
|
|
||||||
|
let arb = make gen ~print:(Print.list str_op)
|
||||||
|
~shrink:Shrink.(filter is_valid @@ list ~shrink:shrink_op)
|
||||||
|
|
||||||
|
exception Nope of string
|
||||||
|
let prop_consistent ops =
|
||||||
|
let buf = Buffer.create 32 in
|
||||||
|
let b = create ~cap:32 () in
|
||||||
|
|
||||||
|
let run_op op =
|
||||||
|
match op with
|
||||||
|
| Get i ->
|
||||||
|
assert (Buffer.length buf = length b);
|
||||||
|
let c1 = Buffer.nth buf i in
|
||||||
|
let c2 = get b i in
|
||||||
|
if c1<>c2 then raise (Nope (spf "c1=%C, c2=%C" c1 c2))
|
||||||
|
|
||||||
|
| Get_contents ->
|
||||||
|
let s1 = Buffer.contents buf in
|
||||||
|
let s2 = contents b in
|
||||||
|
if s1<>s2 then raise (Nope (spf "s1=%S, s2=%S" s1 s2))
|
||||||
|
|
||||||
|
| Add_char c -> Buffer.add_char buf c; add_char b c
|
||||||
|
| Add_string s -> Buffer.add_string buf s; append_string b s
|
||||||
|
| Clear -> Buffer.clear buf; clear b
|
||||||
|
|
||||||
|
in
|
||||||
|
|
||||||
|
assume (is_valid ops);
|
||||||
|
try List.iter run_op ops; true
|
||||||
|
with Nope str ->
|
||||||
|
Test.fail_reportf "consistent ops failed:\n%s" str;
|
||||||
|
false
|
||||||
|
*)
|
||||||
|
|
||||||
|
(*$Q
|
||||||
|
arb (fun ops -> prop_consistent ops)
|
||||||
|
*)
|
||||||
|
|
|
||||||
|
|
@ -15,6 +15,9 @@ val create : ?cap:int -> unit -> t
|
||||||
val length : t -> int
|
val length : t -> int
|
||||||
(** Current length. *)
|
(** Current length. *)
|
||||||
|
|
||||||
|
val is_empty : t -> bool
|
||||||
|
(** [is_empty b] is [length b=0] *)
|
||||||
|
|
||||||
val capacity : t -> int
|
val capacity : t -> int
|
||||||
(** Current capacity (size of the array returned by {!bytes}) *)
|
(** Current capacity (size of the array returned by {!bytes}) *)
|
||||||
|
|
||||||
|
|
@ -56,6 +59,12 @@ val set : t -> int -> char -> unit
|
||||||
|
|
||||||
val unsafe_set : t -> int -> char -> unit
|
val unsafe_set : t -> int -> char -> unit
|
||||||
|
|
||||||
|
val contents : t -> string
|
||||||
|
(** Copy the internal data to a string *)
|
||||||
|
|
||||||
|
val contents_bytes : t -> bytes
|
||||||
|
(** Copy the internal data to a byte buffer *)
|
||||||
|
|
||||||
val iter : (char -> unit) -> t -> unit
|
val iter : (char -> unit) -> t -> unit
|
||||||
|
|
||||||
val fold_left : ('a -> char -> 'a) -> 'a -> t -> 'a
|
val fold_left : ('a -> char -> 'a) -> 'a -> t -> 'a
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue