mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-05 19:00:31 -05:00
154 lines
3.5 KiB
OCaml
154 lines
3.5 KiB
OCaml
module T = (val Containers_testlib.make ~__FILE__ ())
|
|
include T
|
|
open CCByte_buffer;;
|
|
|
|
t @@ fun () ->
|
|
let b = create () in
|
|
is_empty b
|
|
;;
|
|
|
|
t @@ fun () ->
|
|
let b = create ~cap:32 () in
|
|
is_empty b
|
|
;;
|
|
|
|
t @@ fun () ->
|
|
let b = create () in
|
|
length b = 0
|
|
;;
|
|
|
|
t @@ fun () ->
|
|
let b = create ~cap:32 () in
|
|
length b = 0
|
|
|
|
let test_count = 2_500
|
|
|
|
open QCheck
|
|
|
|
type op =
|
|
| Add_char of char
|
|
| Add_string of string
|
|
| Get_contents
|
|
| Get of int
|
|
| Clear
|
|
| Shrink_to of int
|
|
| Set of int * char
|
|
|
|
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"
|
|
| 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
|
|
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 | 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
|
|
| 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
|
|
| 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)
|
|
~shrink:Shrink.(filter is_valid @@ list ~shrink:shrink_op)
|
|
|
|
exception Nope of string
|
|
|
|
let prop_consistent ops =
|
|
let buf = ref "" in
|
|
let b = create ~cap:32 () in
|
|
|
|
let run_op op =
|
|
match op with
|
|
| Get i ->
|
|
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 = !buf in
|
|
let s2 = contents b in
|
|
if s1 <> s2 then raise (Nope (spf "s1=%S, s2=%S" s1 s2))
|
|
| 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
|
|
;;
|
|
|
|
q arb (fun ops -> prop_consistent ops)
|