testing frenzy

_oasis

@@ -48,6 +48,7 @@ Library "containers"
                     CCOrd, CCRandom, CCString, CCHashtbl, CCMap, CCFormat, CCIO,
                     Containers
   BuildDepends:     bytes
+  # BuildDepends:     bytes, bisect_ppx
 
 Library "containers_io"
   Path:             src/io
@@ -78,6 +79,7 @@ Library "containers_data"
                     CCMixset, CCHashconsedSet, CCGraph, CCHashSet, CCBitField,
                     CCHashTrie, CCBloom, CCWBTree, CCRAL
   BuildDepends:     bytes
+  # BuildDepends:     bytes, bisect_ppx
   FindlibParent:    containers
   FindlibName:      data
 

src/core/CCArray.ml

@@ -48,13 +48,13 @@ module type S = sig
 
   val length : _ t -> int
 
-  val fold : ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
+  val fold : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
 
-  val foldi : ('b -> int -> 'a -> 'b) -> 'b -> 'a t -> 'b
+  val foldi : ('a -> int -> 'b -> 'a) -> 'a -> 'b t -> 'a
-  (** fold left on array, with index *)
+  (** Fold left on array, with index *)
 
   val fold_while : ('a -> 'b -> 'a * [`Stop | `Continue]) -> 'a -> 'b t -> 'a
-  (** fold left on array until a stop condition via [('a, `Stop)] is
+  (** Fold left on array until a stop condition via [('a, `Stop)] is
       indicated by the accumulator
       @since 0.8 *)
 
@@ -74,11 +74,13 @@ module type S = sig
       that [f x = Some y], else it returns [None] *)
 
   val findi : (int -> 'a -> 'b option) -> 'a t -> 'b option
-  (** Like {!find}, but also pass the index to the predicate function. *)
+  (** Like {!find}, but also pass the index to the predicate function.
+      @since 0.3.4 *)
 
   val find_idx : ('a -> bool) -> 'a t -> (int * 'a) option
   (** [find p x] returns [Some (i,x)] where [x] is the [i]-th element of [l],
-    and [p x] holds. Otherwise returns [None] *)
+      and [p x] holds. Otherwise returns [None]
+      @since 0.3.4 *)
 
   val lookup : ?cmp:'a ord -> 'a -> 'a t -> int option
   (** Lookup the index of some value in a sorted array.

src/core/CCHeap.ml

@@ -283,6 +283,15 @@ module Make(E : PARTIAL_ORD) : S with type elt = E.t = struct
             Some x
     in next
 
+  (*$Q
+    Q.(list int) (fun l -> \
+      extract_list (H.of_list l) = extract_list (H.of_gen H.empty (CCList.to_gen l)))
+    Q.(list int) (fun l -> \
+      let h = H.of_list l in \
+      (H.to_gen h |> CCList.of_gen |> List.sort Pervasives.compare) \
+        = (H.to_list h |> List.sort Pervasives.compare))
+  *)
+
   let rec to_tree h () = match h with
     | E -> `Nil
     | N (_, x, l, r) -> `Node(x, [to_tree l; to_tree r])

src/core/CCIO.ml

@@ -147,6 +147,19 @@ let read_all_bytes ?(size=1024) ic = read_all_ ~op:Ret_bytes ~size ic
 
 let read_all ?(size=1024) ic = read_all_ ~op:Ret_string ~size ic
 
+(*$R
+  let s = String.make 200 'y' in
+  let s = Printf.sprintf "a\nb\n %s\nlast line\n" s in
+  OUnit.bracket_tmpfile ~prefix:"test_containers" ~mode:[Open_creat; Open_trunc]
+    (fun (name, oc) ->
+      output_string oc s;
+      flush oc;
+      let s' = with_in name read_all in
+      OUnit.assert_equal ~printer:(fun s->s) s s'
+    ) ()
+*)
+
+
 let with_out ?(mode=0o644) ?(flags=[Open_creat; Open_trunc; Open_text]) filename f =
   let oc = open_out_gen (Open_wronly::flags) mode filename in
   try
@@ -186,6 +199,35 @@ let rec write_lines oc g = match g () with
 let write_lines_l oc l =
   List.iter (write_line oc) l
 
+(* test {read,write}_lines. Need to concatenate the lists because some
+   strings in the random input might contain '\n' themselves *)
+
+(*$QR
+   Q.(list_of_size Gen.(0 -- 40) printable_string) (fun l ->
+     let l' = ref [] in
+     OUnit.bracket_tmpfile ~prefix:"test_containers" ~mode:[Open_creat; Open_trunc]
+      (fun (name, oc) ->
+        write_lines_l oc l;
+        flush oc;
+        l' := with_in name read_lines_l;
+      ) ();
+     String.concat "\n" l = String.concat "\n" !l'
+    )
+*)
+
+(*$QR
+   Q.(list_of_size Gen.(0 -- 40) printable_string) (fun l ->
+     let l' = ref [] in
+     OUnit.bracket_tmpfile ~prefix:"test_containers" ~mode:[Open_creat; Open_trunc]
+      (fun (name, oc) ->
+        write_lines oc (Gen.of_list l);
+        flush oc;
+        l' := with_in name (fun ic -> read_lines ic |> Gen.to_list);
+      ) ();
+     String.concat "\n" l = String.concat "\n" !l'
+    )
+*)
+
 let with_in_out ?(mode=0o644) ?(flags=[Open_creat]) filename f =
   let ic = open_in_gen (Open_rdonly::flags) mode filename in
   let oc = open_out_gen (Open_wronly::flags) mode filename in
@@ -269,6 +311,17 @@ module File = struct
       in cons_ (`Dir,d) tail
     else gen_singleton (`File, d)
 
+  (*$R
+    OUnit.assert_bool "walk categorizes files"
+      (File.walk "."
+        |> Gen.for_all
+          (function
+            | `File, f -> not (Sys.is_directory f)
+            | `Dir, f -> Sys.is_directory f
+          )
+      )
+   *)
+
   type walk_item = [`File | `Dir] * t
 
   let read_dir ?(recurse=false) d =

src/core/CCList.ml

@@ -106,6 +106,12 @@ let filter p l =
   in
   direct direct_depth_filter_ p l
 
+(*$= & ~printer:CCInt.to_string
+  500 (filter (fun x->x mod 2 = 0) (1 -- 1000) |> List.length)
+  50_000 (filter (fun x->x mod 2 = 0) (1 -- 100_000) |> List.length)
+  500_000 (filter (fun x->x mod 2 = 0) (1 -- 1_000_000) |> List.length)
+*)
+
 let fold_right f l acc =
   let rec direct i f l acc = match l with
     | [] -> acc
@@ -221,6 +227,13 @@ let diagonal l =
   in
   gen [] l
 
+(*$T
+  diagonal [] = []
+  diagonal [1] = []
+  diagonal [1;2] = [1,2]
+  diagonal [1;2;3] |> List.sort Pervasives.compare = [1, 2; 1, 3; 2, 3]
+*)
+
 let partition_map f l =
   let rec iter f l1 l2 l = match l with
   | [] -> List.rev l1, List.rev l2
@@ -250,7 +263,7 @@ let (>>=) l f = flat_map f l
 
 let (<$>) = map
 
-let pure f = [f]
+let pure = return
 
 let (<*>) funs l = product (fun f x -> f x) funs l
 
@@ -460,6 +473,15 @@ let filter_map f l =
     recurse acc' l'
   in recurse [] l
 
+(*$=
+  ["2"; "4"] \
+    (filter_map (fun x -> if x mod 2 = 0 then Some (string_of_int x) else None) \
+      [1;2;3;4;5])
+  [ "2"; "4"; "6" ] \
+    (filter_map (fun x -> if x mod 2 = 0 then Some (string_of_int x) else None) \
+      [ 1; 2; 3; 4; 5; 6 ])
+*)
+
 module Set = struct
   let mem ?(eq=(=)) x l =
     let rec search eq x l = match l with

src/core/CCOrd.ml

@@ -38,6 +38,16 @@ let equiv i j =
   else if i>0 then j>0
   else j=0
 
+(*$T
+  equiv 1 2
+  equiv ~-1 ~-10
+  equiv 0 0
+  equiv ~-1 ~-1
+  not (equiv 0 1)
+  not (equiv 1 ~-1)
+  not (equiv 1 0)
+*)
+
 let int_ (x:int) y = Pervasives.compare x y
 let string_ (x:string) y = Pervasives.compare x y
 let bool_ (x:bool) y = Pervasives.compare x y
@@ -56,6 +66,12 @@ let pair o_x o_y (x1,y1) (x2,y2) =
     then o_y y1 y2
     else c
 
+(*$T
+  pair int_ string_ (1, "b") (2, "a") < 0
+  pair int_ string_ (1, "b") (0, "a") > 0
+  pair int_ string_ (1, "b") (1, "b") = 0
+*)
+
 let triple o_x o_y o_z (x1,y1,z1) (x2,y2,z2) =
   let c = o_x x1 x2 in
   if c = 0
@@ -76,6 +92,17 @@ let rec list_ ord l1 l2 = match l1, l2 with
         then list_ ord l1' l2'
         else c
 
+(*$T
+  list_ int_ [1;2;3] [1;2;3;4] < 0
+  list_ int_ [1;2;3;4] [1;2;3] > 0
+  list_ int_ [1;2;3;4] [1;3;4] < 0
+*)
+
+(*$Q
+  Q.(pair (list int)(list int)) (fun (l1,l2) -> \
+    equiv (list_ int_ l1 l2) (Pervasives.compare l1 l2))
+*)
+
 let array_ ord a1 a2 =
   let rec aux i =
     if i = Array.length a1
@@ -90,4 +117,15 @@ let array_ ord a1 a2 =
   in
   aux 0
 
+(*$T
+  array_ int_ [|1;2;3|] [|1;2;3;4|] < 0
+  array_ int_ [|1;2;3;4|] [|1;2;3|] > 0
+  array_ int_ [|1;2;3;4|] [|1;3;4|] < 0
+*)
+
+(*$Q & ~small:(fun (a1, a2) -> Array.length a1+Array.length a2)
+  Q.(pair (array int)(array int)) (fun (a1,a2) -> \
+    equiv (array_ int_ a1 a2) (list_ int_ (Array.to_list a1) (Array.to_list a2)))
+*)
+
 let map f ord a b = ord (f a) (f b)

src/data/CCBV.ml

@@ -170,6 +170,21 @@ let flip bv i =
   let i = i - n * __width in
   bv.a.(n) <- bv.a.(n) lxor (1 lsl i)
 
+(*$R
+  let bv = of_list [1;10; 11; 30] in
+  flip bv 10;
+  assert_equal [1;11;30] (to_sorted_list bv);
+  assert_equal false (get bv 10);
+  flip bv 10;
+  assert_equal true (get bv 10);
+  flip bv 5;
+  assert_equal [1;5;10;11;30] (to_sorted_list bv);
+  assert_equal true (get bv 5);
+  flip bv 100;
+  assert_equal [1;5;10;11;30;100] (to_sorted_list bv);
+  assert_equal true (get bv 100);
+*)
+
 let clear bv =
   Array.iteri (fun i _ -> bv.a.(i) <- 0) bv.a
 
@@ -194,6 +209,14 @@ let iter bv f =
     done
   done
 
+(*$R
+  let bv = create ~size:30 false in
+  set bv 5;
+  let n = ref 0 in
+  iter bv (fun i b -> incr n; assert_equal b (i=5));
+  assert_bool "at least 30" (!n >= 30)
+*)
+
 let iter_true bv f =
   let len = Array.length bv.a in
   for n = 0 to len - 1 do
@@ -346,8 +369,8 @@ let select bv arr =
 (*$R
   let bv = CCBV.of_list [1;2;5;400] in
   let arr = [|"a"; "b"; "c"; "d"; "e"; "f"|] in
-  let l = List.sort compare (CCBV.selecti bv arr) in
+  let l = List.sort compare (CCBV.select bv arr) in
-  assert_equal [("b",1); ("c",2); ("f",5)] l;
+  assert_equal ["b"; "c"; "f"] l;
 *)
 
 let selecti bv arr =
@@ -362,6 +385,13 @@ let selecti bv arr =
   end;
   !l
 
+(*$R
+  let bv = CCBV.of_list [1;2;5;400] in
+  let arr = [|"a"; "b"; "c"; "d"; "e"; "f"|] in
+  let l = List.sort compare (CCBV.selecti bv arr) in
+  assert_equal [("b",1); ("c",2); ("f",5)] l;
+*)
+
 (*$T
   selecti (of_list [1;4;3]) [| 0;1;2;3;4;5;6;7;8 |] \
     |> List.sort CCOrd.compare = [1, 1; 3,3; 4,4]

src/data/CCBV.mli

@@ -24,90 +24,97 @@ OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *)
 
-(** {2 Imperative Bitvectors} *)
+(** {2 Imperative Bitvectors}
+
+The size of the bitvector is rounded up to the multiple of 30 or  62.
+In other words some functions such as {!iter} might iterate on more
+bits than what was originally asked for.
+*)
 
 type t
+(** A resizable bitvector *)
 
 val empty : unit -> t
-  (** Empty bitvector *)
+(** Empty bitvector *)
 
 val create : size:int -> bool -> t
-  (** Create a bitvector of given size, with given default value *)
+(** Create a bitvector of given size, with given default value *)
 
 val copy : t -> t
-  (** Copy of bitvector *)
+(** Copy of bitvector *)
 
 val cardinal : t -> int
-  (** Number of bits set *)
+(** Number of bits set *)
 
 val length : t -> int
-  (** Length of underlying array *)
+(** Length of underlying array *)
 
 val resize : t -> int -> unit
-  (** Resize the BV so that it has at least the given physical length *)
+(** Resize the BV so that it has at least the given physical length
+    [resize bv n] should make [bv] able to store [(Sys.word_size - 2)* n] bits *)
 
 val is_empty : t -> bool
-  (** Any bit set? *)
+(** Any bit set? *)
 
 val set : t -> int -> unit
-  (** Set i-th bit. *)
+(** Set i-th bit. *)
 
 val get : t -> int -> bool
-  (** Is the i-th bit true? Returns false if the index is too high*)
+(** Is the i-th bit true? Returns false if the index is too high*)
 
 val reset : t -> int -> unit
-  (** Set i-th bit to 0 *)
+(** Set i-th bit to 0 *)
 
 val flip : t -> int -> unit
-  (** Flip i-th bit *)
+(** Flip i-th bit *)
 
 val clear : t -> unit
-  (** Set every bit to 0 *)
+(** Set every bit to 0 *)
 
 val iter : t -> (int -> bool -> unit) -> unit
-  (** Iterate on all bits *)
+(** Iterate on all bits *)
 
 val iter_true : t -> (int -> unit) -> unit
-  (** Iterate on bits set to 1 *)
+(** Iterate on bits set to 1 *)
 
 val to_list : t -> int list
-  (** List of indexes that are true *)
+(** List of indexes that are true *)
 
 val to_sorted_list : t -> int list
-  (** Same as {!to_list}, but also guarantees the list is sorted in
+(** Same as {!to_list}, but also guarantees the list is sorted in
-      increasing order *)
+    increasing order *)
 
 val of_list : int list -> t
-  (** From a list of true bits *)
+(** From a list of true bits *)
 
 val first : t -> int
-  (** First set bit, or
+(** First set bit, or
-      @raise Not_found if all bits are 0 *)
+    @raise Not_found if all bits are 0 *)
 
 val filter : t -> (int -> bool) -> unit
-  (** [filter bv p] only keeps the true bits of [bv] whose [index]
+(** [filter bv p] only keeps the true bits of [bv] whose [index]
-      satisfies [p index] *)
+    satisfies [p index] *)
 
 val union_into : into:t -> t -> unit
-  (** [union ~into bv] sets [into] to the union of itself and [bv]. *)
+(** [union ~into bv] sets [into] to the union of itself and [bv]. *)
 
 val inter_into : into:t -> t -> unit
-  (** [union ~into bv] sets [into] to the intersection of itself and [bv] *)
+(** [union ~into bv] sets [into] to the intersection of itself and [bv] *)
 
 val union : t -> t -> t
-  (** [union bv1 bv2] returns the union of the two sets *)
+(** [union bv1 bv2] returns the union of the two sets *)
 
 val inter : t -> t -> t
-  (** Intersection of bitvectors *)
+(** Intersection of bitvectors *)
 
 val select : t -> 'a array -> 'a list
-  (** [select arr bv] selects the elements of [arr] whose index
+(** [select arr bv] selects the elements of [arr] whose index
-      correspond to a true bit in [bv]. If [bv] is too short, elements of [arr]
+    correspond to a true bit in [bv]. If [bv] is too short, elements of [arr]
-      with too high an index cannot be selected and are therefore not
+    with too high an index cannot be selected and are therefore not
-      selected. *)
+    selected. *)
 
 val selecti : t -> 'a array -> ('a * int) list
-  (** Same as {!select}, but selected elements are paired with their index *)
+(** Same as {!select}, but selected elements are paired with their index *)
 
 type 'a sequence = ('a -> unit) -> unit
 
@@ -115,5 +122,5 @@ val to_seq : t -> int sequence
 val of_seq : int sequence -> t
 
 val print : Format.formatter -> t -> unit
-(** Print the bitvector
+(** Print the bitvector as a string of bits
     @since NEXT_RELEASE *)

src/data/CCCache.ml

@@ -62,6 +62,20 @@ let with_cache_rec c f =
   let rec f' x = with_cache c (f f') x in
   f'
 
+(*$R
+  let c = unbounded 256 in
+  let fib = with_cache_rec c
+    (fun self n -> match n with
+      | 1 | 2 -> 1
+      | _ -> self (n-1) + self (n-2)
+    )
+  in
+  assert_equal 55 (fib 10);
+  assert_equal 832040 (fib 30);
+  assert_equal 12586269025 (fib 50);
+  assert_equal 190392490709135 (fib 70)
+*)
+
 let size c = c.size ()
 
 let iter c f = c.iter f
@@ -318,6 +332,18 @@ let lru (type a) ?(eq=default_eq_) ?(hash=default_hash_) size =
   res1 <> res2 && res2 <> res3 && res3 <> res1_bis && res1_bis <> res1
 *)
 
+(*$R
+  let f = (let r = ref 0 in fun _ -> incr r; !r) in
+  let c = lru 2 in
+  let x = with_cache c f () in
+  assert_equal 1 x;
+  assert_equal 1 (size c);
+  clear c ;
+  assert_equal 0 (size c);
+  let y = with_cache c f () in
+  assert_equal 2 y ;
+*)
+
 module UNBOUNDED(X:HASH) = struct
   module H = Hashtbl.Make(X)
 

src/data/CCDeque.ml

@@ -75,6 +75,15 @@ let clear q =
   q.size <- 0;
   ()
 
+(*$R
+  let q = of_seq Sequence.(1 -- 100) in
+  assert_equal 100 (length q);
+  clear q;
+  assert_equal 0 (length q);
+  assert_raises Empty (fun () -> peek_front q);
+  assert_raises Empty (fun () -> peek_back q);
+*)
+
 let incr_size_ d = d.size <- d.size + 1
 let decr_size_ d = d.size <- d.size - 1
 
@@ -309,6 +318,11 @@ let of_seq seq =
 
 let to_seq d k = iter k d
 
+(*$Q
+  Q.(list int) (fun l -> \
+    Sequence.of_list l |> of_seq |> to_seq |> Sequence.to_list = l)
+  *)
+
 let of_list l =
   let q = create() in
   List.iter (push_back q) l;
@@ -368,6 +382,20 @@ let copy d =
   iter (fun x -> push_back d' x) d;
   d'
 
+(*$R
+  let q = of_list [1;2;3;4] in
+  assert_equal 4 (length q);
+  let q' = copy q in
+  let cmp = equal ?eq:None in
+  assert_equal 4 (length q');
+  assert_equal ~cmp q q';
+  push_front q 0;
+  assert_bool "not equal" (not (cmp q q'));
+  assert_equal 5 (length q);
+  push_front q' 0;
+  assert_equal ~cmp q q'
+*)
+
 let equal ?(eq=(=)) a b =
   let rec aux eq a b = match a() , b() with
     | None, None -> true
@@ -386,6 +414,12 @@ let compare ?(cmp=Pervasives.compare) a b =
         if c=0 then aux cmp a b else c
   in aux cmp (to_gen a) (to_gen b)
 
+(*$Q
+   Q.(pair (list int) (list int)) (fun (l1,l2) -> \
+    CCOrd.equiv (compare (of_list l1) (of_list l2)) \
+      (CCList.compare Pervasives.compare l1 l2))
+  *)
+
 type 'a printer = Format.formatter -> 'a -> unit
 
 let print pp_x out d =