simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2025-12-05 19:00:31 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

improve test for CCByte_buffer

Browse source
This commit is contained in:
Simon Cruanes 2022-02-08 13:07:39 -05:00
parent 826381690c
commit c5d435848b
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
1 changed files with 28 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

39
src/core/CCByte_buffer.ml
View file

@ -136,6 +136,8 @@ let to_seq self =
| Get_contents
| Get of int
| Clear
| Shrink_to of int
| Set of int * char
let spf = Printf.sprintf
@ -145,11 +147,15 @@ let to_seq self =
| Get_contents -> "contents"
| Get i -> spf "get %d" i
| Clear -> "clear"
| Shrink_to n -> spf "shrink %d" n
| Set (i,c) -> spf "set %d %C" i c
let gen_op size : (_*_) Gen.t =
let open Gen in
let base = if size>0 then
[1, ((0--size) >|= fun x -> Get x, size);
1, ((0--size) >>= fun x -> printable >|= fun c -> Set (x,c), size);
1, ((0--size) >|= fun x -> Shrink_to x, x);
]
else []
in
@ -177,8 +183,9 @@ let to_seq self =
| 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 n | Set (n,_)) :: tl -> n < sz && loop sz tl
| Get_contents :: tl -> loop sz tl
| Shrink_to x :: tl -> x <= sz && loop x tl
in loop 0 ops
let shrink_op = Iter.(function
@ -186,6 +193,10 @@ let to_seq self =
| 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
| Shrink_to n -> Shrink.int n >|= fun n -> Shrink_to n
| Set (n,c) ->
(Shrink.int n >|= fun n-> Set(n,c)) <+>
(Shrink.char c >|= fun c-> Set(n,c))
)
let arb = make gen ~print:(Print.list str_op)
@ -193,33 +204,39 @@ let to_seq self =
exception Nope of string
let prop_consistent ops =
let buf = Buffer.create 32 in
let buf = ref "" 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
assert (String.length !buf = length b);
let c1 = (!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 s1 = !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
| Add_char c -> buf := !buf ^ String.make 1 c; add_char b c
| Add_string s -> buf := !buf ^ s; append_string b s
| Clear -> buf := ""; clear b
| Shrink_to n -> buf := String.sub !buf 0 n; shrink_to b n
| Set (n,c) ->
(
let b' = Bytes.of_string !buf in
Bytes.set b' n c;
buf := Bytes.unsafe_to_string b';
);
set b n c
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
Test.fail_reportf "consistent ops failed:\n%s" str
*)
(*$Q