mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
124 lines
3.3 KiB
OCaml
124 lines
3.3 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);;
|