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)