add random test to CCByte_buffer

This commit is contained in:
Simon Cruanes 2022-02-08 12:58:16 -05:00
parent d7214345e5
commit 826381690c
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
2 changed files with 122 additions and 0 deletions

View file

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

View file

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