From dd0e23cea24e1e91fdf0248b3fe2a117a483787f Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Fri, 5 Jan 2024 21:47:25 -0500 Subject: [PATCH] add tests for pvec --- tests/pvec/dune | 7 ++ tests/pvec/t.ml | 1 + tests/pvec/t_pvec.ml | 246 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 254 insertions(+) create mode 100644 tests/pvec/dune create mode 100644 tests/pvec/t.ml create mode 100644 tests/pvec/t_pvec.ml diff --git a/tests/pvec/dune b/tests/pvec/dune new file mode 100644 index 00000000..d4d56f95 --- /dev/null +++ b/tests/pvec/dune @@ -0,0 +1,7 @@ + +(test + (name t) + (flags :standard -strict-sequence -warn-error -a+8) + (modes (best exe)) + (package containers) + (libraries containers containers.pvec containers_testlib iter)) diff --git a/tests/pvec/t.ml b/tests/pvec/t.ml new file mode 100644 index 00000000..948befc1 --- /dev/null +++ b/tests/pvec/t.ml @@ -0,0 +1 @@ +Containers_testlib.run_all ~descr:"containers.pvec" [ T_pvec.Test.get () ] diff --git a/tests/pvec/t_pvec.ml b/tests/pvec/t_pvec.ml new file mode 100644 index 00000000..a82951ac --- /dev/null +++ b/tests/pvec/t_pvec.ml @@ -0,0 +1,246 @@ +module Test = (val Containers_testlib.make ~__FILE__ ()) +open Test +open Containers_pvec + +let spf = Printf.sprintf + +let _listuniq = + let g = Q.(small_list (pair small_int small_int)) in + Q.map_same_type + (fun l -> + CCList.sort_uniq ~cmp:(fun a b -> Stdlib.compare (fst a) (fst b)) l) + g +;; + +t @@ fun () -> is_empty empty;; +t @@ fun () -> not (is_empty (return 2));; +t @@ fun () -> length (return 2) = 1;; + +q ~name:"get over of_list" _listuniq (fun l -> + let m = of_list l in + List.for_all (fun (i, y) -> get m i = y) @@ List.mapi CCPair.make l) +;; + +(* regression test for #298 *) +t ~name:"reg 298" @@ fun () -> +let rec consume x = + match pop_opt x with + | None -> () + | Some (_, x) -> consume x +in +consume (of_list CCList.(1 -- 100)); +true +;; + +q ~name:"push length pop" + Q.(pair int (small_list int)) + (fun (x, l) -> + let q0 = of_list l in + let q = push q0 x in + assert_equal (length q) (length q0 + 1); + let y, q = pop q in + assert_equal x y; + assert_equal (to_list q) (to_list q0); + true) +;; + +q + Q.(pair (fun1 Observable.int bool) (small_list int)) + (fun (f, l) -> + let f = Q.Fn.apply f in + List.map f l = (of_list l |> map f |> to_list)) +;; + +q + Q.(pair (small_list int) (small_list int)) + (fun (l1, l2) -> l1 @ l2 = (append (of_list l1) (of_list l2) |> to_list)) +;; + +q Q.(small_list int) (fun l -> l = to_list (of_list l));; + +q _listuniq (fun l -> + List.sort Stdlib.compare l + = (l |> Iter.of_list |> of_iter |> to_iter |> Iter.to_list + |> List.sort Stdlib.compare)) +;; + +q _listuniq (fun l -> + List.sort Stdlib.compare l + = (l |> CCSeq.of_list |> of_seq |> to_seq |> CCSeq.to_list + |> List.sort Stdlib.compare)) +;; + +t @@ fun () -> choose empty = None;; +t @@ fun () -> choose (of_list [ 1, 1; 2, 2 ]) <> None + +module Ref_impl = struct + type +'a t = 'a list + + let empty : _ t = [] + let length = List.length + let push x l : _ t = l @ [ x ] + let get i l = List.nth l i + let to_list l = l + let to_seq = CCSeq.of_list + let add_list l l2 : _ t = List.append l l2 + + let pop_exn l = + match List.rev l with + | x :: tl -> x, List.rev tl + | [] -> invalid_arg "empty" + + let is_empty l = l = [] + + let choose l = + match l with + | [] -> None + | x :: _ -> Some x +end + +module Op = struct + type 'a t = + | Push of 'a + | Pop + (* TODO: set *) + | Add_list of 'a list + | Check_get of int + | Check_choose + | Check_is_empty + | Check_len + | Check_to_list + | Check_to_gen + + let well_formed ops : bool = + let rec loop size = function + | [] -> true + | Push _ :: tl -> loop (size + 1) tl + | Pop :: tl -> size >= 0 && loop (size - 1) tl + | Add_list l :: tl -> loop (size + List.length l) tl + | Check_get x :: tl -> x < size && loop size tl + | Check_choose :: tl + | Check_is_empty :: tl + | Check_len :: tl + | Check_to_list :: tl + | Check_to_gen :: tl -> + loop size tl + in + loop 0 ops + + let show show_x (self : _ t) : string = + match self with + | Push x -> spf "push %s" (show_x x) + | Pop -> "pop" + | Add_list l -> spf "add_list [%s]" (String.concat ";" @@ List.map show_x l) + | Check_get i -> spf "check_get %d" i + | Check_choose -> "check_choose" + | Check_is_empty -> "check_is_empty" + | Check_len -> "check_len" + | Check_to_list -> "check_to_list" + | Check_to_gen -> "check_to_gen" + + let shrink shrink_x (op : _ t) : _ Q.Iter.t = + let open Q.Shrink in + let open Q.Iter in + match op with + | Push x -> shrink_x x >|= fun x -> Push x + | Pop -> empty + | Add_list l -> list ~shrink:shrink_x l >|= fun x -> Add_list x + | Check_get _ | Check_choose | Check_is_empty | Check_len | Check_to_list + | Check_to_gen -> + empty + + let shrink_l shrink_x : _ t list Q.Shrink.t = + Q.Shrink.list ~shrink:(shrink shrink_x) |> Q.Shrink.filter well_formed + + type 'a op = 'a t + + (* generate list of length [n] *) + let gen (gen_x : 'a Q.Gen.t) n : 'a t list Q.Gen.t = + let open Q.Gen in + let rec loop size n : 'a op list Q.Gen.t = + if n = 0 then + return [] + else ( + let op = + frequency + @@ List.flatten + [ + [ + (3, gen_x >|= fun x -> Push x, size + 1); + 1, return (Check_choose, size); + 1, return (Check_is_empty, size); + 1, return (Check_to_list, size); + 1, return (Check_to_gen, size); + ]; + (if size > 0 then + [ + 1, return (Pop, size - 1); + (1, 0 -- (size - 1) >|= fun x -> Check_get x, size); + ] + else + []); + [ + ( 1, + small_list gen_x >|= fun l -> + Add_list l, size + List.length l ); + ]; + ] + in + + op >>= fun (op, size) -> + loop size (n - 1) >>= fun tl -> return (op :: tl) + ) + in + loop 0 n +end + +let arb_ops_int : int Op.t list Q.arbitrary = + Q.make + ~print:(fun o -> + spf "[%s]" @@ String.concat ";" @@ List.map (Op.show @@ spf "%d") o) + ~shrink:(Op.shrink_l Q.Shrink.int) + Q.Gen.(0 -- 40 >>= fun len -> Op.gen small_int len) + +let check_ops ~show_x (ops : 'a Op.t list) : unit = + let fail () = + Q.Test.fail_reportf "on list [%s]" + (String.concat ";" @@ List.map (Op.show show_x) ops) + in + let cur = ref empty in + let cur_ref = ref Ref_impl.empty in + List.iter + (fun (op : _ Op.t) -> + match op with + | Op.Push x -> + cur := push !cur x; + cur_ref := Ref_impl.push x !cur_ref + | Op.Pop -> + let x1, cur' = pop !cur in + cur := cur'; + let x2, cur_ref' = Ref_impl.pop_exn !cur_ref in + cur_ref := cur_ref'; + if x1 <> x2 then fail () + | Op.Add_list l -> + cur := add_list !cur l; + cur_ref := Ref_impl.add_list !cur_ref l + | Op.Check_get i -> if get !cur i <> Ref_impl.get i !cur_ref then fail () + | Op.Check_is_empty -> + if is_empty !cur <> Ref_impl.is_empty !cur_ref then fail () + | Op.Check_len -> if length !cur <> Ref_impl.length !cur_ref then fail () + | Op.Check_to_list -> + if to_list !cur <> Ref_impl.to_list !cur_ref then fail () + | Op.Check_choose -> + if choose !cur <> Ref_impl.choose !cur_ref then fail () + | Op.Check_to_gen -> + if + to_seq !cur |> CCSeq.to_list + <> (Ref_impl.to_seq !cur_ref |> CCSeq.to_list) + then + fail ()) + ops; + () + +let () = + q arb_ops_int (fun ops -> + check_ops ~show_x:(spf "%d") ops; + true)