From 1e4a22fbf27ad3dd09698ee325f487e7ecab2593 Mon Sep 17 00:00:00 2001 From: Simon Cruanes Date: Sat, 2 Jul 2022 22:09:25 -0400 Subject: [PATCH] refactor: finish migration to qtest --- src/data/CCFQueue.ml | 170 ----------- src/data/CCFun_vec.ml | 84 ------ src/data/CCGraph.ml | 63 ----- src/data/CCHashSet.ml | 25 -- src/data/CCHashTrie.ml | 126 --------- src/data/CCHet.ml | 33 +-- src/data/CCImmutArray.ml | 56 ---- src/data/CCIntMap.ml | 451 ------------------------------ src/data/CCIntMap.mli | 2 - src/data/CCLazy_list.ml | 30 -- src/data/CCMixmap.ml | 22 -- src/data/CCMixset.ml | 16 -- src/data/CCMixtbl.ml | 86 ------ src/data/CCMultiSet.ml | 9 - src/data/CCMutHeap.ml | 75 ----- src/data/CCPersistentArray.ml | 12 - src/data/CCPersistentHashtbl.ml | 168 ----------- src/data/CCRAL.ml | 199 ------------- src/data/CCRingBuffer.ml | 446 ----------------------------- src/data/CCSimple_queue.ml | 47 ---- src/data/CCTrie.ml | 146 ---------- src/data/CCWBTree.ml | 107 ------- src/data/CCZipper.ml | 30 -- tests/data/dune | 2 +- tests/data/t.ml | 18 ++ tests/data/t_fqueue.ml | 126 +++++++++ tests/data/t_fun_vec.ml | 65 +++++ tests/data/t_graph.ml | 68 +++++ tests/data/t_hashset.ml | 22 ++ tests/data/t_hashtrie.ml | 108 +++++++ tests/data/t_het.ml | 32 +++ tests/data/t_immutarray.ml | 48 ++++ tests/data/t_intmap.ml | 377 +++++++++++++++++++++++++ tests/data/t_lazylist.ml | 21 ++ tests/data/t_misc.ml | 166 +++++++++++ tests/data/t_mutheap.ml | 76 +++++ tests/data/t_persistenthashtbl.ml | 162 +++++++++++ tests/data/t_ral.ml | 139 +++++++++ tests/data/t_ringbuffer.ml | 394 ++++++++++++++++++++++++++ tests/data/t_simplequeue.ml | 36 +++ tests/data/t_trie.ml | 134 +++++++++ tests/data/t_wbt.ml | 100 +++++++ tests/data/t_zipper.ml | 23 ++ 43 files changed, 2117 insertions(+), 2403 deletions(-) create mode 100644 tests/data/t_fqueue.ml create mode 100644 tests/data/t_fun_vec.ml create mode 100644 tests/data/t_graph.ml create mode 100644 tests/data/t_hashset.ml create mode 100644 tests/data/t_hashtrie.ml create mode 100644 tests/data/t_het.ml create mode 100644 tests/data/t_immutarray.ml create mode 100644 tests/data/t_intmap.ml create mode 100644 tests/data/t_lazylist.ml create mode 100644 tests/data/t_misc.ml create mode 100644 tests/data/t_mutheap.ml create mode 100644 tests/data/t_persistenthashtbl.ml create mode 100644 tests/data/t_ral.ml create mode 100644 tests/data/t_ringbuffer.ml create mode 100644 tests/data/t_simplequeue.ml create mode 100644 tests/data/t_trie.ml create mode 100644 tests/data/t_wbt.ml create mode 100644 tests/data/t_zipper.ml diff --git a/src/data/CCFQueue.ml b/src/data/CCFQueue.ml index 443abdbb..ef971ac0 100644 --- a/src/data/CCFQueue.ml +++ b/src/data/CCFQueue.ml @@ -7,10 +7,6 @@ type 'a iter = ('a -> unit) -> unit type 'a equal = 'a -> 'a -> bool type 'a printer = Format.formatter -> 'a -> unit -(*$inject - let pp_ilist = CCFormat.(to_string (list int)) -*) - (** {2 Basics} *) [@@@warning "-37"] @@ -34,11 +30,6 @@ type +'a t = let empty : type a. a t = Shallow Zero -(*$R - let q = empty in - OUnit2.assert_bool "is_empty" (is_empty q) -*) - exception Empty let _empty = Shallow Zero @@ -68,11 +59,6 @@ let rec cons : type a. a -> a t -> a t | Deep (n,Three (y,z,z'), lazy q', tail) -> _deep (n+1) (Two (x,y)) (lazy (cons (z,z') q')) tail -(*$Q - (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \ - cons x (of_list l) |> to_list = x::l) -*) - let rec snoc : type a. a t -> a -> a t = fun q x -> match q with | Shallow Zero -> _single x @@ -85,19 +71,6 @@ let rec snoc : type a. a t -> a -> a t | Deep (n,hd, lazy q', Three (y,z,z')) -> _deep (n+1) hd (lazy (snoc q' (y,z))) (Two(z',x)) -(*$Q - (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \ - snoc (of_list l) x |> to_list = l @ [x]) -*) - -(*$R - let q = List.fold_left snoc empty [1;2;3;4;5] in - let q = tail q in - let q = List.fold_left snoc q [6;7;8] in - let l = Iter.to_list (to_iter q) in - OUnit2.assert_equal ~printer:pp_ilist [2;3;4;5;6;7;8] l -*) - let rec take_front_exn : 'a. 'a t -> ('a *'a t) = fun q -> match q with | Shallow Zero -> raise Empty @@ -115,30 +88,10 @@ let rec take_front_exn : 'a. 'a t -> ('a *'a t) | Deep (n,Three (x,y,z), middle, tail) -> x, _deep (n-1) (Two(y,z)) middle tail -(*$Q - (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \ - let x', q = cons x (of_list l) |> take_front_exn in \ - x'=x && to_list q = l) -*) - -(*$R - let q = of_list [1;2;3;4] in - let x, q = take_front_exn q in - OUnit2.assert_equal 1 x; - let q = List.fold_left snoc q [5;6;7] in - OUnit2.assert_equal 2 (first_exn q); - let x, q = take_front_exn q in - OUnit2.assert_equal 2 x; -*) - let take_front q = try Some (take_front_exn q) with Empty -> None -(*$T - take_front empty = None -*) - let take_front_l n q = if n<0 then ( invalid_arg "take_back_l: cannot take negative number of arguments" @@ -150,11 +103,6 @@ let take_front_l n q = aux (x::acc) q' (n-1) in aux [] q n -(*$T - let l, q = take_front_l 5 (1 -- 10) in \ - l = [1;2;3;4;5] && to_list q = [6;7;8;9;10] -*) - let take_front_while p q = let rec aux acc q = if is_empty q then List.rev acc, q @@ -163,10 +111,6 @@ let take_front_while p q = if p x then aux (x::acc) q' else List.rev acc, q in aux [] q -(*$T - take_front_while (fun x-> x<5) (1 -- 10) |> fst = [1;2;3;4] -*) - let rec take_back_exn : 'a. 'a t -> 'a t * 'a = fun q -> match q with | Shallow Zero -> raise Empty @@ -182,20 +126,10 @@ let rec take_back_exn : 'a. 'a t -> 'a t * 'a | Deep (n, hd, middle, Two(x,y)) -> _deep (n-1) hd middle (One x), y | Deep (n, hd, middle, Three(x,y,z)) -> _deep (n-1) hd middle (Two (x,y)), z -(*$Q - (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> \ - let q,x' = snoc (of_list l) x |> take_back_exn in \ - x'=x && to_list q = l) -*) - let take_back q = try Some (take_back_exn q) with Empty -> None -(*$T - take_back empty = None -*) - let take_back_l n q = if n<0 then ( invalid_arg "take_back_l: cannot take negative number of arguments" @@ -240,11 +174,6 @@ let size : 'a. 'a t -> int | Shallow d -> _size_digit d | Deep (n, _, _, _) -> n -(*$Q - (Q.list Q.int) (fun l -> \ - size (of_list l) = List.length l) -*) - let _nth_digit : type l. int -> ('a, l) digit -> 'a = fun i d -> match i, d with | _, Zero -> raise Not_found | 0, One x -> x @@ -278,51 +207,24 @@ let rec nth_exn : 'a. int -> 'a t -> 'a else _nth_digit (i'-2*size q') r -(*$T - let l = CCList.(0--100) in let q = of_list l in \ - List.map (fun i->nth_exn i q) l = l -*) - let nth i q = try Some (nth_exn i q) with Failure _ -> None -(*$Q & ~count:30 - (Q.list Q.int) (fun l -> \ - let len = List.length l in let idx = CCList.(0 -- (len - 1)) in \ - let q = of_list l in \ - l = [] || List.for_all (fun i -> nth i q = Some (List.nth l i)) idx) -*) - let init q = try fst (take_back_exn q) with Empty -> q -(*$Q - (Q.list Q.int) (fun l -> \ - l = [] || (of_list l |> init |> to_list = List.rev (List.tl (List.rev l)))) -*) - let tail q = try snd (take_front_exn q) with Empty -> q -(*$Q - (Q.list Q.int) (fun l -> \ - l = [] || (of_list l |> tail |> to_list = List.tl l)) -*) - let add_iter_front seq q = let l = ref [] in (* reversed seq *) seq (fun x -> l := x :: !l); List.fold_left (fun q x -> cons x q) q !l -(*$Q - Q.(pair (list int) (list int)) (fun (l1, l2) -> \ - add_iter_front (Iter.of_list l1) (of_list l2) |> to_list = l1 @ l2) -*) - let add_iter_back q seq = let q = ref q in seq (fun x -> q := snoc !q x); @@ -342,40 +244,17 @@ let rec to_iter : 'a. 'a t -> 'a iter to_iter q' (fun (x,y) -> k x; k y); _digit_to_iter tail k -(*$Q - (Q.list Q.int) (fun l -> \ - of_list l |> to_iter |> Iter.to_list = l) -*) - let append q1 q2 = match q1, q2 with | Shallow Zero, _ -> q2 | _, Shallow Zero -> q1 | _ -> add_iter_back q1 (to_iter q2) -(*$Q - (Q.pair (Q.list Q.int)(Q.list Q.int)) (fun (l1,l2) -> \ - append (of_list l1) (of_list l2) |> to_list = l1 @ l2) -*) - -(*$R - let q1 = of_iter (Iter.of_list [1;2;3;4]) in - let q2 = of_iter (Iter.of_list [5;6;7;8]) in - let q = append q1 q2 in - let l = Iter.to_list (to_iter q) in - OUnit2.assert_equal ~printer:pp_ilist [1;2;3;4;5;6;7;8] l -*) - let add_seq_front seq q = (* reversed seq *) let l = Seq.fold_left (fun l elt -> elt::l ) [] seq in List.fold_left (fun q x -> cons x q) q l -(*$Q - Q.(pair (list int) (list int)) (fun (l1, l2) -> \ - add_seq_front (CCList.to_seq l1) (of_list l2) |> to_list = l1 @ l2) -*) - let add_seq_back q seq = Seq.fold_left (fun q x -> snoc q x) q seq @@ -396,11 +275,6 @@ let rec to_seq : 'a. 'a t -> 'a Seq.t let of_seq seq = add_seq_front seq empty -(*$Q - (Q.list Q.int) (fun l -> \ - of_list l |> to_seq |> CCList.of_seq = l) -*) - let _map_digit : type l. ('a -> 'b) -> ('a, l) digit -> ('b, l) digit = fun f d -> match d with | Zero -> Zero | One x -> One (f x) @@ -414,11 +288,6 @@ let rec map : 'a 'b. ('a -> 'b) -> 'a t -> 'b t let q'' = map (fun (x,y) -> f x, f y) q' in _deep size (_map_digit f hd) (Lazy.from_val q'') (_map_digit f tl) -(*$Q - (Q.list Q.int) (fun l -> \ - of_list l |> map string_of_int |> to_list = List.map string_of_int l) -*) - let (>|=) q f = map f q let _fold_digit : type l. ('acc -> 'a -> 'acc) -> 'acc -> ('a, l) digit -> 'acc = fun f acc d -> match d with @@ -435,17 +304,6 @@ let rec fold : 'a 'b. ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b let acc = fold (fun acc (x,y) -> f (f acc x) y) acc q' in _fold_digit f acc tl -(*$Q - (Q.list Q.int) (fun l -> \ - of_list l |> fold (fun acc x->x::acc) [] = List.rev l) -*) - -(*$R - let q = of_iter (Iter.of_list [1;2;3;4]) in - let n = fold (+) 0 q in - OUnit2.assert_equal 10 n; -*) - let iter f q = to_iter q f let of_list l = List.fold_left snoc empty l @@ -457,21 +315,11 @@ let to_list q = let of_iter seq = add_iter_front seq empty -(*$Q - (Q.list Q.int) (fun l -> \ - Iter.of_list l |> of_iter |> to_list = l) -*) - let rev q = let q' = ref empty in iter (fun x -> q' := cons x !q') q; !q' -(*$Q - (Q.list Q.int) (fun l -> \ - of_list l |> rev |> to_list = List.rev l) -*) - let rec _equal_seq eq l1 l2 = match l1(), l2() with | Seq.Nil, Seq.Nil -> true | Seq.Nil, _ @@ -481,11 +329,6 @@ let rec _equal_seq eq l1 l2 = match l1(), l2() with let equal eq q1 q2 = _equal_seq eq (to_seq q1) (to_seq q2) -(*$T - let q1 = 1 -- 10 and q2 = append (1 -- 5) (6 -- 10) in \ - equal (=) q1 q2 -*) - let (--) a b = let rec up_to q a b = if a = b then snoc q a @@ -495,24 +338,11 @@ let (--) a b = in if a <= b then up_to empty a b else down_to empty a b -(*$T - 1 -- 5 |> to_list = [1;2;3;4;5] - 5 -- 1 |> to_list = [5;4;3;2;1] - 0 -- 0 |> to_list = [0] -*) - let (--^) a b = if a=b then empty else if a to_list = [1;2;3;4] - 5 --^ 1 |> to_list = [5;4;3;2] - 1 --^ 2 |> to_list = [1] - 0 --^ 0 |> to_list = [] -*) - let pp pp_x out d = let first = ref true in Format.fprintf out "@[queue {"; diff --git a/src/data/CCFun_vec.ml b/src/data/CCFun_vec.ml index ddd62f0d..e5aa3046 100644 --- a/src/data/CCFun_vec.ml +++ b/src/data/CCFun_vec.ml @@ -1,16 +1,5 @@ (* This file is free software, part of containers. See file "license" for more details. *) -(*$inject - - 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 - ;; -*) - (** {1 Hash Tries} *) type 'a iter = ('a -> unit) -> unit @@ -140,17 +129,8 @@ let empty = {size=0; leaves=A.empty; subs=A.empty} let is_empty {size;_} = size=0 -(*$T - is_empty empty -*) - let length {size;_} = size -(*$T - not (is_empty (return 2)) - length (return 2) = 1 -*) - let return x = {leaves=A.return x; subs=A.empty; size=1} type idx_l = @@ -182,12 +162,6 @@ let get_ (i:int) (m:'a t) : 'a = in aux (split_idx i) m -(*$Q - _listuniq (fun l -> \ - let m = of_list l in \ - List.for_all (fun (i,y) -> get_exn i m = y) @@ List.mapi CCPair.make l) -*) - let get_exn i v = if i >= 0 && i < length v then get_ i v else raise Not_found @@ -241,27 +215,6 @@ let pop_exn (v:'a t) : 'a * 'a t = let pop (v:'a t) : ('a * 'a t) option = if v.size=0 then None else Some (pop_ (v.size-1) v) -(* regression test for #298 *) -(*$R - let rec consume x = match CCFun_vec.pop x with - | None -> () | Some (_, x) -> consume x - in - consume (of_list (CCList.(1 -- 100))); - () -*) - -(*$QR - Q.(pair int (small_list int)) (fun (x,l) -> - let q0 = of_list l in - let q = push x q0 in - assert_equal (length q) (length q0+1); - let y, q = pop_exn q in - assert_equal x y; - assert_equal (to_list q) (to_list q0); - true - ) - *) - let iteri ~f (m : 'a t) : unit = (* basically, a 32-way BFS traversal. The queue contains subtrees to explore, along with their high_idx_ offsets *) @@ -306,34 +259,16 @@ let rec map f m : _ t = size=m.size; } -(*$QR - 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) - ) -*) - let append a b = if is_empty b then a else fold ~f:(fun v x -> push x v) ~x:a b -(*$QR - Q.(pair (small_list int)(small_list int)) (fun (l1,l2) -> - (l1 @ l2) = (append (of_list l1)(of_list l2) |> to_list) - ) -*) - let add_list v l = List.fold_left (fun v x -> push x v) v l let of_list l = add_list empty l let to_list m = fold_rev m ~f:(fun acc x -> x::acc) ~x:[] -(*$QR - Q.(small_list int) (fun l -> - l = to_list (of_list l)) -*) - let add_iter v seq = let v = ref v in seq (fun x -> v := push x !v); @@ -343,13 +278,6 @@ let of_iter s = add_iter empty s let to_iter m yield = iteri ~f:(fun _ v -> yield v) m -(*$Q - _listuniq (fun l -> \ - (List.sort Stdlib.compare l) = \ - (l |> Iter.of_list |> of_iter |> to_iter |> Iter.to_list \ - |> List.sort Stdlib.compare) ) -*) - let rec add_gen m g = match g() with | None -> m | Some x -> add_gen (push x m) g @@ -374,20 +302,8 @@ let to_gen m = ) else None in next -(*$Q - _listuniq (fun l -> \ - (List.sort Stdlib.compare l) = \ - (l |> Gen.of_list |> of_gen |> to_gen |> Gen.to_list \ - |> List.sort Stdlib.compare) ) -*) - let choose m = to_gen m () -(*$T - choose empty = None - choose (of_list [1,1; 2,2]) <> None -*) - let choose_exn m = match choose m with | None -> raise Not_found | Some (k,v) -> k, v diff --git a/src/data/CCGraph.ml b/src/data/CCGraph.ml index 250b7189..db58102a 100644 --- a/src/data/CCGraph.ml +++ b/src/data/CCGraph.ml @@ -290,22 +290,6 @@ module Traverse = struct } in dfs_tag ~eq ~tags ~graph iter end - - (*$R - let l = - let tbl = mk_table ~eq:CCInt.equal 128 in - Traverse.Event.dfs ~tbl ~eq:CCInt.equal ~graph:divisors_graph (Iter.return 345614) - |> Iter.to_list in - let expected = - [`Enter (345614, 0, []); `Edge (345614, (), 172807, `Forward); - `Enter (172807, 1, [(345614, (), 172807)]); `Edge (172807, (), 1, `Forward); - `Enter (1, 2, [(172807, (), 1); (345614, (), 172807)]); `Exit 1; `Exit 172807; - `Edge (345614, (), 2, `Forward); `Enter (2, 3, [(345614, (), 2)]); - `Edge (2, (), 1, `Cross); `Exit 2; `Edge (345614, (), 1, `Cross); - `Exit 345614] - in - assert_equal expected l - *) end (** {2 Cycles} *) @@ -343,23 +327,6 @@ let topo_sort ~eq ?rev ~tbl ~graph iter = } in topo_sort_tag ~eq ?rev ~tags ~graph iter -(*$T - let tbl = mk_table ~eq:CCInt.equal 128 in \ - let l = topo_sort ~eq:CCInt.equal ~tbl ~graph:divisors_graph (Iter.return 42) in \ - List.for_all (fun (i,j) -> \ - let idx_i = CCList.find_idx ((=)i) l |> CCOption.get_exn |> fst in \ - let idx_j = CCList.find_idx ((=)j) l |> CCOption.get_exn |> fst in \ - idx_i < idx_j) \ - [ 42, 21; 14, 2; 3, 1; 21, 7; 42, 3] - let tbl = mk_table ~eq:CCInt.equal 128 in \ - let l = topo_sort ~eq:CCInt.equal ~rev:true ~tbl ~graph:divisors_graph (Iter.return 42) in \ - List.for_all (fun (i,j) -> \ - let idx_i = CCList.find_idx ((=)i) l |> CCOption.get_exn |> fst in \ - let idx_j = CCList.find_idx ((=)j) l |> CCOption.get_exn |> fst in \ - idx_i > idx_j) \ - [ 42, 21; 14, 2; 3, 1; 21, 7; 42, 3] -*) - (** {2 Lazy Spanning Tree} *) module Lazy_tree = struct @@ -491,36 +458,6 @@ type 'v scc_state = 'v SCC.state let scc ~tbl ~graph iter = SCC.explore ~tbl ~graph iter -(* example from https://en.wikipedia.org/wiki/Strongly_connected_component *) -(*$R - let set_eq ?(eq=(=)) l1 l2 = CCList.subset ~eq l1 l2 && CCList.subset ~eq l2 l1 in - let graph = of_list ~eq:CCString.equal - [ "a", "b" - ; "b", "e" - ; "e", "a" - ; "b", "f" - ; "e", "f" - ; "f", "g" - ; "g", "f" - ; "b", "c" - ; "c", "g" - ; "c", "d" - ; "d", "c" - ; "d", "h" - ; "h", "d" - ; "h", "g" - ] in - let tbl = mk_table ~eq:CCString.equal 128 in - let res = scc ~tbl ~graph (Iter.return "a") |> Iter.to_list in - assert_bool "scc" - (set_eq ~eq:(set_eq ?eq:None) res - [ [ "a"; "b"; "e" ] - ; [ "f"; "g" ] - ; [ "c"; "d"; "h" ] - ] - ) -*) - (** {2 Pretty printing in the DOT (graphviz) format} *) module Dot = struct diff --git a/src/data/CCHashSet.ml b/src/data/CCHashSet.ml index b5d6ad50..ff23e10f 100644 --- a/src/data/CCHashSet.ml +++ b/src/data/CCHashSet.ml @@ -123,11 +123,6 @@ module Make(E : ELEMENT) : S with type elt = E.t = struct let cardinal = Tbl.length - (*$T - let module IS = Make(CCInt) in \ - IS.cardinal (IS.create 10) = 0 - *) - let mem = Tbl.mem let find_exn = Tbl.find @@ -136,11 +131,6 @@ module Make(E : ELEMENT) : S with type elt = E.t = struct try Some (Tbl.find s x) with Not_found -> None - (*$T - let module IS = Make(CCInt) in IS.find (IS.of_list [1;2;3]) 3 = Some 3 - let module IS = Make(CCInt) in IS.find (IS.of_list [1;2;3]) 5 = None - *) - let iter f s = Tbl.iter (fun x _ -> f x) s let fold f acc s = Tbl.fold (fun x _ acc -> f acc x) s acc @@ -150,11 +140,6 @@ module Make(E : ELEMENT) : S with type elt = E.t = struct iter (fun x -> if mem a x then insert res x) b; res - (*$T - let module IS = Make(CCInt) in \ - IS.(equal (inter (of_list [1;2;3]) (of_list [2;5;4])) (of_list [2])) - *) - let inter_mut ~into a = iter (fun x -> @@ -166,11 +151,6 @@ module Make(E : ELEMENT) : S with type elt = E.t = struct copy_into ~into:res b; res - (*$T - let module IS = Make(CCInt) in \ - IS.(equal (union (of_list [1;2;3]) (of_list [2;5;4])) (of_list [1;2;3;4;5])) - *) - let union_mut ~into a = copy_into ~into a @@ -180,11 +160,6 @@ module Make(E : ELEMENT) : S with type elt = E.t = struct (fun x -> remove res x) b; res - (*$T - let module IS = Make(CCInt) in \ - IS.(equal (diff (of_list [1;2;3]) (of_list [2;4;5])) (of_list [1;3])) - *) - exception FastExit let for_all p s = diff --git a/src/data/CCHashTrie.ml b/src/data/CCHashTrie.ml index 3ee9cdde..1fd51800 100644 --- a/src/data/CCHashTrie.ml +++ b/src/data/CCHashTrie.ml @@ -1,17 +1,5 @@ (* This file is free software, part of containers. See file "license" for more details. *) -(*$inject - module M = Make(CCInt) ;; - - let _listuniq = - let g = Q.(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 - ;; -*) - (** {1 Hash Tries} *) type 'a iter = ('a -> unit) -> unit @@ -182,20 +170,6 @@ let popcount (b:I64.t) : int = let b = b + (b lsr 32) in Int64.to_int (b land 0x7fL) -(*$T - popcount 5L = 2 - popcount 256L = 1 - popcount 255L = 8 - popcount 0xFFFFL = 16 - popcount 0xFF1FL = 13 - popcount 0xFFFFFFFFL = 32 - popcount 0xFFFFFFFFFFFFFFFFL = 64 -*) - -(*$Q - Q.int (fun i -> let i = Int64.of_int i in popcount i <= 64) -*) - (* sparse array, using a bitfield and POPCOUNT *) module A_SPARSE = struct type 'a t = { @@ -364,19 +338,10 @@ module Make(Key : KEY) | S _ | L _ | N _ -> false - (*$T - M.is_empty M.empty - *) - let leaf_ k v ~h = L (h, Cons(k,v,Nil)) let singleton k v = leaf_ k v ~h:(hash_ k) - (*$T - not (M.is_empty (M.singleton 1 2)) - M.cardinal (M.singleton 1 2) = 1 - *) - let rec get_exn_list_ k l = match l with | Nil -> raise Not_found | One (k', v') -> if Key.equal k k' then v' else raise Not_found @@ -401,12 +366,6 @@ module Make(Key : KEY) let get_exn k m = get_exn_ k ~h:(hash_ k) m - (*$Q - _listuniq (fun l -> \ - let m = M.of_list l in \ - List.for_all (fun (x,y) -> M.get_exn x m = y) l) - *) - let get k m = try Some (get_exn_ k ~h:(hash_ k) m) with Not_found -> None @@ -485,30 +444,10 @@ module Make(Key : KEY) let add k v m = add_ ~id:Transient.empty k v ~h:(hash_ k) m - (*$Q - _listuniq (fun l -> \ - let m = List.fold_left (fun m (x,y) -> M.add x y m) M.empty l in \ - List.for_all (fun (x,y) -> M.get_exn x m = y) l) - *) - let add_mut ~id k v m = if Transient.frozen id then raise Transient.Frozen; add_ ~id k v ~h:(hash_ k) m - (*$R - let lsort = List.sort Stdlib.compare in - let m = M.of_list [1, 1; 2, 2] in - let id = Transient.create() in - let m' = M.add_mut ~id 3 3 m in - let m' = M.add_mut ~id 4 4 m' in - assert_equal [1, 1; 2, 2] (M.to_list m |> lsort); - assert_equal [1, 1; 2, 2; 3,3; 4,4] (M.to_list m' |> lsort); - Transient.freeze id; - assert_bool "must raise" - (try ignore(M.add_mut ~id 5 5 m'); false with Transient.Frozen -> true) - *) - - exception LocalExit let is_empty_arr_ a = @@ -569,21 +508,6 @@ module Make(Key : KEY) if Transient.frozen id then raise Transient.Frozen; remove_rec_ ~id k ~h:(hash_ k) m - (*$QR - _listuniq (fun l -> - let m = M.of_list l in - List.for_all - (fun (x,_) -> - let m' = M.remove x m in - not (M.mem x m') && - M.cardinal m' = M.cardinal m - 1 && - List.for_all - (fun (y,v) -> y = x || M.get_exn y m' = v) - l - ) l - ) - *) - let update_ ~id k f m = let h = hash_ k in let opt_v = try Some (get_exn_ k ~h m) with Not_found -> None in @@ -600,17 +524,6 @@ module Make(Key : KEY) if Transient.frozen id then raise Transient.Frozen; update_ ~id k f m - (*$R - let m = M.of_list [1, 1; 2, 2; 5, 5] in - let m' = M.update 4 - ~f:(function - | None -> Some 4 - | Some _ -> Some 0 - ) m - in - assert_equal [1,1; 2,2; 4,4; 5,5] (M.to_list m' |> List.sort Stdlib.compare); - *) - let iter ~f t = let rec aux = function | E -> () @@ -639,13 +552,6 @@ module Make(Key : KEY) in aux acc t - (*$T - let l = CCList.(1 -- 10 |> map (fun x->x,x)) in \ - M.of_list l \ - |> M.fold ~f:(fun acc x y -> (x,y)::acc) ~x:[] \ - |> List.sort Stdlib.compare = l - *) - let cardinal m = fold ~f:(fun n _ _ -> n+1) ~x:0 m let to_list m = fold ~f:(fun acc k v -> (k,v)::acc) ~x:[] m @@ -670,13 +576,6 @@ module Make(Key : KEY) let to_iter m yield = iter ~f:(fun k v -> yield (k,v)) m - (*$Q - _listuniq (fun l -> \ - (List.sort Stdlib.compare l) = \ - (l |> Iter.of_list |> M.of_iter |> M.to_iter |> Iter.to_list \ - |> List.sort Stdlib.compare) ) - *) - let rec add_gen_mut ~id m g = match g() with | None -> m | Some (k,v) -> add_gen_mut ~id (add_mut ~id k v m) g @@ -714,20 +613,8 @@ module Make(Key : KEY) in next - (*$Q - _listuniq (fun l -> \ - (List.sort Stdlib.compare l) = \ - (l |> Gen.of_list |> M.of_gen |> M.to_gen |> Gen.to_list \ - |> List.sort Stdlib.compare) ) - *) - let choose m = to_gen m () - (*$T - M.choose M.empty = None - M.choose M.(of_list [1,1; 2,2]) <> None - *) - let choose_exn m = match choose m with | None -> raise Not_found | Some (k,v) -> k, v @@ -755,16 +642,3 @@ module Make(Key : KEY) and array_as_tree_ a = A.fold (fun acc t -> as_tree t :: acc) [] a end -(*$R - let m = M.of_list CCList.( (501 -- 1000) @ (500 -- 1) |> map (fun i->i,i)) in - assert_equal ~printer:CCInt.to_string 1000 (M.cardinal m); - assert_bool "check all get" - (Iter.for_all (fun i -> i = M.get_exn i m) Iter.(1 -- 1000)); - let m = Iter.(501 -- 1000 |> fold (fun m i -> M.remove i m) m) in - assert_equal ~printer:CCInt.to_string 500 (M.cardinal m); - assert_bool "check all get after remove" - (Iter.for_all (fun i -> i = M.get_exn i m) Iter.(1 -- 500)); - assert_bool "check all get after remove" - (Iter.for_all (fun i -> None = M.get i m) Iter.(501 -- 1000)); -*) - diff --git a/src/data/CCHet.ml b/src/data/CCHet.ml index 3d9538af..bcb63e29 100644 --- a/src/data/CCHet.ml +++ b/src/data/CCHet.ml @@ -3,37 +3,6 @@ (** {1 Associative containers with Heterogenerous Values} *) -(*$R - let k1 : int Key.t = Key.create() in - let k2 : int Key.t = Key.create() in - let k3 : string Key.t = Key.create() in - let k4 : float Key.t = Key.create() in - - let tbl = Tbl.create () in - - Tbl.add tbl k1 1; - Tbl.add tbl k2 2; - Tbl.add tbl k3 "k3"; - - assert_equal (Some 1) (Tbl.find tbl k1); - assert_equal (Some 2) (Tbl.find tbl k2); - assert_equal (Some "k3") (Tbl.find tbl k3); - assert_equal None (Tbl.find tbl k4); - assert_equal 3 (Tbl.length tbl); - - Tbl.add tbl k1 10; - assert_equal (Some 10) (Tbl.find tbl k1); - assert_equal 3 (Tbl.length tbl); - assert_equal None (Tbl.find tbl k4); - - Tbl.add tbl k4 0.0; - assert_equal (Some 0.0) (Tbl.find tbl k4); - - () - - -*) - type 'a iter = ('a -> unit) -> unit type 'a gen = unit -> 'a option @@ -171,7 +140,7 @@ module Map = struct let add (type a) (k : a Key.t) v t = let module K = (val k) in add_e_pair_ (E_pair (k, K.Store v)) t - + let remove (type a) (k: a Key.t) t = let module K = (val k) in M.remove K.id t diff --git a/src/data/CCImmutArray.ml b/src/data/CCImmutArray.ml index f69e32e0..81ddf927 100644 --- a/src/data/CCImmutArray.ml +++ b/src/data/CCImmutArray.ml @@ -5,9 +5,6 @@ (* TODO: transient API? for batch modifications *) -(*$inject let print_array f a = to_list a |> Array.of_list |> Q.Print.(array f) -*) - type 'a t = 'a array let empty = [| |] @@ -29,11 +26,6 @@ let set a n x = a'.(n) <- x; a' -(*$= set & ~printer:(print_array Q.Print.int) - (of_list [0]) (set (of_list [5]) 0 0) - (of_list [1; 3; 4; 5]) (set (of_list [1; 2; 4; 5]) 1 3) -*) - let sub = Array.sub (* Would this not be better implemented with CCArray_slice *) let map = Array.map @@ -45,13 +37,6 @@ let append a b = Array.init (na + length b) (fun i -> if i < na then a.(i) else b.(i-na)) -(*$= append & ~printer:(print_array Q.Print.int) - empty (append empty empty) - (of_list [1; 2; 3]) (append empty (of_list [1; 2; 3])) - (of_list [1; 2; 3]) (append (of_list [1; 2; 3]) empty) - (of_list [3; 1; 4; 1; 5]) (append (of_list [3; 1]) (of_list [4; 1; 5])) -*) - let iter = Array.iter let iteri = Array.iteri @@ -67,10 +52,6 @@ let foldi f acc a = acc) acc a -(*$= foldi & ~printer:Q.Print.(list (pair int string)) - ([2, "baz"; 1, "bar"; 0, "foo"]) (foldi (fun l i a -> (i, a) :: l) [] (of_list ["foo"; "bar"; "baz"])) -*) - exception ExitNow let for_all p a = @@ -79,37 +60,12 @@ let for_all p a = true with ExitNow -> false -(*$= for_all & ~printer:Q.Print.bool - true (for_all (fun _ -> false) empty) - false (for_all (fun _ -> false) (singleton 3)) - true (for_all (fun n -> n mod 2 = 0) (of_list [2; 4; 8])) - false (for_all (fun n -> n mod 2 = 0) (of_list [2; 4; 5; 8])) -*) - let exists p a = try Array.iter (fun x -> if p x then raise ExitNow) a; false with ExitNow -> true -(*$= exists & ~printer:Q.Print.bool - false (exists (fun _ -> true) empty) - true (exists (fun _ -> true) (singleton 3)) - false (exists (fun _ -> false) (singleton 3)) - false (exists (fun n -> n mod 2 = 1) (of_list [2; 4; 8])) - true (exists (fun n -> n mod 2 = 1) (of_list [2; 4; 5; 8])) -*) - -(*$Q - Q.(list bool) (fun l -> let a = of_list l in not @@ exists (fun b -> b) a = for_all not a) - Q.(list bool) (fun l -> let a = of_list l in not @@ for_all (fun b -> b) a = exists not a) -*) - -(*$Q - Q.(list bool) (fun l -> exists (fun b -> b) (of_list l) = List.fold_left (||) false l) - Q.(list bool) (fun l -> for_all (fun b -> b) (of_list l) = List.fold_left (&&) true l) - *) - (** {2 Conversions} *) type 'a iter = ('a -> unit) -> unit @@ -128,12 +84,6 @@ let of_iter s = s (fun x -> l := x :: !l); Array.of_list (List.rev !l) -(*$Q - Q.(list int) (fun l -> \ - let g = Iter.of_list l in \ - of_iter g |> to_iter |> Iter.to_list = l) -*) - let rec gen_to_list_ acc g = match g() with | None -> List.rev acc | Some x -> gen_to_list_ (x::acc) g @@ -151,12 +101,6 @@ let to_gen a = Some x ) else None -(*$Q - Q.(list int) (fun l -> \ - let g = Gen.of_list l in \ - of_gen g |> to_gen |> Gen.to_list = l) -*) - (** {2 IO} *) type 'a printer = Format.formatter -> 'a -> unit diff --git a/src/data/CCIntMap.ml b/src/data/CCIntMap.ml index 35087823..14fc8f0d 100644 --- a/src/data/CCIntMap.ml +++ b/src/data/CCIntMap.ml @@ -1,7 +1,4 @@ -(* This file is free software, part of containers. See file "license" for more details. *) - -(** {1 Map specialized for Int keys} *) (* "Fast Mergeable Integer Maps", Okasaki & Gill. We use big-endian trees. *) @@ -57,26 +54,6 @@ end = struct let equal_int : int -> int -> bool = Stdlib.(=) end -(*$inject - let highest2 x : int = - let rec aux i = - if i=0 then i - else if 1 = (x lsr i) then 1 lsl i else aux (i-1) - in - if x<0 then min_int else aux (Sys.word_size-2) -*) - -(*$QR & ~count:1_000 - Q.int (fun x -> - if Bit.equal_int (highest2 x) (Bit.highest x) then true - else QCheck.Test.fail_reportf "x=%d, highest=%d, highest2=%d@." x - (Bit.highest x :> int) (highest2 x)) - *) - -(*$inject - let _list_uniq l = CCList.sort_uniq ~cmp:(fun a b-> Stdlib.compare (fst a)(fst b)) l -*) - type +'a t = | E (* empty *) | L of int * 'a (* leaf *) @@ -88,31 +65,9 @@ let[@inline] is_empty = function | E -> true | _ -> false -(*$Q - Q.(small_list (pair int int)) (fun l -> \ - let m = of_list l in \ - is_empty m = (cardinal m = 0)) - *) - let[@inline] is_prefix_ ~prefix y ~bit = prefix = Bit.mask y ~mask:bit -(*$Q - Q.int (fun i -> \ - let b = Bit.highest i in \ - ((b:>int) land i = (b:>int)) && (i < 0 || ((b:>int) <= i && (i-(b:>int)) < (b:>int)))) - Q.int (fun i -> (Bit.highest i = Bit.min_int) = (i < 0)) - Q.int (fun i -> ((Bit.highest i:>int) < 0) = (Bit.highest i = Bit.min_int)) - Q.int (fun i -> let j = (Bit.highest i :> int) in j land (j-1) = 0) -*) - -(*$T - (Bit.highest min_int :> int) = min_int - (Bit.highest 2 :> int) = 2 - (Bit.highest 17 :> int) = 16 - (Bit.highest 300 :> int) = 256 -*) - (* small endian: let branching_bit_ a _ b _ = lowest_bit_ (a lxor b) *) let branching_bit_ a b = Bit.highest (a lxor b) @@ -137,11 +92,6 @@ let check_invariants t = in check_keys [] t -(*$Q - Q.(list (pair int bool)) (fun l -> \ - check_invariants (of_list l)) -*) - let rec find_exn k t = match t with | E -> raise Not_found | L (k', v) when k = k' -> v @@ -159,23 +109,10 @@ let find k t = try Some (find_exn k t) with Not_found -> None -(*$Q - Q.(list (pair int int)) (fun l -> \ - let l = _list_uniq l in \ - let m = of_list l in \ - List.for_all (fun (k,v) -> find k m = Some v) l) -*) - let mem k t = try ignore (find_exn k t); true with Not_found -> false -(*$Q - Q.(list (pair int int)) (fun l -> \ - let m = of_list l in \ - List.for_all (fun (k,_) -> mem k m) l) -*) - let mk_node_ prefix switch l r = match l, r with | E, o | o, E -> o | _ -> N (prefix, switch, l, r) @@ -213,12 +150,6 @@ let rec insert_ c k v t = match t with let add k v t = insert_ (fun ~old:_ v -> v) k v t -(*$Q & ~count:20 - Q.(list (pair int int)) (fun l -> \ - let l = _list_uniq l in let m = of_list l in \ - List.for_all (fun (k,v) -> find_exn k m = v) l) -*) - let rec remove k t = match t with | E -> E | L (k', _) -> if k=k' then E else t @@ -231,12 +162,6 @@ let rec remove k t = match t with t (* not present *) ) -(*$Q & ~count:20 - Q.(list (pair int int)) (fun l -> \ - let l = _list_uniq l in let m = of_list l in \ - List.for_all (fun (k,_) -> mem k m && not (mem k (remove k m))) l) -*) - let update k f t = try let v = find_exn k t in @@ -249,13 +174,6 @@ let update k f t = | None -> t | Some v -> add k v t -(*$= & ~printer:Q.Print.(list (pair int int)) - [1,1; 2, 22; 3, 3] \ - (of_list [1,1;2,2;3,3] \ - |> update 2 (function None -> assert false | Some _ -> Some 22) \ - |> to_list |> List.sort Stdlib.compare) -*) - let doubleton k1 v1 k2 v2 = add k1 v1 (singleton k2 v2) let rec equal ~eq a b = @@ -270,12 +188,6 @@ let rec equal ~eq a b = | L _, _ -> false end -(*$Q - Q.(list (pair int bool)) ( fun l -> \ - CCList.sort_uniq ~cmp:CCOrd.compare l = CCList.sort CCOrd.compare l ==> \ - equal ~eq:(=) (of_list l) (of_list (List.rev l))) -*) - let rec iter f t = match t with | E -> () | L (k, v) -> f k v @@ -335,75 +247,6 @@ let rec union f t1 t2 = join_ t1 p1 t2 p2 ) -(* regression for #329 *) -(*$R -let minus m1 m2 = -union (fun _key v1 v2 -> v1 - v2) m1 m2 in - -let key = 0 in -let m0 = singleton key 1 in (* a map of [key] to the value 1 *) -let m1 = minus m0 m0 in (* a map of [key] to the value 0 *) -let m2 = minus m0 m1 in (* a map of [key] to the value 1 *) -let observed = equal ~eq:(=) m2 m0 in (* [m0] and [m2] should be equal *) -assert_equal true observed - *) - -(*$Q & ~small:(fun (a,b) -> List.length a + List.length b) - Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1,l2) -> \ - check_invariants (union (fun _ _ x -> x) (of_list l1) (of_list l2))) - Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1,l2) -> \ - check_invariants (inter (fun _ _ x -> x) (of_list l1) (of_list l2))) -*) - -(* associativity of union *) -(*$Q & ~small:(fun (a,b,c) -> List.(length a + length b + length c)) - Q.(let p = list (pair int int) in triple p p p) (fun (l1,l2,l3) -> \ - let m1 = of_list l1 and m2 = of_list l2 and m3 = of_list l3 in \ - let f _ x y = max x y in \ - equal ~eq:(=) (union f (union f m1 m2) m3) (union f m1 (union f m2 m3))) -*) - -(*$R - assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp)) - (of_list [1, "1"; 2, "2"; 3, "3"; 4, "4"]) - (union (fun _ a b -> a) - (of_list [1, "1"; 3, "3"]) (of_list [2, "2"; 4, "4"])); -*) - -(*$R - assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp)) - (of_list [1, "1"; 2, "2"; 3, "3"; 4, "4"]) - (union (fun _ a b -> a) - (of_list [1, "1"; 2, "2"; 3, "3"]) (of_list [2, "2"; 4, "4"])) -*) - -(*$Q - Q.(list (pair int bool)) (fun l -> \ - equal ~eq:(=) (of_list l) (union (fun _ a _ -> a) (of_list l)(of_list l))) -*) - -(*$inject - let union_l l1 l2 = - let l2' = List.filter (fun (x,_) -> not @@ List.mem_assoc x l1) l2 in - _list_uniq (l1 @ l2') - - let inter_l l1 l2 = - let l2' = List.filter (fun (x,_) -> List.mem_assoc x l1) l2 in - _list_uniq l2' -*) - -(*$QR - Q.(pair (small_list (pair small_int unit)) (small_list (pair small_int unit))) - (fun (l1,l2) -> - union_l l1 l2 = _list_uniq @@ to_list (union (fun _ _ _ ->())(of_list l1) (of_list l2))) - *) - -(*$QR - Q.(pair (small_list (pair small_int unit)) (small_list (pair small_int unit))) - (fun (l1,l2) -> - inter_l l1 l2 = _list_uniq @@ to_list (inter (fun _ _ _ ->()) (of_list l1) (of_list l2))) - *) - let rec inter f a b = match a, b with | E, _ | _, E -> E @@ -432,26 +275,6 @@ let rec inter f a b = else inter f a r2 ) else E -(*$R - assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp)) - (singleton 2 "2") - (inter (fun _ a b -> a) - (of_list [1, "1"; 2, "2"; 3, "3"]) (of_list [2, "2"; 4, "4"])) -*) - -(*$Q - Q.(list (pair int bool)) (fun l -> \ - equal ~eq:(=) (of_list l) (inter (fun _ a _ -> a) (of_list l)(of_list l))) -*) - -(* associativity of inter *) -(*$Q & ~small:(fun (a,b,c) -> List.(length a + length b + length c)) - Q.(let p = list (pair int int) in triple p p p) (fun (l1,l2,l3) -> \ - let m1 = of_list l1 and m2 = of_list l2 and m3 = of_list l3 in \ - let f _ x y = max x y in \ - equal ~eq:(=) (inter f (inter f m1 m2) m3) (inter f m1 (inter f m2 m3))) -*) - let rec disjoint_union_ t1 t2 : _ t = match t1, t2 with | E, o | o, E -> o | L (k,v), o @@ -478,14 +301,6 @@ let rec filter f m = match m with | N (_,_,l,r) -> disjoint_union_ (filter f l) (filter f r) -(*$QR - Q.(pair (fun2 Observable.int Observable.int bool) (small_list (pair int int))) (fun (f,l) -> - let QCheck.Fun(_,f) = f in - _list_uniq (List.filter (fun (x,y) -> f x y) l) = - (_list_uniq @@ to_list @@ filter f @@ of_list l) - ) -*) - let rec filter_map f m = match m with | E -> E | L (k,v) -> @@ -496,14 +311,6 @@ let rec filter_map f m = match m with | N (_,_,l,r) -> disjoint_union_ (filter_map f l) (filter_map f r) -(*$QR - Q.(pair (fun2 Observable.int Observable.int @@ option bool) (small_list (pair int int))) (fun (f,l) -> - let QCheck.Fun(_,f) = f in - _list_uniq (CCList.filter_map (fun (x,y) -> CCOption.map (CCPair.make x) @@ f x y) l) = - (_list_uniq @@ to_list @@ filter_map f @@ of_list l) - ) -*) - let rec merge ~f t1 t2 : _ t = let merge1 t = filter_map (fun k v -> f k (`Left v)) t @@ -541,42 +348,6 @@ let rec merge ~f t1 t2 : _ t = join_ (merge1 t1) p1 (merge2 t2) p2 ) -(*$inject - let merge_union _x o = match o with - | `Left v | `Right v | `Both (v,_) -> Some v - let merge_inter _x o = match o with - | `Left _ | `Right _ -> None - | `Both (v,_) -> Some v -*) - -(*$QR - Q.(let p = small_list (pair small_int small_int) in pair p p) (fun (l1,l2) -> - check_invariants - (merge ~f:merge_union (of_list l1) (of_list l2))) - *) - -(*$QR - Q.(let p = small_list (pair small_int small_int) in pair p p) (fun (l1,l2) -> - check_invariants - (merge ~f:merge_inter (of_list l1) (of_list l2))) - *) - -(*$QR - Q.(let p = small_list (pair small_int unit) in pair p p) (fun (l1,l2) -> - let l1 = _list_uniq l1 and l2 = _list_uniq l2 in - equal ~eq:Stdlib.(=) - (union (fun _ v1 _ -> v1) (of_list l1) (of_list l2)) - (merge ~f:merge_union (of_list l1) (of_list l2))) - *) - -(*$QR - Q.(let p = small_list (pair small_int unit) in pair p p) (fun (l1,l2) -> - let l1 = _list_uniq l1 and l2 = _list_uniq l2 in - equal ~eq:Stdlib.(=) - (inter (fun _ v1 _ -> v1) (of_list l1) (of_list l2)) - (merge ~f:merge_inter (of_list l1) (of_list l2))) - *) - (** {2 Conversions} *) type 'a iter = ('a -> unit) -> unit @@ -588,25 +359,6 @@ let of_list l = add_list empty l let to_list t = fold (fun k v l -> (k,v) :: l) t [] -(*$Q - Q.(list (pair int int)) (fun l -> \ - let l = List.map (fun (k,v) -> abs k,v) l in \ - let rec is_sorted = function [] | [_] -> true \ - | x::y::tail -> x <= y && is_sorted (y::tail) in \ - of_list l |> to_list |> List.rev_map fst |> is_sorted) -*) - -(*$Q - Q.(list (pair int int)) (fun l -> \ - of_list l |> cardinal = List.length (l |> List.map fst |> CCList.sort_uniq ~cmp:CCInt.compare)) - Q.(list (pair small_int int)) (fun l -> \ - of_list l |> cardinal = List.length (l |> List.map fst |> CCList.sort_uniq ~cmp:CCInt.compare)) -*) - -(*$= & ~printer:Q.Print.int - 1 (let t = of_list [(197151390, 0); (197151390, 0)] in cardinal t) - *) - let add_iter t iter = let t = ref t in iter (fun (k,v) -> t := add k v !t); @@ -641,16 +393,6 @@ let to_gen m = in next -(*$T - doubleton 1 "a" 2 "b" |> to_gen |> of_gen |> to_list \ - |> List.sort Stdlib.compare = [1, "a"; 2, "b"] -*) - -(*$Q - Q.(list (pair int bool)) (fun l -> \ - let m = of_list l in equal ~eq:(=) m (m |> to_gen |> of_gen)) -*) - (* E < L < N; arbitrary order for switches *) let compare ~cmp a b = let rec cmp_gen cmp a b = match a(), b() with @@ -667,31 +409,6 @@ let compare ~cmp a b = in cmp_gen cmp (to_gen a) (to_gen b) -(*$Q - Q.(list (pair int bool)) ( fun l -> \ - let m1 = of_list l and m2 = of_list (List.rev l) in \ - compare ~cmp:Stdlib.compare m1 m2 = 0) - -*) - -(*$QR - Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1, l2) -> - let l1 = List.map (fun (k,v) -> abs k,v) l1 in - let l2 = List.map (fun (k,v) -> abs k,v) l2 in - let m1 = of_list l1 and m2 = of_list l2 in - let c = compare ~cmp:Stdlib.compare m1 m2 - and c' = compare ~cmp:Stdlib.compare m2 m1 in - (c = 0) = (c' = 0) && (c < 0) = (c' > 0) && (c > 0) = (c' < 0)) -*) - -(*$QR - Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1, l2) -> - let l1 = List.map (fun (k,v) -> abs k,v) l1 in - let l2 = List.map (fun (k,v) -> abs k,v) l2 in - let m1 = of_list l1 and m2 = of_list l2 in - (compare ~cmp:Stdlib.compare m1 m2 = 0) = equal ~eq:(=) m1 m2) -*) - let rec add_seq m l = match l() with | Seq.Nil -> m | Seq.Cons ((k,v), tl) -> add_seq (add k v m) tl @@ -710,11 +427,6 @@ let to_seq m = in next [m] -(*$Q - Q.(list (pair int bool)) (fun l -> \ - let m = of_list l in equal ~eq:(=) m (m |> to_seq |> of_seq)) -*) - type 'a tree = unit -> [`Nil | `Node of 'a * 'a tree list] let rec as_tree t () = match t with @@ -742,166 +454,3 @@ let pp pp_x out m = (* Some thorough tests from Jan Midtgaar https://github.com/jmid/qc-ptrees *) - -(*$inject - let test_count = 2_500 - - open QCheck - - type instr_tree = - | Empty - | Singleton of int * int - | Add of int * int * instr_tree - | Remove of int * instr_tree - | Union of instr_tree * instr_tree - | Inter of instr_tree * instr_tree - - let rec to_string (a:instr_tree): string = - let int_to_string = string_of_int in - match a with - | Empty -> "Empty" - | Singleton (k,v) -> Printf.sprintf "Singleton(%d,%d)" k v - | Add (k,v,t) -> Printf.sprintf "Add(%d,%d," k v ^ (to_string t) ^ ")" - | Remove (n,t) -> "Remove (" ^ (int_to_string n) ^ ", " ^ (to_string t) ^ ")" - | Union (t,t') -> "Union (" ^ (to_string t) ^ ", " ^ (to_string t') ^ ")" - | Inter (t,t') -> "Inter (" ^ (to_string t) ^ ", " ^ (to_string t') ^ ")" - - let merge_f _ x y = min x y - - let rec interpret t : _ t = match t with - | Empty -> empty - | Singleton (k,v) -> singleton k v - | Add (k,v,t) -> add k v (interpret t) - | Remove (n,t) -> remove n (interpret t) - | Union (t,t') -> - let s = interpret t in - let s' = interpret t' in - union merge_f s s' - | Inter (t,t') -> - let s = interpret t in - let s' = interpret t' in - inter merge_f s s' - - let tree_gen int_gen : instr_tree Q.Gen.t = - let open Gen in - sized - (fix (fun recgen n -> match n with - | 0 -> oneof [return Empty; - Gen.map2 (fun i j -> Singleton (i,j)) int_gen int_gen] - | _ -> - frequency - [ (1, return Empty); - (1, map2 (fun k v -> Singleton (k,v)) int_gen int_gen); - (2, map3 (fun i j t -> Add (i,j,t)) int_gen int_gen (recgen (n-1))); - (2, map2 (fun i t -> Remove (i,t)) int_gen (recgen (n-1))); - (2, map2 (fun l r -> Union (l,r)) (recgen (n/2)) (recgen (n/2))); - (2, map2 (fun l r -> Inter (l,r)) (recgen (n/2)) (recgen (n/2))); - ])) - - let (<+>) = Q.Iter.(<+>) - - let rec tshrink t : instr_tree Q.Iter.t = match t with - | Empty -> Iter.empty - | Singleton (k,v) -> - (Iter.return Empty) - <+> (Iter.map (fun k' -> Singleton (k',v)) (Shrink.int k)) - <+> (Iter.map (fun v' -> Singleton (k,v')) (Shrink.int v)) - | Add (k,v,t) -> - (Iter.of_list [Empty; t; Singleton (k,v)]) - <+> (Iter.map (fun t' -> Add (k,v,t')) (tshrink t)) - <+> (Iter.map (fun k' -> Add (k',v,t)) (Shrink.int k)) - <+> (Iter.map (fun v' -> Add (k,v',t)) (Shrink.int v)) - | Remove (i,t) -> - (Iter.of_list [Empty; t]) - <+> (Iter.map (fun t' -> Remove (i,t')) (tshrink t)) - <+> (Iter.map (fun i' -> Remove (i',t)) (Shrink.int i)) - | Union (t0,t1) -> - (Iter.of_list [Empty;t0;t1]) - <+> (Iter.map (fun t0' -> Union (t0',t1)) (tshrink t0)) - <+> (Iter.map (fun t1' -> Union (t0,t1')) (tshrink t1)) - | Inter (t0,t1) -> - (Iter.of_list [Empty;t0;t1]) - <+> (Iter.map (fun t0' -> Inter (t0',t1)) (tshrink t0)) - <+> (Iter.map (fun t1' -> Inter (t0,t1')) (tshrink t1)) - - let arb_int = - frequency - [(5,small_signed_int); - (3,int); - (1, oneofl [min_int;max_int])] - - let arb_tree = - make ~print:to_string ~shrink:tshrink - (tree_gen arb_int.gen) - - let empty_m = [] - let singleton_m k v = [k,v] - let mem_m i s = List.mem_assoc i s - let rec remove_m i s = match s with - | [] -> [] - | (j,v)::s' -> if i=j then s' else (j,v)::(remove_m i s') - let add_m k v s = List.sort Stdlib.compare ((k,v)::remove_m k s) - let rec union_m s s' = match s,s' with - | [], _ -> s' - | _, [] -> s - | (k1,v1)::is,(k2,v2)::js -> - if k1k2 then (k2,v2)::(union_m s js) else - (k1,min v1 v2)::(union_m is js) - let rec inter_m s s' = match s with - | [] -> [] - | (k,v)::s -> - if List.mem_assoc k s' - then (k,min v (List.assoc k s'))::(inter_m s s') - else inter_m s s' - - let abstract s = List.sort Stdlib.compare (fold (fun k v acc -> (k,v)::acc) s []) -*) - -(* A bunch of agreement properties *) - -(*$= - empty_m (let s = empty in abstract s) -*) - -(*$QR & ~count:test_count - (Q.pair arb_int arb_int) (fun (k,v) -> - abstract (singleton k v) = singleton_m k v) -*) - -(*$QR & ~count:test_count - Q.(pair arb_tree arb_int) - (fun (t,n) -> - let s = interpret t in - mem n s = mem_m n (abstract s)) -*) - -(*$QR & ~count:test_count - (triple arb_tree arb_int arb_int) - (fun (t,k,v) -> - let s = interpret t in - abstract (add k v s) = add_m k v (abstract s)) -*) - -(*$QR & ~count:test_count - (pair arb_tree arb_int) - (fun (t,n) -> - let s = interpret t in - abstract (remove n s) = remove_m n (abstract s)) -*) - -(*$QR & ~count:test_count - (pair arb_tree arb_tree) - (fun (t,t') -> - let s = interpret t in - let s' = interpret t' in - abstract (union merge_f s s') = union_m (abstract s) (abstract s')) -*) - -(*$QR & ~count:test_count - Q.(pair arb_tree arb_tree) - (fun (t,t') -> - let s = interpret t in - let s' = interpret t' in - abstract (inter merge_f s s') = inter_m (abstract s) (abstract s')) -*) diff --git a/src/data/CCIntMap.mli b/src/data/CCIntMap.mli index 7dfb9c5b..3bd3737f 100644 --- a/src/data/CCIntMap.mli +++ b/src/data/CCIntMap.mli @@ -1,6 +1,4 @@ -(* This file is free software, part of containers. See file "license" for more details. *) - (** Map specialized for Int keys {b status: stable} diff --git a/src/data/CCLazy_list.ml b/src/data/CCLazy_list.ml index 5c6ec50c..5a608eca 100644 --- a/src/data/CCLazy_list.ml +++ b/src/data/CCLazy_list.ml @@ -29,10 +29,6 @@ let length l = in aux 0 l -(*$Q - Q.(list int) (fun l -> length (of_list l) = List.length l) -*) - let rec map ~f l = lazy ( match l with @@ -48,11 +44,6 @@ let filter ~f l = in lazy (aux f l) -(*$= - [2;4;6] (of_list [1;2;3;4;5;6;7] |> filter ~f:(fun x -> x mod 2=0) |> to_list) - [2;4;6] (of_gen Gen.(1 -- max_int) |> filter ~f:(fun x -> x mod 2=0) |> take 3 |> to_list) -*) - let rec take n l = lazy ( match l with @@ -68,11 +59,6 @@ let rec append a b = | lazy (Cons (x,tl)) -> Cons (x, append tl b) ) -(*$Q - Q.(pair (list int) (list int)) (fun (l1,l2) ->\ - length (append (of_list l1) (of_list l2)) = List.length l1 + List.length l2) -*) - let rec flat_map ~f l = lazy ( match l with @@ -89,10 +75,6 @@ let default ~default l = | lazy l -> l ) -(*$= - [1] (default ~default:(return 1) empty |> to_list) -*) - module Infix = struct let (>|=) x f = map ~f x let (>>=) x f = flat_map ~f x @@ -110,10 +92,6 @@ let rec of_gen g = | Some x -> Cons (x, of_gen g) ) -(*$Q - Q.(list int) (fun l -> l = (Gen.of_list l |> of_gen |> to_list)) -*) - let rec of_list = function | [] -> empty | x :: tl -> cons x (of_list tl) @@ -127,16 +105,8 @@ let to_list_rev l = let to_list l = List.rev (to_list_rev l) -(*$Q - Q.(list int) (fun l -> l = to_list (of_list l)) -*) - let to_gen l = let l = ref l in fun () -> match !l with | lazy Nil -> None | lazy (Cons (x,tl)) -> l := tl; Some x - -(*$Q - Q.(list int) (fun l -> l = (of_list l |> to_gen |> Gen.to_list)) -*) diff --git a/src/data/CCMixmap.ml b/src/data/CCMixmap.ml index 10befe19..92b58893 100644 --- a/src/data/CCMixmap.ml +++ b/src/data/CCMixmap.ml @@ -3,28 +3,6 @@ (** {1 Maps with Heterogeneous Values} *) -(*$R - let module M = CCMixmap.Make(CCInt) in - - let inj_int = CCMixmap.create_inj() in - let inj_str = CCMixmap.create_inj() in - let inj_list_int = CCMixmap.create_inj() in - - let m = - M.empty - |> M.add ~inj:inj_int 1 1 - |> M.add ~inj:inj_str 2 "2" - |> M.add ~inj:inj_list_int 3 [3;3;3] - in - - assert_equal (M.get ~inj:inj_int 1 m) (Some 1) ; - assert_equal (M.get ~inj:inj_str 1 m) None ; - assert_equal (M.get ~inj:inj_str 2 m) (Some "2") ; - assert_equal (M.get ~inj:inj_int 2 m) None ; - assert_equal (M.get ~inj:inj_list_int 3 m) (Some [3;3;3]) ; - assert_equal (M.get ~inj:inj_str 3 m) None ; -*) - type 'b injection = { get : (unit -> unit) -> 'b option; set : 'b -> (unit -> unit); diff --git a/src/data/CCMixset.ml b/src/data/CCMixset.ml index 86a65860..7c4e185c 100644 --- a/src/data/CCMixset.ml +++ b/src/data/CCMixset.ml @@ -8,22 +8,6 @@ module IMap = Map.Make(struct let compare : int -> int -> int = compare end) -(*$R - let k1 : int key = newkey () in - let k2 : int key = newkey () in - let k3 : string key = newkey () in - let set = - empty - |> set ~key:k1 1 - |> set ~key:k2 2 - |> set ~key:k3 "3" - in - assert (get ~key:k1 set = Some 1); - assert (get ~key:k2 set = Some 2); - assert (get ~key:k3 set = Some "3"); - () -*) - type t = (unit -> unit) IMap.t and 'a key = { id: int; diff --git a/src/data/CCMixtbl.ml b/src/data/CCMixtbl.ml index c3d9ac66..ccb59ecb 100644 --- a/src/data/CCMixtbl.ml +++ b/src/data/CCMixtbl.ml @@ -3,32 +3,11 @@ (** {1 Hash Table with Heterogeneous Keys} *) -(*$inject - open CCFun - -*) - type 'b injection = { get : (unit -> unit) -> 'b option; set : 'b -> (unit -> unit); } -(*$R - let inj_int = create_inj () in - let tbl = create 10 in - OUnit2.assert_equal None (get ~inj:inj_int tbl "a"); - set ~inj:inj_int tbl "a" 1; - OUnit2.assert_equal (Some 1) (get ~inj:inj_int tbl "a"); - let inj_string = create_inj () in - set ~inj:inj_string tbl "b" "Hello"; - OUnit2.assert_equal (Some "Hello") (get ~inj:inj_string tbl "b"); - OUnit2.assert_equal None (get ~inj:inj_string tbl "a"); - OUnit2.assert_equal (Some 1) (get ~inj:inj_int tbl "a"); - set ~inj:inj_string tbl "a" "Bye"; - OUnit2.assert_equal None (get ~inj:inj_int tbl "a"); - OUnit2.assert_equal (Some "Bye") (get ~inj:inj_string tbl "a"); -*) - type 'a t = ('a, unit -> unit) Hashtbl.t let create n = Hashtbl.create n @@ -53,33 +32,8 @@ let set ~inj tbl x y = let length tbl = Hashtbl.length tbl -(*$R - let inj_int = create_inj () in - let tbl = create 5 in - set ~inj:inj_int tbl "foo" 1; - set ~inj:inj_int tbl "bar" 2; - OUnit2.assert_equal 2 (length tbl); - OUnit2.assert_equal 2 (find ~inj:inj_int tbl "bar"); - set ~inj:inj_int tbl "foo" 42; - OUnit2.assert_equal 2 (length tbl); - remove tbl "bar"; - OUnit2.assert_equal 1 (length tbl); -*) - let clear tbl = Hashtbl.clear tbl -(*$R - let inj_int = create_inj () in - let inj_str = create_inj () in - let tbl = create 5 in - set ~inj:inj_int tbl "foo" 1; - set ~inj:inj_int tbl "bar" 2; - set ~inj:inj_str tbl "baaz" "hello"; - OUnit2.assert_equal 3 (length tbl); - clear tbl; - OUnit2.assert_equal 0 (length tbl); -*) - let remove tbl x = Hashtbl.remove tbl x let copy tbl = Hashtbl.copy tbl @@ -93,21 +47,6 @@ let mem ~inj tbl x = is_some (inj.get (Hashtbl.find tbl x)) with Not_found -> false -(*$R - let inj_int = create_inj () in - let inj_str = create_inj () in - let tbl = create 5 in - set ~inj:inj_int tbl "foo" 1; - set ~inj:inj_int tbl "bar" 2; - set ~inj:inj_str tbl "baaz" "hello"; - OUnit2.assert_bool "mem foo int" (mem ~inj:inj_int tbl "foo"); - OUnit2.assert_bool "mem bar int" (mem ~inj:inj_int tbl "bar"); - OUnit2.assert_bool "not mem baaz int" (not (mem ~inj:inj_int tbl "baaz")); - OUnit2.assert_bool "not mem foo str" (not (mem ~inj:inj_str tbl "foo")); - OUnit2.assert_bool "not mem bar str" (not (mem ~inj:inj_str tbl "bar")); - OUnit2.assert_bool "mem baaz str" (mem ~inj:inj_str tbl "baaz"); -*) - let find ~inj tbl x = match inj.get (Hashtbl.find tbl x) with | None -> raise Not_found @@ -128,17 +67,6 @@ let keys_iter tbl yield = (fun x _ -> yield x) tbl -(*$R - let inj_int = create_inj () in - let inj_str = create_inj () in - let tbl = create 5 in - set ~inj:inj_int tbl "foo" 1; - set ~inj:inj_int tbl "bar" 2; - set ~inj:inj_str tbl "baaz" "hello"; - let l = keys_iter tbl |> Iter.to_list in - OUnit2.assert_equal ["baaz"; "bar"; "foo"] (List.sort compare l); -*) - let bindings_of ~inj tbl yield = Hashtbl.iter (fun k value -> @@ -154,17 +82,3 @@ let bindings tbl yield = Hashtbl.iter (fun x y -> yield (x, Value (fun inj -> inj.get y))) tbl - -(*$R - let inj_int = create_inj () in - let inj_str = create_inj () in - let tbl = create 5 in - set ~inj:inj_int tbl "foo" 1; - set ~inj:inj_int tbl "bar" 2; - set ~inj:inj_str tbl "baaz" "hello"; - set ~inj:inj_str tbl "str" "rts"; - let l_int = bindings_of ~inj:inj_int tbl |> Iter.to_list in - OUnit2.assert_equal ["bar", 2; "foo", 1] (List.sort compare l_int); - let l_str = bindings_of ~inj:inj_str tbl |> Iter.to_list in - OUnit2.assert_equal ["baaz", "hello"; "str", "rts"] (List.sort compare l_str); -*) diff --git a/src/data/CCMultiSet.ml b/src/data/CCMultiSet.ml index b6bc318e..87916f5c 100644 --- a/src/data/CCMultiSet.ml +++ b/src/data/CCMultiSet.ml @@ -258,12 +258,3 @@ module Make(O : Set.OrderedType) = struct seq (fun (x,n) -> m := add_mult !m x n); !m end - -(*$T - let module S = CCMultiSet.Make(String) in \ - S.count (S.add_mult S.empty "a" 5) "a" = 5 - let module S = CCMultiSet.Make(String) in \ - S.count (S.remove_mult (S.add_mult S.empty "a" 5) "a" 3) "a" = 2 - let module S = CCMultiSet.Make(String) in \ - S.count (S.remove_mult (S.add_mult S.empty "a" 4) "a" 6) "a" = 0 -*) diff --git a/src/data/CCMutHeap.ml b/src/data/CCMutHeap.ml index 10d6b110..2c260713 100644 --- a/src/data/CCMutHeap.ml +++ b/src/data/CCMutHeap.ml @@ -144,78 +144,3 @@ module Make(Elt : RANKED) = struct x end [@@inline] - -(*$inject - type elt = { - x: string; - mutable rank: int; - mutable idx: int; - } - module Elt = struct - type t = elt - let idx x = x.idx - let set_idx x i = x.idx <- i - let lt a b = - if a.rank = b.rank then a.x < b.x else a.rank < b.rank - end - module H = CCMutHeap.Make(Elt) -*) - -(*$R - let h = H.create() in - let x1 = {x="a"; rank=10; idx= -1} in - let x2 = {x="b"; rank=10; idx= -1} in - let x3 = {x="c"; rank=10; idx= -1} in - H.insert h x1; - assert (H.in_heap x1); - assert (not (H.in_heap x2)); - assert (not (H.in_heap x3)); - H.insert h x2; - H.insert h x3; - - assert (Elt.lt x1 x2); - assert (Elt.lt x2 x3); - - let x = H.remove_min h in - assert (x == x1); - - let x = H.remove_min h in - assert (x == x2); - - let x = H.remove_min h in - assert (x == x3); - - assert (try ignore (H.remove_min h); false with Not_found -> true); - - *) - -(*$R - let h = H.create() in - let x1 = {x="a"; rank=10; idx= -1} in - let x2 = {x="b"; rank=10; idx= -1} in - let x3 = {x="c"; rank=10; idx= -1} in - H.insert h x1; - H.insert h x2; - H.insert h x3; - - x3.rank <- 2; - H.decrease h x3; - - assert (Elt.lt x3 x1); - assert (Elt.lt x3 x2); - - let x = H.remove_min h in - assert (x == x3); - - x1.rank <- 20; - H.increase h x1; - - let x = H.remove_min h in - assert (x == x2); - - let x = H.remove_min h in - assert (x == x1); - - assert (try ignore (H.remove_min h); false with Not_found -> true); - - *) diff --git a/src/data/CCPersistentArray.ml b/src/data/CCPersistentArray.ml index 914bcea0..1b038c6e 100644 --- a/src/data/CCPersistentArray.ml +++ b/src/data/CCPersistentArray.ml @@ -99,13 +99,6 @@ let flat_map f a = let a' = map f a in flatten a' -(*$T - of_list [ of_list [1]; of_list []; of_list [2;3;4]; of_list [5]; of_list [6;7]] \ - |> flatten |> to_list = [1;2;3;4;5;6;7] - of_list [ of_list []; of_list []; of_list []] |> flatten |> length = 0 - of_list [] |> flatten |> length = 0 -*) - let to_array t = Array.copy (reroot t) let of_array a = init (Array.length a) (fun i -> a.(i)) @@ -156,11 +149,6 @@ let to_gen a = Some x ) -(*$Q - Q.(list int) (fun l -> \ - of_list l |> to_gen |> of_gen |> to_list = l) -*) - type 'a printer = Format.formatter -> 'a -> unit let pp pp_item out v = diff --git a/src/data/CCPersistentHashtbl.ml b/src/data/CCPersistentHashtbl.ml index f5abee52..1f9517dd 100644 --- a/src/data/CCPersistentHashtbl.ml +++ b/src/data/CCPersistentHashtbl.ml @@ -118,27 +118,6 @@ module type S = sig @since 0.14 *) end -(*$inject - module H = Make(CCInt) - - let my_list = - [ 1, "a"; - 2, "b"; - 3, "c"; - 4, "d"; - ] - - let my_iter = Iter.of_list my_list - - let _list_uniq = CCList.sort_uniq - ~cmp:(fun a b -> Stdlib.compare (fst a) (fst b)) - - let _list_int_int = Q.( - map_same_type _list_uniq - (list_of_size Gen.(0 -- 40) (pair small_int small_int)) - ) -*) - (** {2 Implementation} *) module Make(H : HashedType) : S with type key = H.t = struct @@ -222,41 +201,6 @@ module Make(H : HashedType) : S with type key = H.t = struct | Cons (k4,v4,l4) -> if H.equal k k4 then v4 else find_rec_ k l4 - (*$R - let h = H.of_iter my_iter in - OUnit2.assert_equal "a" (H.find h 1); - OUnit2.assert_raises Not_found (fun () -> H.find h 5); - let h' = H.replace h 5 "e" in - OUnit2.assert_equal "a" (H.find h' 1); - OUnit2.assert_equal "e" (H.find h' 5); - OUnit2.assert_equal "a" (H.find h 1); - OUnit2.assert_raises Not_found (fun () -> H.find h 5); - *) - - (*$R - let n = 10000 in - let seq = Iter.map (fun i -> i, string_of_int i) Iter.(0--n) in - let h = H.of_iter seq in - Iter.iter - (fun (k,v) -> - OUnit2.assert_equal ~printer:(fun x -> x) v (H.find h k)) - seq; - OUnit2.assert_raises Not_found (fun () -> H.find h (n+1)); - *) - - (*$QR - _list_int_int - (fun l -> - let h = H.of_list l in - List.for_all - (fun (k,v) -> - try - H.find h k = v - with Not_found -> false) - l - ) - *) - let get_exn k t = find t k let get k t = @@ -267,20 +211,6 @@ module Make(H : HashedType) : S with type key = H.t = struct try ignore (find t k); true with Not_found -> false - (*$R - let h = H.of_iter - Iter.(map (fun i -> i, string_of_int i) - (0 -- 200)) in - OUnit2.assert_equal 201 (H.length h); - *) - - (*$QR - _list_int_int (fun l -> - let h = H.of_list l in - H.length h = List.length l - ) - *) - let rec buck_rev_iter_ ~f l = match l with | Nil -> () | Cons (k,v,l') -> buck_rev_iter_ ~f l'; f k v @@ -369,26 +299,6 @@ module Make(H : HashedType) : S with type key = H.t = struct t' ) - (*$R - let h = H.of_iter my_iter in - OUnit2.assert_equal "a" (H.find h 1); - OUnit2.assert_raises Not_found (fun () -> H.find h 5); - let h1 = H.add h 5 "e" in - OUnit2.assert_equal "a" (H.find h1 1); - OUnit2.assert_equal "e" (H.find h1 5); - OUnit2.assert_equal "a" (H.find h 1); - let h2 = H.add h1 5 "ee" in - OUnit2.assert_equal "ee" (H.find h2 5); - OUnit2.assert_raises Not_found (fun () -> H.find h 5); - let h3 = H.remove h2 1 in - OUnit2.assert_equal "ee" (H.find h3 5); - OUnit2.assert_raises Not_found (fun () -> H.find h3 1); - let h4 = H.remove h3 5 in - OUnit2.assert_equal "e" (H.find h4 5); - OUnit2.assert_equal "ee" (H.find h3 5); - *) - - (* return [Some l'] if [l] changed into [l'] by removing [k] *) let rec remove_rec_ k l = match l with | Nil -> None @@ -413,36 +323,6 @@ module Make(H : HashedType) : S with type key = H.t = struct t.arr <- Set (i,l,t'); t' - (*$R - let h = H.of_iter my_iter in - OUnit2.assert_equal (H.find h 2) "b"; - OUnit2.assert_equal (H.find h 3) "c"; - OUnit2.assert_equal (H.find h 4) "d"; - OUnit2.assert_equal (H.length h) 4; - let h = H.remove h 2 in - OUnit2.assert_equal (H.find h 3) "c"; - OUnit2.assert_equal (H.length h) 3; - OUnit2.assert_raises Not_found (fun () -> H.find h 2) - *) - - (*$R - let open Iter.Infix in - let n = 10000 in - let seq = Iter.map (fun i -> i, string_of_int i) (0 -- n) in - let h = H.of_iter seq in - OUnit2.assert_equal (n+1) (H.length h); - let h = Iter.fold (fun h i -> H.remove h i) h (0 -- 500) in - OUnit2.assert_equal (n-500) (H.length h); - OUnit2.assert_bool "is_empty" (H.is_empty (H.create 16)); - *) - - (*$QR - _list_int_int (fun l -> - let h = H.of_list l in - let h = List.fold_left (fun h (k,_) -> H.remove h k) h l in - H.is_empty h) - *) - let update t k f = let v = get k t in match v, f v with @@ -559,22 +439,6 @@ module Make(H : HashedType) : S with type key = H.t = struct | Some v' -> replace tbl k v' ) tbl t2 - (*$R - let t1 = H.of_list [1, "a"; 2, "b1"] in - let t2 = H.of_list [2, "b2"; 3, "c"] in - let t = H.merge - ~f:(fun _ -> function - | `Right v2 -> Some v2 - | `Left v1 -> Some v1 - | `Both (s1,s2) -> if s1 < s2 then Some s1 else Some s2) - t1 t2 - in - OUnit2.assert_equal ~printer:string_of_int 3 (H.length t); - OUnit2.assert_equal "a" (H.find t 1); - OUnit2.assert_equal "b1" (H.find t 2); - OUnit2.assert_equal "c" (H.find t 3); - *) - let add_iter init seq = let tbl = ref init in seq (fun (k,v) -> tbl := replace !tbl k v); @@ -585,46 +449,14 @@ module Make(H : HashedType) : S with type key = H.t = struct let add_list init l = add_iter init (fun k -> List.iter k l) - (*$QR - _list_int_int (fun l -> - let l1, l2 = List.partition (fun (x,_) -> x mod 2 = 0) l in - let h1 = H.of_list l1 in - let h2 = H.add_list h1 l2 in - List.for_all - (fun (k,v) -> H.find h2 k = v) - l - && - List.for_all - (fun (k,v) -> H.find h1 k = v) - l1 - && - List.length l1 = H.length h1 - && - List.length l = H.length h2 - ) - *) - let of_list l = add_list (empty ()) l let to_list t = fold (fun acc k v -> (k,v)::acc) [] t - (*$R - let h = H.of_iter my_iter in - let l = Iter.to_list (H.to_iter h) in - OUnit2.assert_equal my_list (List.sort compare l) - *) - let to_iter t = fun k -> iter t (fun x y -> k (x,y)) - (*$R - let h = H.of_iter my_iter in - OUnit2.assert_equal "b" (H.find h 2); - OUnit2.assert_equal "a" (H.find h 1); - OUnit2.assert_raises Not_found (fun () -> H.find h 42); - *) - let equal eq t1 t2 = length t1 = length t2 && diff --git a/src/data/CCRAL.ml b/src/data/CCRAL.ml index 870e30e4..f1e9a19e 100644 --- a/src/data/CCRAL.ml +++ b/src/data/CCRAL.ml @@ -54,21 +54,6 @@ and tree_update_ size t i v =match t, i with then Node (x, tree_update_ size' t1 (i-1) v, t2) else Node (x, t1, tree_update_ size' t2 (i-1-size') v) -(*$Q & ~small:(CCFun.compose snd List.length) - Q.(pair (pair small_int int) (list int)) (fun ((i,v),l) -> \ - l=[] || \ - (let i = (abs i) mod (List.length l) in \ - let ral = of_list l in let ral = set ral i v in \ - get_exn ral i = v)) -*) - -(*$Q & ~small:List.length - Q.(list small_int) (fun l -> \ - let l1 = of_list l in \ - CCList.mapi (fun i x -> i,x) l \ - |> List.for_all (fun (i,x) -> get_exn l1 i = x)) -*) - let cons x l = match l with | Cons (size1, t1, Cons (size2, t2, l')) when size1=size2 -> Cons (1 + size1 + size2, Node (x, t1, t2), l') @@ -88,17 +73,6 @@ let tl l = match l with let size' = size / 2 in Cons (size', t1, Cons (size', t2, l')) -(*$T - let l = of_list[1;2;3] in hd l = 1 - let l = of_list[1;2;3] in tl l |> to_list = [2;3] -*) - -(*$Q - Q.(list_of_size Gen.(1--100) int) (fun l -> \ - let l' = of_list l in \ - (not (is_empty l')) ==> (equal ~eq:CCInt.equal l' (cons (hd l') (tl l'))) ) -*) - let front l = match l with | Nil -> None | Cons (_, Leaf x, tl) -> Some (x, tl) @@ -121,10 +95,6 @@ let rec _remove prefix l i = let remove l i = _remove [] l i -(*$= & ~printer:Q.Print.(list int) - [1;2;4] (to_list @@ remove (of_list [1;2;3;4]) 2) -*) - let rec _get_and_remove_exn prefix l i = let x, l' = front_exn l in if i=0 @@ -134,10 +104,6 @@ let rec _get_and_remove_exn prefix l i = let get_and_remove_exn l i = _get_and_remove_exn [] l i -(*$= & ~printer:Q.Print.(pair int (list int)) - (3,[1;2;4]) (CCPair.map_snd to_list @@ get_and_remove_exn (of_list [1;2;3;4]) 2) -*) - let rec _map_tree f t = match t with | Leaf x -> Leaf (f x) | Node (x, l, r) -> Node (f x, _map_tree f l, _map_tree f r) @@ -159,20 +125,6 @@ let mapi ~f l = in aux f 0 l -(*$QR - Q.small_int (fun n -> - let l = CCList.(0 -- n) in - let l' = of_list l |> mapi ~f:(fun i x ->i,x) in - List.mapi (fun i x->i,x) l = to_list l' - ) -*) - -(*$Q - Q.(pair (list small_int)(fun2 Observable.int Observable.int bool)) (fun (l,f) -> \ - let f = Q.Fn.apply f in \ - mapi ~f (of_list l) |> to_list = List.mapi f l ) -*) - let rec length l = match l with | Nil -> 0 | Cons (size,_, l') -> size + length l' @@ -229,28 +181,10 @@ and fold_tree_rev t acc f = match t with let rev_map ~f l = fold ~f:(fun acc x -> cons (f x) acc) ~x:empty l -(*$Q - Q.(list int) (fun l -> \ - let f x = x+1 in \ - of_list l |> rev_map ~f |> to_list = List.rev_map f l) -*) - let rev l = fold ~f:cons' ~x:empty l -(*$Q - Q.(list small_int) (fun l -> \ - let l = of_list l in rev (rev l) = l) - Q.(list small_int) (fun l -> \ - let l1 = of_list l in length l1 = List.length l) -*) - let append l1 l2 = fold_rev ~f:(fun l2 x -> cons x l2) ~x:l2 l1 -(*$Q & ~small:(CCPair.merge (CCFun.compose_binop List.length (+))) - Q.(pair (list int) (list int)) (fun (l1,l2) -> \ - append (of_list l1) (of_list l2) = of_list (l1 @ l2)) -*) - let append_tree_ t l = fold_tree_rev t l cons' let filter ~f l = @@ -263,10 +197,6 @@ let filter_map ~f l = | Some y -> cons y acc ) -(*$T - of_list [1;2;3;4;5;6] |> filter ~f:(fun x -> x mod 2=0) |> to_list = [2;4;6] -*) - let flat_map f l = fold_rev ~x:empty l ~f:(fun acc x -> @@ -274,25 +204,8 @@ let flat_map f l = append l acc ) -(*$Q - Q.(pair (fun1 Observable.int (small_list int)) (small_list int)) (fun (f,l) -> \ - let f x = Q.Fn.apply f x in \ - let f' x = f x |> of_list in \ - of_list l |> flat_map f' |> to_list = CCList.(flat_map f l)) -*) - let flatten l = fold_rev ~f:(fun acc l -> append l acc) ~x:empty l -(*$T - flatten (of_list [of_list [1]; of_list []; of_list [2;3]]) = \ - of_list [1;2;3;] -*) - -(*$Q - Q.(small_list (small_list int)) (fun l -> \ - of_list l |> map ~f:of_list |> flatten |> to_list = CCList.flatten l) -*) - let app funs l = fold_rev ~x:empty funs ~f:(fun acc f -> @@ -300,11 +213,6 @@ let app funs l = ~f:(fun acc x -> cons (f x) acc) ) -(*$T - app (of_list [(+) 2; ( * ) 10]) (of_list [1;10]) |> to_list = \ - [3; 12; 10; 100] -*) - type 'a stack = | St_nil | St_list of 'a t * 'a stack @@ -330,17 +238,6 @@ and take_tree_ ~size n t = match t with then cons x (append_tree_ l (take_tree_ ~size:size' (n-size'-1) r)) else cons x (take_tree_ ~size:size' (n-1) l) -(*$T - take 3 (of_list CCList.(1--10)) |> to_list = [1;2;3] - take 5 (of_list CCList.(1--10)) |> to_list = [1;2;3;4;5] - take 0 (of_list CCList.(1--10)) |> to_list = [] -*) - -(*$Q - Q.(pair small_int (list int)) (fun (n,l) -> \ - of_list l |> take n |> to_list = CCList.take n l) -*) - let take_while ~f l = (* st: stack of subtrees *) let rec aux p st = match st with @@ -353,15 +250,6 @@ let take_while ~f l = if p x then cons x (aux p (St_tree (l, St_tree (r, st')))) else Nil in aux f (St_list (l, St_nil)) -(*$Q - Q.(list int) (fun l -> \ - let f x = x mod 7 <> 0 in \ - of_list l |> take_while ~f |> to_list = CCList.take_while f l) - Q.(pair (fun1 Observable.int bool) (list int)) (fun (f,l) -> \ - let f x = Q.Fn.apply f x in \ - of_list l |> take_while ~f |> to_list = CCList.take_while f l) -*) - (* drop [n < size] elements from [t] *) let rec drop_tree_ ~size n t tail = match t with | _ when n=0 -> tail @@ -392,15 +280,6 @@ let rec drop n l = match l with if n >= size then drop (n-size) tl else drop_tree_ ~size n t tl -(*$T - of_list [1;2;3] |> drop 2 |> length = 1 -*) - -(*$Q - Q.(pair small_int (list int)) (fun (n,l) -> \ - of_list l |> drop n |> to_list = CCList.drop n l) -*) - let drop_while ~f l = let rec aux p st = match st with | St_nil -> Nil @@ -415,19 +294,6 @@ let drop_while ~f l = else append_tree_ tree (stack_to_list st') in aux f (St_list (l, St_nil)) -(*$T - drop 3 (of_list CCList.(1--10)) |> to_list = CCList.(4--10) - drop 5 (of_list CCList.(1--10)) |> to_list = [6;7;8;9;10] - drop 0 (of_list CCList.(1--10)) |> to_list = CCList.(1--10) - drop 15 (of_list CCList.(1--10)) |> to_list = [] -*) - -(*$Q - Q.(list_of_size Gen.(0 -- 200) int) (fun l -> \ - let f x = x mod 10 <> 0 in \ - of_list l |> drop_while ~f |> to_list = CCList.drop_while f l) -*) - let take_drop n l = take n l, drop n l let equal ~eq l1 l2 = @@ -446,11 +312,6 @@ let equal ~eq l1 l2 = in aux ~eq l1 l2 -(*$Q - Q.(pair (list int)(list int)) (fun (l1,l2) -> \ - equal ~eq:CCInt.equal (of_list l1) (of_list l2) = (l1=l2)) -*) - (** {2 Utils} *) let make n x = @@ -465,12 +326,6 @@ let repeat n l = in aux n l empty - -(*$Q - Q.(pair small_int (small_list int)) (fun (n,l) -> \ - of_list l |> repeat n |> to_list = CCList.(repeat n l)) -*) - let range i j = let rec aux i j acc = if i=j then cons i acc @@ -481,29 +336,11 @@ let range i j = in aux i j empty -(*$T - range 0 3 |> to_list = [0;1;2;3] - range 3 0 |> to_list = [3;2;1;0] - range 17 17 |> to_list = [17] -*) - -(*$Q - Q.(pair small_int small_int) (fun (i,j) -> \ - range i j |> to_list = CCList.(i -- j) ) -*) - let range_r_open_ i j = if i=j then empty else if i to_list) - [5;4;3;2] (5 --^ 1 |> to_list) - [1] (1 --^ 2 |> to_list) - [] (0 --^ 0 |> to_list) -*) - (** {2 Conversions} *) type 'a iter = ('a -> unit) -> unit @@ -511,19 +348,10 @@ type 'a gen = unit -> 'a option let add_list l l2 = List.fold_left (fun acc x -> cons x acc) l (List.rev l2) -(*$Q & ~small:(CCPair.merge (CCFun.compose_binop List.length (+))) - Q.(pair (list small_int) (list small_int)) (fun (l1,l2) -> \ - add_list (of_list l2) l1 |> to_list = l1 @ l2) -*) - let of_list l = add_list empty l let to_list l = fold_rev ~f:(fun acc x -> x :: acc) ~x:[] l -(*$Q - Q.(list int) (fun l -> to_list (of_list l) = l) -*) - let add_array l a = Array.fold_right cons a l let of_array a = add_array empty a @@ -537,11 +365,6 @@ let to_array l = match l with iteri ~f:(fun i x -> Array.set arr i x) l; arr -(*$Q - Q.(array int) (fun a -> \ - of_array a |> to_array = a) -*) - let of_iter s = let l = ref empty in s (fun x -> l := cons x !l); @@ -554,17 +377,6 @@ let add_iter l s = let to_iter l yield = iter ~f:yield l -(*$Q & ~small:List.length - Q.(list small_int) (fun l -> \ - of_list l |> to_iter |> Iter.to_list = l) - Q.(list small_int) (fun l -> \ - Iter.of_list l |> of_iter |> to_list = l) -*) - -(*$T - add_iter (of_list [3;4]) (Iter.of_list [1;2]) |> to_list = [1;2;3;4] -*) - let rec gen_iter_ f g = match g() with | None -> () | Some x -> f x; gen_iter_ f g @@ -596,12 +408,6 @@ let to_gen l = in next -(*$Q & ~small:List.length - Q.(list small_int) (fun l -> of_list l |> to_gen |> Gen.to_list = l) - Q.(list small_int) (fun l -> \ - Gen.of_list l |> of_gen |> to_list = l) -*) - let rec of_list_map ~f l = match l with | [] -> empty | x::l' -> @@ -619,11 +425,6 @@ let compare ~cmp l1 l2 = in cmp_gen ~cmp (to_gen l1)(to_gen l2) -(*$Q - Q.(pair (list int)(list int)) (fun (l1,l2) -> \ - compare ~cmp:CCInt.compare (of_list l1) (of_list l2) = (Stdlib.compare l1 l2)) -*) - (** {2 Infix} *) module Infix = struct diff --git a/src/data/CCRingBuffer.ml b/src/data/CCRingBuffer.ml index 523f8895..05419e38 100644 --- a/src/data/CCRingBuffer.ml +++ b/src/data/CCRingBuffer.ml @@ -202,13 +202,6 @@ module type S = sig @since 0.11 *) end -(*$inject - open Q.Gen - let g_char = map Char.chr (Char.code 'A' -- Char.code 'z') - let g_str = string_size ~gen:g_char (0--10) - let a_str = Q.set_gen g_str Q.string -*) - module MakeFromArray(A:Array.S) : S with module Array = A = struct module Array = A @@ -230,25 +223,10 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct let copy b = { b with buf=A.copy b.buf; } - (*$T - let b = Byte.of_array (Bytes.of_string "abc") in \ - let b' = Byte.copy b in \ - Byte.clear b; \ - Byte.to_array b' = (Bytes.of_string "abc") && Byte.to_array b = Bytes.empty - *) - let capacity b = let len = A.length b.buf in match len with 0 -> 0 | l -> l - 1 - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - Byte.capacity b >= s_len) - *) - let length b = if b.stop >= b.start then b.stop - b.start @@ -278,44 +256,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct done ) - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - let b' = Byte.copy b in \ - try Byte.iteri b ~f:(fun i c -> if Byte.get_front b' i <> c then raise Exit); true with Exit -> false) - *) - - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - Byte.push_back b 'X'; \ - Byte.peek_back_exn b = 'X') - *) - - (*$Q - (Q.pair a_str a_str) (fun (s,s') -> \ - let b = Byte.create (max (String.length s+String.length s') 64) in \ - let s = Bytes.of_string s in let s' = Bytes.of_string s' in \ - Byte.blit_from b s 0 (Bytes.length s); \ - Byte.blit_from b s' 0 (Bytes.length s'); \ - Byte.length b = Bytes.length s + Bytes.length s') - *) - - - (*$Q - (Q.pair a_str a_str) (fun (s,s') -> \ - let s = Bytes.of_string s in let s' = Bytes.of_string s' in \ - let b = Byte.create (max (Bytes.length s + Bytes.length s') 64) in \ - Byte.blit_from b s 0 (Bytes.length s); \ - Byte.blit_from b s' 0 (Bytes.length s'); \ - Byte.length b = Bytes.length s + Bytes.length s') - *) - - let blit_into b to_buf o len = if o+len > A.length to_buf then ( invalid_arg "CCRingBuffer.blit_into"; @@ -336,26 +276,8 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct ) ) - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let b = Byte.create (max 64 (Bytes.length s)) in \ - Byte.blit_from b s 0 (Bytes.length s); \ - let to_buf = Bytes.create (Bytes.length s) in \ - let len = Byte.blit_into b to_buf 0 (Bytes.length s) in \ - to_buf = s && len = Bytes.length s) - *) - let is_empty b = b.start = b.stop - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - Byte.skip b s_len; \ - Byte.is_empty b) - *) - let take_front_exn b = if b.start = b.stop then raise Empty; let c = A.get b.buf b.start in @@ -365,15 +287,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct let take_front b = try Some (take_front_exn b) with Empty -> None - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - try let front = Byte.take_front_exn b in \ - front = Bytes.get s 0 with Byte.Empty -> s_len = 0) - *) - let take_back_exn b = if b.start = b.stop then raise Empty; if b.stop = 0 @@ -385,16 +298,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct let take_back b = try Some (take_back_exn b) with Empty -> None - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - try let back = Byte.take_back_exn b in \ - back = Bytes.get s (Bytes.length s - 1) \ - with Byte.Empty -> s_len = 0) - *) - let junk_front b = if b.start = b.stop then raise Empty; A.set b.buf b.start A.dummy; @@ -402,15 +305,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct then b.start <- 0 else b.start <- b.start + 1 - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - try let () = Byte.junk_front b in \ - s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0) - *) - let junk_back b = if b.start = b.stop then raise Empty; if b.stop = 0 @@ -418,15 +312,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct else b.stop <- b.stop - 1; A.set b.buf b.stop A.dummy - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - try let () = Byte.junk_back b in \ - s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0) - *) - let skip b len = if len > length b then ( invalid_arg "CCRingBuffer.skip"; @@ -435,31 +320,9 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct junk_front b done - (*$Q - (Q.pair a_str a_str) (fun (s,s') -> \ - let s = Bytes.of_string s in let s' = Bytes.of_string s' in \ - let b = Byte.create (max (Bytes.length s+Bytes.length s') 64) in \ - Byte.blit_from b s 0 (Bytes.length s); \ - Byte.blit_from b s' 0 (Bytes.length s'); \ - let h = Bytes.of_string "hello world" in \ - Byte.blit_from b h 0 (Bytes.length h); (* big enough *) \ - let l = Byte.length b in let l' = l/2 in Byte.skip b l'; \ - Byte.length b + l' = l) - *) - let clear b = skip b (length b) - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - Byte.clear b; \ - Byte.length b = 0) - *) - - let iter b ~f = if b.stop >= b.start then for i = b.start to b.stop - 1 do f (A.get b.buf i) done @@ -476,15 +339,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct for i = 0 to b.stop - 1 do f i (A.get b.buf i) done; ) - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - try Byte.iteri b ~f:(fun i c -> if Byte.get_front b i <> c then raise Exit); \ - true with Exit -> false) - *) - let get b i = if b.stop >= b.start then ( @@ -504,35 +358,12 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct invalid_arg "CCRingBuffer.get_front" ) else get b i - (*$Q - (Q.pair Q.small_int a_str) (fun (i, s) -> \ - let s = Bytes.of_string (s ^ " ") in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - let index = abs (i mod Byte.length b) in \ - let front = Byte.get_front b index in \ - front = Bytes.get s index) - *) - let get_back b i = let offset = ((length b) - i - 1) in if offset < 0 then ( invalid_arg "CCRingBuffer.get_back" ) else get b offset - (*$Q - (Q.pair Q.small_int a_str) (fun (i, s) -> \ - let s = Bytes.of_string (s ^ " ") in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - let index = abs (i mod Byte.length b) in \ - let back = Byte.get_back b index in \ - back = Bytes.get s (s_len - index - 1)) - *) - - let to_list b = let len = length b in let rec build l i = @@ -540,18 +371,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct in build [] (len-1) - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - let l = Byte.to_list b in \ - let explode s = let rec exp i l = \ - if i < 0 then l else exp (i - 1) (Bytes.get s i :: l) in \ - exp (Bytes.length s - 1) [] in \ - explode s = l) - *) - (* TODO: more efficient version, with one or two blit *) let append b ~into = iter b ~f:(push_back into) @@ -562,15 +381,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct let peek_front b = try Some (peek_front_exn b) with Empty -> None - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - try let back = Byte.peek_front_exn b in \ - back = Bytes.get s 0 with Byte.Empty -> s_len = 0) - *) - let peek_back_exn b = if is_empty b then raise Empty else ( @@ -580,15 +390,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct let peek_back b = try Some (peek_back_exn b) with Empty -> None - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let s_len = Bytes.length s in \ - let b = Byte.create (max s_len 64) in \ - Byte.blit_from b s 0 s_len; \ - try let back = Byte.peek_back_exn b in \ - back = Bytes.get s (s_len - 1) with Byte.Empty -> s_len = 0) - *) - let of_array a = let b = create (max (A.length a) 16) in blit_from b a 0 (A.length a); @@ -599,12 +400,6 @@ module MakeFromArray(A:Array.S) : S with module Array = A = struct let n = blit_into b a 0 (length b) in assert (n = length b); a - - (*$Q - a_str (fun s -> let s = Bytes.of_string s in \ - let b = Byte.of_array s in let s' = Byte.to_array b in \ - s = s') - *) end module Byte = MakeFromArray(Array.Byte) @@ -613,244 +408,3 @@ module Make(Elt:sig type t val dummy : t end) = MakeFromArray(Array.Make(Elt)) - - -(*$inject - module BI = CCRingBuffer.Make(struct type t = int let dummy=0 end) -*) - -(* try to trigger an error on resize - see issue #126 *) -(*$R - let b = BI.create 50 in - let st = Random.State.make [| 0 |] in - for _i = 1 to 100_000 do - if Random.State.float st 1.0 < 0.5 then - BI.push_back b 0 - else - let _ = BI.take_front b in () - done -*) - -(* Test against reference implementation (lists) on a succession of - operations. - - Remarks on semantics: - - JUNK_FRONT/JUNK_BACK: try to remove if not empty - SKIP: if at least n elements, skip; else nop -*) - -(*$inject - module BS = CCRingBuffer.Byte - - type op = - | Push_back of char - | Take_front - | Take_back - | Peek_front - | Peek_back - | Junk_front - | Junk_back - | Skip of int - | Blit of string * int * int - | Z_if_full - - let str_of_op = function - | Push_back c -> Printf.sprintf "push_back(%C)" c - | Take_front -> Printf.sprintf "take_front" - | Take_back -> Printf.sprintf "take_back" - | Peek_front -> Printf.sprintf "peek_front" - | Peek_back -> Printf.sprintf "peek_back" - | Junk_front -> Printf.sprintf "junk_front" - | Junk_back -> Printf.sprintf "junk_back" - | Skip n -> Printf.sprintf "skip(%d)" n - | Blit (s,i,len) -> Printf.sprintf "blit(%S,%d,%d)" s i len - | Z_if_full -> "zero_if_full" - - let push_back c = Push_back c - let skip n = assert (n>=0); Skip n - let blit s i len = - if i<0 || len<0 || i+len > String.length s then ( - failwith ("wrong blit: " ^ str_of_op (Blit (s,i,len))); - ); - Blit (s,i,len) - - let shrink_op = - let open Q.Iter in - function - | Push_back c -> Q.Shrink.char c >|= push_back - | Take_front | Take_back | Junk_back | Junk_front - | Z_if_full | Peek_front | Peek_back - -> empty - | Skip n -> Q.Shrink.int n >|= skip - | Blit (s,i,len) -> - let s_i = - Q.Shrink.int i >>= fun i' -> - assert (i' <= i && i' + len <= String.length s); - if i' <= 0 then empty else return (blit s i' len) - and s_len = - Q.Shrink.int len >>= fun len'-> - assert (len' <= len && i + len' <= String.length s); - if len' <= 0 then empty else return (blit s i len') - and s_s = - Q.Shrink.string s >>= fun s' -> - if i+len > String.length s' then empty else return (blit s' i len) - in - append s_i (append s_len s_s) - - let rec len_op size acc = function - | Push_back _ -> min size (acc + 1) - | Take_front | Take_back | Junk_front | Junk_back -> max (acc-1) 0 - | Skip n -> if acc >= n then acc-n else acc - | Z_if_full | Peek_front | Peek_back -> acc - | Blit (_,_,len) -> min size (acc + len) - - let apply_op b = function - | Push_back c -> BS.push_back b c; None - | Take_front -> BS.take_front b - | Take_back -> BS.take_back b - | Junk_front -> (try BS.junk_front b with BS.Empty -> ()); None - | Junk_back -> (try BS.junk_back b with BS.Empty -> ()); None - | Peek_front -> BS.peek_front b - | Peek_back -> BS.peek_back b - | Skip n -> if n <= BS.length b then BS.skip b n; None - | Blit (s,i,len) -> - assert(i+len <= String.length s); - BS.blit_from b (Bytes.unsafe_of_string s) i len; None - | Z_if_full -> if BS.is_full b then Some '0' else None - - let gen_op = - let open Q.Gen in - let g_blit = - string_size ~gen:g_char (5--20) >>= fun s -> - (0 -- String.length s) >>= fun len -> - assert (len >= 0 && len <= String.length s); - (0--(String.length s-len)) >|= fun i -> - blit s i len - in - frequency - [ 3, return Take_back; - 3, return Take_front; - 1, return Junk_back; - 1, return Junk_front; - 1, return Peek_front; - 1, return Peek_back; - 2, g_blit; - 1, (0--5 >|= skip); - 2, map push_back g_char; - 1, return Z_if_full; - ] - - let arb_op = - Q.make - ~shrink:shrink_op - ~print:str_of_op - gen_op - - let arb_ops = Q.list_of_size Q.Gen.(0 -- 20) arb_op - - module L_impl = struct - type t = { - size: int; - mutable l: char list; - } - - let create size = {size; l=[]} - - let normalize_ b = - let n = List.length b.l in - if n>b.size then b.l <- CCList.drop (n-b.size) b.l - - let push_back b c = b.l <- b.l @ [c]; normalize_ b - let take_front b = match b.l with - | [] -> None - | c :: l -> b.l <- l; Some c - let peek_front b = match b.l with [] -> None | x::_ -> Some x - let take_back b = - let n = List.length b.l in - if n=0 then None - else ( - let init, last = CCList.take_drop (n-1) b.l in - let x = List.hd last in - b.l <- init; - Some x - ) - let peek_back b = match b.l with [] -> None | l -> Some (List.hd (List.rev l)) - let junk_front b = ignore (take_front b) - let junk_back b = ignore (take_back b) - let skip b n = - if n <= List.length b.l then ( - CCInt.range' 0 n (fun _ -> junk_front b) - ) - - let blit b s i len = - for j=i to i+len-1 do push_back b (String.get s j) done - - let apply_op b = function - | Push_back c -> push_back b c; None - | Take_front -> take_front b - | Take_back -> take_back b - | Peek_front -> peek_front b - | Peek_back -> peek_back b - | Junk_back -> junk_back b; None - | Junk_front -> junk_front b; None - | Skip n -> skip b n; None - | Blit (s,i,len) -> blit b s i len; None - | Z_if_full -> if b.size = List.length b.l then Some '0' else None - - let to_list b = b.l - end - -*) - -(* check that a lot of operations can be applied without failure, - and that the result has correct length *) -(*$QR & ~count:3_000 - arb_ops (fun ops -> - let size = 64 in - let b = BS.create size in - List.iter (fun o-> ignore (apply_op b o)) ops; - BS.length b = List.fold_left (len_op size) 0 ops) -*) - -(* check identical behavior with list implem *) -(*$QR & ~count:3_000 - arb_ops (fun ops -> - let size = 64 in - let b = BS.create size in - let l = L_impl.create size in - let l1 = CCList.filter_map (apply_op b) ops in - let l2 = CCList.filter_map (L_impl.apply_op l) ops in - l1=l2 && BS.to_list b = L_impl.to_list l) -*) - -(* check that deleted elements can be GCed *) -(*$inject - module BO = CCRingBuffer.Make(struct type t = int option let dummy=None end) - let make_bo () = - let b = BO.create 1000 in - for i = 1 to BO.capacity b do - BO.push_back b (Some i) - done; - b - let test_no_major_blocks clear = - Gc.full_major (); - let live_blocks_before = (Gc.stat ()).live_blocks in - let b = make_bo () in - clear b; - Gc.full_major (); - let live_blocks_after = (Gc.stat ()).live_blocks in - assert (BO.length b = 0); - let diff = live_blocks_after - live_blocks_before in - diff < BO.capacity b / 2 -*) - -(*$T - test_no_major_blocks (fun b -> for _ = 1 to BO.length b do BO.junk_front b; done) - test_no_major_blocks (fun b -> for _ = 1 to BO.length b do BO.junk_back b; done) - test_no_major_blocks (fun b -> for _ = 1 to BO.length b do ignore (BO.take_front b); done) - test_no_major_blocks (fun b -> for _ = 1 to BO.length b do ignore (BO.take_back b); done) - test_no_major_blocks (fun b -> BO.skip b (BO.length b)) - test_no_major_blocks (fun b -> BO.clear b) -*) diff --git a/src/data/CCSimple_queue.ml b/src/data/CCSimple_queue.ml index 13370846..eb840166 100644 --- a/src/data/CCSimple_queue.ml +++ b/src/data/CCSimple_queue.ml @@ -52,12 +52,6 @@ let pop q = try Some (pop_exn q) with Invalid_argument _ -> None -(*$Q - Q.(list small_int) (fun l -> \ - let q = of_list l in \ - equal CCInt.equal (Gen.unfold pop q |> of_gen) q) -*) - let junk q = try let _, q' = pop_exn q in @@ -68,26 +62,8 @@ let map f q = { hd=List.map f q.hd; tl=List.map f q.tl; } let rev q = make_ q.tl q.hd -(*$Q - Q.(list small_int) (fun l -> \ - equal CCInt.equal (of_list l |> rev) (of_list (List.rev l))) - Q.(list small_int) (fun l -> \ - let q = of_list l in \ - equal CCInt.equal q (q |> rev |> rev)) -*) - let length q = List.length q.hd + List.length q.tl -(*$Q - Q.(list small_int)(fun l -> \ - length (of_list l) = List.length l) -*) - -(*$Q - Q.(list small_int)(fun l -> \ - equal CCInt.equal (of_list l) (List.fold_left snoc empty l)) -*) - let fold f acc q = let acc' = List.fold_left f acc q.hd in List.fold_right (fun x acc -> f acc x) q.tl acc' @@ -115,15 +91,6 @@ let add_iter q seq = let of_iter s = add_iter empty s -(*$Q - Q.(list small_int) (fun l -> \ - equal CCInt.equal \ - (of_iter (Iter.of_list l)) \ - (of_list l)) - Q.(list small_int) (fun l -> \ - l = (of_list l |> to_iter |> Iter.to_list)) -*) - let add_seq q l = add_iter q (fun k -> Seq.iter k l) let of_seq l = add_seq empty l @@ -164,23 +131,11 @@ let rec seq_equal eq l1 l2 = match l1(), l2() with let equal eq q1 q2 = seq_equal eq (to_seq q1) (to_seq q2) -(*$Q - Q.(pair (list small_int)(list small_int)) (fun (l1,l2) -> \ - equal CCInt.equal (of_list l1)(of_list l2) = (l1=l2)) -*) - let append q1 q2 = add_seq q1 (fun yield -> to_seq q2 yield) -(*$Q - Q.(pair (list small_int)(list small_int)) (fun (l1,l2) -> \ - equal CCInt.equal \ - (append (of_list l1)(of_list l2)) \ - (of_list (List.append l1 l2))) -*) - module Infix = struct let (>|=) q f = map f q let (<::) = snoc @@ -189,8 +144,6 @@ end include Infix -(** {2 IO} *) - let pp ?(sep=fun out () -> Format.fprintf out ",@ ") pp_item out l = let first = ref true in iter diff --git a/src/data/CCTrie.ml b/src/data/CCTrie.ml index ff2a955f..a053ee0c 100644 --- a/src/data/CCTrie.ml +++ b/src/data/CCTrie.ml @@ -115,32 +115,6 @@ module type S = sig (**/**) end -(*$inject - module T = MakeList(CCInt) - module S = String - - let l1 = [ [1;2], "12"; [1], "1"; [2;1], "21"; [1;2;3], "123"; [], "[]" ] - let t1 = T.of_list l1 - - let small_l l = List.fold_left (fun acc (k,v) -> List.length k+acc) 0 l - - let s1 = String.of_list ["cat", 1; "catogan", 2; "foo", 3] -*) - -(*$T - String.of_list ["a", 1; "b", 2] |> String.size = 2 - String.of_list ["a", 1; "b", 2; "a", 3] |> String.size = 2 - String.of_list ["a", 1; "b", 2] |> String.find_exn "a" = 1 - String.of_list ["a", 1; "b", 2] |> String.find_exn "b" = 2 - String.of_list ["a", 1; "b", 2] |> String.find "c" = None - - s1 |> String.find_exn "cat" = 1 - s1 |> String.find_exn "catogan" = 2 - s1 |> String.find_exn "foo" = 3 - s1 |> String.find "cato" = None -*) - - module Make(W : WORD) : S with type char_ = W.char_ and type key = W.t = struct @@ -307,14 +281,6 @@ module Make(W : WORD) let remove k t = update k (fun _ -> None) t - (*$T - T.add [3] "3" t1 |> T.find_exn [3] = "3" - T.add [3] "3" t1 |> T.find_exn [1;2] = "12" - T.remove [1;2] t1 |> T.find [1;2] = None - T.remove [1;2] t1 |> T.find [1] = Some "1" - T.remove [1;2] t1 |> T.find [] = Some "[]" - *) - let find_exn k t = (* at subtree [t], and character [c] *) let goto t c = match t with @@ -360,20 +326,6 @@ module Make(W : WORD) let word = W.to_iter k in _fold_iter_and_then goto ~finish (t,_id) word - (*$= & ~printer:CCFun.id - "ca" (String.longest_prefix "carte" s1) - "" (String.longest_prefix "yolo" s1) - "cat" (String.longest_prefix "cat" s1) - "catogan" (String.longest_prefix "catogan" s1) - *) - - (*$Q - Q.(pair (list (pair (printable_string_of_size Gen.(0 -- 30)) int)) printable_string) (fun (l,s) -> \ - let m = String.of_list l in \ - let s' = String.longest_prefix s m in \ - CCString.prefix ~pre:s' s) - *) - (* fold that also keeps the path from the root, so as to provide the list of chars that lead to a value. The path is a difference list, ie a function that prepends a list to some suffix *) @@ -396,11 +348,6 @@ module Make(W : WORD) f acc key v) _id t acc - (*$T - T.fold (fun acc k v -> (k,v) :: acc) [] t1 \ - |> List.sort Stdlib.compare = List.sort Stdlib.compare l1 - *) - let mapi f t = let rec map_ prefix t = match t with | Empty -> Empty @@ -417,12 +364,6 @@ module Make(W : WORD) in Node (v', map') in map_ _id t - (*$= & ~printer:Q.Print.(list (pair (list int) string)) - (List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Stdlib.compare) \ - (T.mapi (fun k v -> v ^ "!") t1 \ - |> T.to_list |> List.sort Stdlib.compare) - *) - let map f t = let rec map_ = function | Empty -> Empty @@ -434,12 +375,6 @@ module Make(W : WORD) in let map' = M.map map_ map in Node (v', map') in map_ t - (*$= & ~printer:Q.Print.(list (pair (list int) string)) - (List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Stdlib.compare) \ - (T.map (fun v -> v ^ "!") t1 \ - |> T.to_list |> List.sort Stdlib.compare) - *) - let iter f t = _fold @@ -512,17 +447,6 @@ module Make(W : WORD) in _mk_node v map' - (*$QR & ~count:30 - Q.(let p = list_of_size Gen.(0--100) (pair printable_string small_int) in pair p p) - (fun (l1,l2) -> - let t1 = S.of_list l1 and t2 = S.of_list l2 in - let t = S.merge (fun a _ -> Some a) t1 t2 in - S.to_iter t |> Iter.for_all - (fun (k,v) -> S.find k t1 = Some v || S.find k t2 = Some v) && - S.to_iter t1 |> Iter.for_all (fun (k,v) -> S.find k t <> None) && - S.to_iter t2 |> Iter.for_all (fun (k,v) -> S.find k t <> None)) - *) - let rec size t = match t with | Empty -> 0 | Cons (_, t') -> size t' @@ -532,10 +456,6 @@ module Make(W : WORD) (fun _ t' acc -> size t' + acc) map s - (*$T - T.size t1 = List.length l1 - *) - let to_list t = fold (fun acc k v -> (k,v)::acc) [] t let of_list l = @@ -561,8 +481,6 @@ module Make(W : WORD) let l = M.bindings map in `Node(x, List.map (fun (c,t') -> _tree_node (`Char c) [to_tree t']) l) - (** {6 Ranges} *) - (* stack of actions for [above] and [below] *) type 'a alternative = | Yield of 'a * char_ difflist @@ -668,70 +586,6 @@ module Make(W : WORD) let below key t = _half_range ~dir:Below ~p:(fun ~cur ~other -> W.compare cur other > 0) key t - - (*$= & ~printer:CCFormat.(to_string (list (pair (list int) string))) - [ [1], "1"; [1;2], "12"; [1;2;3], "123"; [2;1], "21" ] \ - (T.above [1] t1 |> Iter.to_list) - [ [1;2], "12"; [1;2;3], "123"; [2;1], "21" ] \ - (T.above [1;1] t1 |> Iter.to_list) - [ [1;2], "12"; [1], "1"; [], "[]" ] \ - (T.below [1;2] t1 |> Iter.to_list) - [ [1], "1"; [], "[]" ] \ - (T.below [1;1] t1 |> Iter.to_list) - *) - - (* NOTE: Regression test. See #158 *) - (*$T - let module TPoly = Make (struct \ - type t = (unit -> char) list \ - type char_ = char \ - let compare = compare \ - let to_iter a k = List.iter (fun c -> k (c ())) a \ - let of_list l = List.map (fun c -> (fun () -> c)) l \ - end) \ - in \ - let trie = TPoly.of_list [[fun () -> 'a'], 1; [fun () -> 'b'], 2] in \ - ignore (TPoly.below [fun () -> 'a'] trie |> Iter.to_list); \ - true - *) - - (*$Q & ~count:30 - Q.(list_of_size Gen.(0--100) (pair printable_string small_int)) (fun l -> \ - let t = S.of_list l in \ - S.check_invariants t) - *) - - (*$inject - let rec sorted ~rev = function - | [] | [_] -> true - | x :: ((y ::_) as tl) -> - (if rev then x >= y else x <= y) && sorted ~rev tl - - let gen_str = Q.small_printable_string - *) - - (*$Q & ~count:200 - Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) \ - (fun l -> let t = String.of_list l in \ - List.for_all (fun (k,_) -> \ - String.above k t |> Iter.for_all (fun (k',v) -> k' >= k)) \ - l) - Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) \ - (fun l -> let t = String.of_list l in \ - List.for_all (fun (k,_) -> \ - String.below k t |> Iter.for_all (fun (k',v) -> k' <= k)) \ - l) - Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) \ - (fun l -> let t = String.of_list l in \ - List.for_all (fun (k,_) -> \ - String.above k t |> Iter.to_list |> sorted ~rev:false) \ - l) - Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) \ - (fun l -> let t = String.of_list l in \ - List.for_all (fun (k,_) -> \ - String.below k t |> Iter.to_list |> sorted ~rev:true) \ - l) - *) end module type ORDERED = sig diff --git a/src/data/CCWBTree.ml b/src/data/CCWBTree.ml index f0024676..e06f2145 100644 --- a/src/data/CCWBTree.ml +++ b/src/data/CCWBTree.ml @@ -8,39 +8,6 @@ The coefficients 5/2, 3/2 for balancing come from "balancing weight-balanced trees" *) -(*$inject - module M = Make(CCInt) - - type op = - | Add of int * int - | Remove of int - | Remove_min - - let gen_op = CCRandom.(choose_exn - [ return Remove_min - ; map (fun x->Remove x) small_int - ; pure (fun x y->Add (x,y)) <*> small_int <*> small_int]) - and pp_op =let open Printf in - function Add (x,y) -> sprintf "Add %d %d" x y - | Remove x -> sprintf "Remove %d" x | Remove_min -> "Remove_min" - - let apply_ops l m = List.fold_left - (fun m -> function - | Add (i,b) -> M.add i b m - | Remove i -> M.remove i m - | Remove_min -> - try let _, _, m' = M.extract_min m in m' with Not_found -> m - ) m l - - let op = Q.make ~print:pp_op gen_op - - let _list_uniq = CCList.sort_uniq ~cmp:(CCFun.compose_binop fst Stdlib.compare) -*) - -(*$Q & ~count:200 - Q.(list op) (fun l -> let m = apply_ops l M.empty in M.balanced m) -*) - type 'a iter = ('a -> unit) -> unit type 'a gen = unit -> 'a option type 'a printer = Format.formatter -> 'a -> unit @@ -289,18 +256,6 @@ module MakeFull(K : KEY) : S with type key = K.t = struct | n when n<0 -> balance_r k' v' (add k v l) r | _ -> balance_l k' v' l (add k v r) - (*$Q - Q.(list (pair small_int bool)) (fun l -> \ - let m = M.of_list l in \ - M.balanced m) - Q.(list (pair small_int small_int)) (fun l -> \ - let l = _list_uniq l in let m = M.of_list l in \ - List.for_all (fun (k,v) -> M.get_exn k m = v) l) - Q.(list (pair small_int small_int)) (fun l -> \ - let l = _list_uniq l in let m = M.of_list l in \ - M.cardinal m = List.length l) - *) - (* extract min binding of the tree *) let rec extract_min m = match m with | E -> raise Not_found @@ -341,16 +296,6 @@ module MakeFull(K : KEY) : S with type key = K.t = struct | n when n<0 -> balance_l k' v' (remove k l) r | _ -> balance_r k' v' l (remove k r) - (*$Q - Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) (fun l -> \ - let m = M.of_list l in \ - List.for_all (fun (k,_) -> \ - M.mem k m && (let m' = M.remove k m in not (M.mem k m'))) l) - Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) (fun l -> \ - let m = M.of_list l in \ - List.for_all (fun (k,_) -> let m' = M.remove k m in M.balanced m') l) - *) - let update k f m = let maybe_v = get k m in match maybe_v, f maybe_v with @@ -373,11 +318,6 @@ module MakeFull(K : KEY) : S with type key = K.t = struct try Some (nth_exn i m) with Not_found -> None - (*$T - let m = CCList.(0 -- 1000 |> map (fun i->i,i) |> M.of_list) in \ - List.for_all (fun i -> M.nth_exn i m = (i,i)) CCList.(0--1000) - *) - let get_rank k m = let rec aux i k m = match m with | E -> if i=0 then `First else `After i @@ -389,17 +329,6 @@ module MakeFull(K : KEY) : S with type key = K.t = struct in aux 0 k m - (*$QR & ~count:1_000 - Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) (fun l -> - let l = CCList.sort_uniq ~cmp:(CCFun.compose_binop fst compare) l in - let m = M.of_list l in - List.for_all - (fun (k,v) -> match M.get_rank k m with - | `First | `After _ -> true - | `At n -> (k,v) = M.nth_exn n m) - l) - *) - let rec fold ~f ~x:acc m = match m with | E -> acc | N (k, v, l, r, _) -> @@ -494,20 +423,6 @@ module MakeFull(K : KEY) : S with type key = K.t = struct let rl, o, rr = split k r in node_ k' v' l rl, o, rr - (*$QR & ~count:20 - Q.(list_of_size Gen.(1 -- 100) (pair small_int small_int)) ( fun lst -> - let lst = _list_uniq lst in - let m = M.of_list lst in - List.for_all (fun (k,v) -> - let l, v', r = M.split k m in - v' = Some v - && (M.to_iter l |> Iter.for_all (fun (k',_) -> k' < k)) - && (M.to_iter r |> Iter.for_all (fun (k',_) -> k' > k)) - && M.balanced m - && M.cardinal l + M.cardinal r + 1 = List.length lst - ) lst) - *) - let rec merge ~f a b = match a, b with | E, E -> E | E, N (k, v, l, r, _) -> @@ -531,28 +446,6 @@ module MakeFull(K : KEY) : S with type key = K.t = struct mk_node_or_join_ k1 (f k1 (Some v1) v2') (merge ~f l1 l2') (merge ~f r1 r2') - (*$R - let m1 = M.of_list [1, 1; 2, 2; 4, 4] in - let m2 = M.of_list [1, 1; 3, 3; 4, 4; 7, 7] in - let m = M.merge ~f:(fun k -> CCOption.map2 (+)) m1 m2 in - assert_bool "balanced" (M.balanced m); - assert_equal - ~cmp:(CCList.equal (CCPair.equal CCInt.equal CCInt.equal)) - ~printer:CCFormat.(to_string (list (pair int int))) - [1, 2; 4, 8] - (M.to_list m |> List.sort Stdlib.compare) - *) - - (*$QR - Q.(let p = list (pair small_int small_int) in pair p p) (fun (l1, l2) -> - let l1 = _list_uniq l1 and l2 = _list_uniq l2 in - let m1 = M.of_list l1 and m2 = M.of_list l2 in - let m = M.merge ~f:(fun _ v1 v2 -> match v1 with - | None -> v2 | Some _ as r -> r) m1 m2 in - List.for_all (fun (k,v) -> M.get_exn k m = v) l1 && - List.for_all (fun (k,v) -> M.mem k m1 || M.get_exn k m = v) l2) - *) - let cardinal m = fold ~f:(fun acc _ _ -> acc+1) ~x:0 m let add_list m l = List.fold_left (fun acc (k,v) -> add k v acc) m l diff --git a/src/data/CCZipper.ml b/src/data/CCZipper.ml index da89786c..f4a4e759 100644 --- a/src/data/CCZipper.ml +++ b/src/data/CCZipper.ml @@ -11,24 +11,10 @@ let is_empty = function | [], [] -> true | _ -> false -(*$T - (is_empty empty) - not ([42] |> make |> right |> is_empty) -*) - let to_list (l,r) = List.rev_append l r let to_rev_list (l,r) = List.rev_append r l -(*$inject - let zip_gen = Q.(pair (small_list int)(small_list int)) -*) - -(*$Q - zip_gen (fun z -> \ - to_list z = List.rev (to_rev_list z)) -*) - let make l = [], l let left = function @@ -67,11 +53,6 @@ let focused = function | _, x::_ -> Some x | _, [] -> None -(*$Q - zip_gen (fun g -> \ - is_focused g = (focused g |> CCOption.is_some)) -*) - let focused_exn = function | _, x::_ -> x | _, [] -> raise Not_found @@ -82,11 +63,6 @@ let remove (l,r) = match r with | [] -> l, [] | _ :: r' -> l, r' -(*$Q - Q.(triple int (list small_int)(list small_int)) (fun (x,l,r) -> \ - insert x (l,r) |> remove = (l,r)) -*) - let drop_before (_, r) = [], r let drop_after (l, r) = match r with @@ -94,9 +70,3 @@ let drop_after (l, r) = match r with | x :: _ -> l, [x] let drop_after_and_focused (l, _) = l, [] - -(*$= - ([1], [2]) (drop_after ([1], [2;3])) - ([1], []) (drop_after ([1], [])) - ([1], []) (drop_after_and_focused ([1], [2;3])) -*) diff --git a/tests/data/dune b/tests/data/dune index ce956cc4..c8de630d 100644 --- a/tests/data/dune +++ b/tests/data/dune @@ -2,4 +2,4 @@ (name t) (flags :standard -strict-sequence -warn-error -a+8 -open CCShims_) (modes native) - (libraries containers containers-data containers_testlib iter)) + (libraries containers containers-data containers_testlib iter gen)) diff --git a/tests/data/t.ml b/tests/data/t.ml index 22060cf6..2f4685b8 100644 --- a/tests/data/t.ml +++ b/tests/data/t.ml @@ -5,4 +5,22 @@ Containers_testlib.run_all ~descr:"containers-data" [ T_bitfield.Test.get(); T_cache.Test.get(); T_deque.Test.get(); + T_fqueue.Test.get(); + T_fun_vec.Test.get(); + T_graph.Test.get(); + T_hashset.Test.get(); + T_hashtrie.Test.get(); + T_het.Test.get(); + T_immutarray.Test.get(); + T_intmap.Test.get(); + T_lazylist.Test.get(); + T_misc.Test.get(); + T_mutheap.Test.get(); + T_persistenthashtbl.Test.get(); + T_ral.Test.get(); + T_ringbuffer.Test.get(); + T_simplequeue.Test.get(); + T_trie.Test.get(); + T_wbt.Test.get(); + T_zipper.Test.get(); ];; diff --git a/tests/data/t_fqueue.ml b/tests/data/t_fqueue.ml new file mode 100644 index 00000000..61c8f4b7 --- /dev/null +++ b/tests/data/t_fqueue.ml @@ -0,0 +1,126 @@ + + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCFQueue;; + +let pp_ilist = CCFormat.(to_string (list int));; + +t @@ fun () -> + let q = empty in + assert_bool "is_empty" (is_empty q); + true;; + +q (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> + cons x (of_list l) |> to_list = x::l);; + +q (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> + snoc (of_list l) x |> to_list = l @ [x]);; + +t @@ fun () -> + let q = List.fold_left snoc empty [1;2;3;4;5] in + let q = tail q in + let q = List.fold_left snoc q [6;7;8] in + let l = Iter.to_list (to_iter q) in + assert_equal ~printer:pp_ilist [2;3;4;5;6;7;8] l; + true ;; + +q (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> + let x', q = cons x (of_list l) |> take_front_exn in + x'=x && to_list q = l);; + +t @@ fun () -> + let q = of_list [1;2;3;4] in + let x, q = take_front_exn q in + assert_equal 1 x; + let q = List.fold_left snoc q [5;6;7] in + assert_equal 2 (first_exn q); + let x, _q = take_front_exn q in + assert_equal 2 x; + true;; + +t @@ fun () -> take_front empty = None;; + +t @@ fun () -> + let l, q = take_front_l 5 (1 -- 10) in + l = [1;2;3;4;5] && to_list q = [6;7;8;9;10];; + +t @@ fun () -> take_front_while (fun x-> x<5) (1 -- 10) |> fst = [1;2;3;4];; + +q (Q.pair Q.int (Q.list Q.int)) (fun (x,l) -> + let q,x' = snoc (of_list l) x |> take_back_exn in + x'=x && to_list q = l);; + +t @@ fun () -> take_back empty = None;; + +q (Q.list Q.int) (fun l -> + size (of_list l) = List.length l);; + +t @@ fun () -> + let l = CCList.(0--100) in let q = of_list l in + List.map (fun i->nth_exn i q) l = l;; + +q ~count:30 + (Q.list Q.int) (fun l -> + let len = List.length l in let idx = CCList.(0 -- (len - 1)) in + let q = of_list l in + l = [] || List.for_all (fun i -> nth i q = Some (List.nth l i)) idx);; + +q (Q.list Q.int) (fun l -> + l = [] || (of_list l |> init |> to_list = List.rev (List.tl (List.rev l))));; + +q (Q.list Q.int) (fun l -> + l = [] || (of_list l |> tail |> to_list = List.tl l));; + +q Q.(pair (list int) (list int)) (fun (l1, l2) -> + add_iter_front (Iter.of_list l1) (of_list l2) |> to_list = l1 @ l2);; + +q (Q.list Q.int) (fun l -> + of_list l |> to_iter |> Iter.to_list = l);; + +q (Q.pair (Q.list Q.int)(Q.list Q.int)) (fun (l1,l2) -> + append (of_list l1) (of_list l2) |> to_list = l1 @ l2) ;; + +t @@ fun () -> + let q1 = of_iter (Iter.of_list [1;2;3;4]) in + let q2 = of_iter (Iter.of_list [5;6;7;8]) in + let q = append q1 q2 in + let l = Iter.to_list (to_iter q) in + assert_equal ~printer:pp_ilist [1;2;3;4;5;6;7;8] l; + true;; + +q Q.(pair (list int) (list int)) (fun (l1, l2) -> + add_seq_front (CCList.to_seq l1) (of_list l2) |> to_list = l1 @ l2);; + +q (Q.list Q.int) (fun l -> + of_list l |> to_seq |> CCList.of_seq = l);; + +q (Q.list Q.int) (fun l -> + of_list l |> map string_of_int |> to_list = List.map string_of_int l);; + +q (Q.list Q.int) (fun l -> + of_list l |> fold (fun acc x->x::acc) [] = List.rev l);; + +t @@ fun () -> + let q = of_iter (Iter.of_list [1;2;3;4]) in + let n = fold (+) 0 q in + assert_equal 10 n; + true;; + +q (Q.list Q.int) (fun l -> + Iter.of_list l |> of_iter |> to_list = l);; + +q (Q.list Q.int) (fun l -> + of_list l |> rev |> to_list = List.rev l);; + +t @@ fun () -> + let q1 = 1 -- 10 and q2 = append (1 -- 5) (6 -- 10) in + equal (=) q1 q2;; + +t @@ fun () -> 1 -- 5 |> to_list = [1;2;3;4;5];; +t @@ fun () -> 5 -- 1 |> to_list = [5;4;3;2;1];; +t @@ fun () -> 0 -- 0 |> to_list = [0];; +t @@ fun () -> 1 --^ 5 |> to_list = [1;2;3;4];; +t @@ fun () -> 5 --^ 1 |> to_list = [5;4;3;2];; +t @@ fun () -> 1 --^ 2 |> to_list = [1];; +t @@ fun () -> 0 --^ 0 |> to_list = [];; diff --git a/tests/data/t_fun_vec.ml b/tests/data/t_fun_vec.ml new file mode 100644 index 00000000..bf79dd89 --- /dev/null +++ b/tests/data/t_fun_vec.ml @@ -0,0 +1,65 @@ + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCFun_vec;; + + + +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 _listuniq (fun l -> + let m = of_list l in + List.for_all (fun (i,y) -> get_exn i m = y) @@ List.mapi CCPair.make l);; + +(* regression test for #298 *) +t @@ fun () -> + let rec consume x = match CCFun_vec.pop x with + | None -> () | Some (_, x) -> consume x + in + consume (of_list (CCList.(1 -- 100))); + true;; + +q Q.(pair int (small_list int)) (fun (x,l) -> + let q0 = of_list l in + let q = push x q0 in + assert_equal (length q) (length q0+1); + let y, q = pop_exn 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 |> Gen.of_list |> of_gen |> to_gen |> Gen.to_list + |> List.sort Stdlib.compare) );; + +t @@ fun () -> choose empty = None;; +t @@ fun () -> choose (of_list [1,1; 2,2]) <> None;; diff --git a/tests/data/t_graph.ml b/tests/data/t_graph.ml new file mode 100644 index 00000000..6b38d3e0 --- /dev/null +++ b/tests/data/t_graph.ml @@ -0,0 +1,68 @@ + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCGraph;; + +t @@ fun () -> + let l = + let tbl = mk_table ~eq:CCInt.equal 128 in + Traverse.Event.dfs ~tbl ~eq:CCInt.equal ~graph:divisors_graph (Iter.return 345614) + |> Iter.to_list in + let expected = + [`Enter (345614, 0, []); `Edge (345614, (), 172807, `Forward); + `Enter (172807, 1, [(345614, (), 172807)]); `Edge (172807, (), 1, `Forward); + `Enter (1, 2, [(172807, (), 1); (345614, (), 172807)]); `Exit 1; `Exit 172807; + `Edge (345614, (), 2, `Forward); `Enter (2, 3, [(345614, (), 2)]); + `Edge (2, (), 1, `Cross); `Exit 2; `Edge (345614, (), 1, `Cross); + `Exit 345614] + in + assert_equal expected l; + true;; + +t @@ fun () -> + let tbl = mk_table ~eq:CCInt.equal 128 in + let l = topo_sort ~eq:CCInt.equal ~tbl ~graph:divisors_graph (Iter.return 42) in + List.for_all (fun (i,j) -> + let idx_i = CCList.find_idx ((=)i) l |> CCOption.get_exn_or "" |> fst in + let idx_j = CCList.find_idx ((=)j) l |> CCOption.get_exn_or "" |> fst in + idx_i < idx_j) + [ 42, 21; 14, 2; 3, 1; 21, 7; 42, 3];; + +t @@ fun () -> + let tbl = mk_table ~eq:CCInt.equal 128 in + let l = topo_sort ~eq:CCInt.equal ~rev:true ~tbl ~graph:divisors_graph (Iter.return 42) in + List.for_all (fun (i,j) -> + let idx_i = CCList.find_idx ((=)i) l |> CCOption.get_exn_or "" |> fst in + let idx_j = CCList.find_idx ((=)j) l |> CCOption.get_exn_or "" |> fst in + idx_i > idx_j) + [ 42, 21; 14, 2; 3, 1; 21, 7; 42, 3];; + +(* example from https://en.wikipedia.org/wiki/Strongly_connected_component *) +t @@ fun () -> + let set_eq ?(eq=(=)) l1 l2 = CCList.subset ~eq l1 l2 && CCList.subset ~eq l2 l1 in + let graph = of_list ~eq:CCString.equal + [ "a", "b" + ; "b", "e" + ; "e", "a" + ; "b", "f" + ; "e", "f" + ; "f", "g" + ; "g", "f" + ; "b", "c" + ; "c", "g" + ; "c", "d" + ; "d", "c" + ; "d", "h" + ; "h", "d" + ; "h", "g" + ] in + let tbl = mk_table ~eq:CCString.equal 128 in + let res = scc ~tbl ~graph (Iter.return "a") |> Iter.to_list in + assert_bool "scc" + (set_eq ~eq:(set_eq ?eq:None) res + [ [ "a"; "b"; "e" ] + ; [ "f"; "g" ] + ; [ "c"; "d"; "h" ] + ] + ); + true;; diff --git a/tests/data/t_hashset.ml b/tests/data/t_hashset.ml new file mode 100644 index 00000000..257c63bd --- /dev/null +++ b/tests/data/t_hashset.ml @@ -0,0 +1,22 @@ + + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCHashSet;; + +t @@ fun () -> let module IS = Make(CCInt) in IS.cardinal (IS.create 10) = 0;; + +t @@ fun () -> let module IS = Make(CCInt) in IS.find (IS.of_list [1;2;3]) 3 = Some 3;; +t @@ fun () -> let module IS = Make(CCInt) in IS.find (IS.of_list [1;2;3]) 5 = None;; + +t @@ fun () -> + let module IS = Make(CCInt) in + IS.(equal (inter (of_list [1;2;3]) (of_list [2;5;4])) (of_list [2]));; + +t @@ fun () -> + let module IS = Make(CCInt) in + IS.(equal (union (of_list [1;2;3]) (of_list [2;5;4])) (of_list [1;2;3;4;5]));; + +t @@ fun () -> + let module IS = Make(CCInt) in + IS.(equal (diff (of_list [1;2;3]) (of_list [2;4;5])) (of_list [1;3]));; diff --git a/tests/data/t_hashtrie.ml b/tests/data/t_hashtrie.ml new file mode 100644 index 00000000..58a76cb7 --- /dev/null +++ b/tests/data/t_hashtrie.ml @@ -0,0 +1,108 @@ + + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCHashTrie;; + + +module M = Make(CCInt) ;; + +let _listuniq = + let g = Q.(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 () -> M.is_empty M.empty;; + +t @@ fun () -> not (M.is_empty (M.singleton 1 2));; +t @@ fun () -> M.cardinal (M.singleton 1 2) = 1;; +t @@ fun () -> popcount 5L = 2;; +t @@ fun () -> popcount 256L = 1;; +t @@ fun () -> popcount 255L = 8;; +t @@ fun () -> popcount 0xFFFFL = 16;; +t @@ fun () -> popcount 0xFF1FL = 13;; +t @@ fun () -> popcount 0xFFFFFFFFL = 32;; +t @@ fun () -> popcount 0xFFFFFFFFFFFFFFFFL = 64;; + +q Q.int (fun i -> let i = Int64.of_int i in popcount i <= 64);; + +q _listuniq (fun l -> + let m = M.of_list l in + List.for_all (fun (x,y) -> M.get_exn x m = y) l);; + +q _listuniq (fun l -> + let m = List.fold_left (fun m (x,y) -> M.add x y m) M.empty l in + List.for_all (fun (x,y) -> M.get_exn x m = y) l);; + +t @@ fun () -> + let lsort = List.sort Stdlib.compare in + let m = M.of_list [1, 1; 2, 2] in + let id = Transient.create() in + let m' = M.add_mut ~id 3 3 m in + let m' = M.add_mut ~id 4 4 m' in + assert_equal [1, 1; 2, 2] (M.to_list m |> lsort); + assert_equal [1, 1; 2, 2; 3,3; 4,4] (M.to_list m' |> lsort); + Transient.freeze id; + assert_bool "must raise" + (try ignore(M.add_mut ~id 5 5 m'); false with Transient.Frozen -> true); + true;; + + +q _listuniq (fun l -> + let m = M.of_list l in + List.for_all + (fun (x,_) -> + let m' = M.remove x m in + not (M.mem x m') && + M.cardinal m' = M.cardinal m - 1 && + List.for_all + (fun (y,v) -> y = x || M.get_exn y m' = v) + l + ) l +);; + +t @@ fun () -> + let m = M.of_list [1, 1; 2, 2; 5, 5] in + let m' = M.update 4 + ~f:(function + | None -> Some 4 + | Some _ -> Some 0 + ) m + in + assert_equal [1,1; 2,2; 4,4; 5,5] (M.to_list m' |> List.sort Stdlib.compare); + true;; + +t @@ fun () -> + let l = CCList.(1 -- 10 |> map (fun x->x,x)) in + M.of_list l + |> M.fold ~f:(fun acc x y -> (x,y)::acc) ~x:[] + |> List.sort Stdlib.compare = l ;; + +q _listuniq (fun l -> + (List.sort Stdlib.compare l) = + (l |> Iter.of_list |> M.of_iter |> M.to_iter |> Iter.to_list + |> List.sort Stdlib.compare) );; + +q _listuniq (fun l -> + (List.sort Stdlib.compare l) = + (l |> Gen.of_list |> M.of_gen |> M.to_gen |> Gen.to_list + |> List.sort Stdlib.compare) );; + +t @@ fun () -> M.choose M.empty = None;; +t @@ fun () -> M.choose M.(of_list [1,1; 2,2]) <> None;; + +t @@ fun () -> + let m = M.of_list CCList.( (501 -- 1000) @ (500 -- 1) |> map (fun i->i,i)) in + assert_equal ~printer:CCInt.to_string 1000 (M.cardinal m); + assert_bool "check all get" + (Iter.for_all (fun i -> i = M.get_exn i m) Iter.(1 -- 1000)); + let m = Iter.(501 -- 1000 |> fold (fun m i -> M.remove i m) m) in + assert_equal ~printer:CCInt.to_string 500 (M.cardinal m); + assert_bool "check all get after remove" + (Iter.for_all (fun i -> i = M.get_exn i m) Iter.(1 -- 500)); + assert_bool "check all get after remove" + (Iter.for_all (fun i -> None = M.get i m) Iter.(501 -- 1000)); + true;; diff --git a/tests/data/t_het.ml b/tests/data/t_het.ml new file mode 100644 index 00000000..b64971d8 --- /dev/null +++ b/tests/data/t_het.ml @@ -0,0 +1,32 @@ + + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCHet;; + +t @@ fun () -> + let k1 : int Key.t = Key.create() in + let k2 : int Key.t = Key.create() in + let k3 : string Key.t = Key.create() in + let k4 : float Key.t = Key.create() in + + let tbl = Tbl.create () in + + Tbl.add tbl k1 1; + Tbl.add tbl k2 2; + Tbl.add tbl k3 "k3"; + + assert_equal (Some 1) (Tbl.find tbl k1); + assert_equal (Some 2) (Tbl.find tbl k2); + assert_equal (Some "k3") (Tbl.find tbl k3); + assert_equal None (Tbl.find tbl k4); + assert_equal 3 (Tbl.length tbl); + + Tbl.add tbl k1 10; + assert_equal (Some 10) (Tbl.find tbl k1); + assert_equal 3 (Tbl.length tbl); + assert_equal None (Tbl.find tbl k4); + + Tbl.add tbl k4 0.0; + assert_equal (Some 0.0) (Tbl.find tbl k4); + true diff --git a/tests/data/t_immutarray.ml b/tests/data/t_immutarray.ml new file mode 100644 index 00000000..bf84c95c --- /dev/null +++ b/tests/data/t_immutarray.ml @@ -0,0 +1,48 @@ + + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCImmutArray;; + +let print_array f a = to_list a |> Array.of_list |> Q.Print.(array f);; + +eq ~printer:(print_array Q.Print.int) + (of_list [0]) (set (of_list [5]) 0 0);; +eq ~printer:(print_array Q.Print.int) + (of_list [1; 3; 4; 5]) (set (of_list [1; 2; 4; 5]) 1 3);; + +let eq' = eq ~printer:(print_array Q.Print.int) ;; +eq' empty (append empty empty);; +eq' (of_list [1; 2; 3]) (append empty (of_list [1; 2; 3]));; +eq' (of_list [1; 2; 3]) (append (of_list [1; 2; 3]) empty);; +eq' (of_list [3; 1; 4; 1; 5]) (append (of_list [3; 1]) (of_list [4; 1; 5]));; + +eq ~printer:Q.Print.(list (pair int string)) + ([2, "baz"; 1, "bar"; 0, "foo"]) + (foldi (fun l i a -> (i, a) :: l) [] (of_list ["foo"; "bar"; "baz"]));; + +let eq' = eq ~printer:Q.Print.bool;; +eq' true (for_all (fun _ -> false) empty);; +eq' false (for_all (fun _ -> false) (singleton 3));; +eq' true (for_all (fun n -> n mod 2 = 0) (of_list [2; 4; 8]));; +eq' false (for_all (fun n -> n mod 2 = 0) (of_list [2; 4; 5; 8]));; + +eq' false (exists (fun _ -> true) empty);; +eq' true (exists (fun _ -> true) (singleton 3));; +eq' false (exists (fun _ -> false) (singleton 3));; +eq' false (exists (fun n -> n mod 2 = 1) (of_list [2; 4; 8]));; +eq' true (exists (fun n -> n mod 2 = 1) (of_list [2; 4; 5; 8]));; + +q Q.(list bool) (fun l -> let a = of_list l in not @@ exists (fun b -> b) a = for_all not a);; +q Q.(list bool) (fun l -> let a = of_list l in not @@ for_all (fun b -> b) a = exists not a);; + +q Q.(list bool) (fun l -> exists (fun b -> b) (of_list l) = List.fold_left (||) false l);; +q Q.(list bool) (fun l -> for_all (fun b -> b) (of_list l) = List.fold_left (&&) true l);; + +q Q.(list int) (fun l -> + let g = Iter.of_list l in + of_iter g |> to_iter |> Iter.to_list = l);; + +q Q.(list int) (fun l -> + let g = Gen.of_list l in + of_gen g |> to_gen |> Gen.to_list = l);; diff --git a/tests/data/t_intmap.ml b/tests/data/t_intmap.ml new file mode 100644 index 00000000..7f1d01eb --- /dev/null +++ b/tests/data/t_intmap.ml @@ -0,0 +1,377 @@ + + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCIntMap;; + +let highest2 x : int = + let rec aux i = + if i=0 then i + else if 1 = (x lsr i) then 1 lsl i else aux (i-1) + in + if x<0 then min_int else aux (Sys.word_size-2);; + +q ~count:1_000 + Q.int (fun x -> + if Bit.equal_int (highest2 x) (Bit.highest x) then true + else QCheck.Test.fail_reportf "x=%d, highest=%d, highest2=%d@." x + (Bit.highest x :> int) (highest2 x));; + +let _list_uniq l = CCList.sort_uniq ~cmp:(fun a b-> Stdlib.compare (fst a)(fst b)) l;; + +q Q.(small_list (pair int int)) (fun l -> + let m = of_list l in + is_empty m = (cardinal m = 0)) ;; + +q Q.int (fun i -> + let b = Bit.highest i in + ((b:>int) land i = (b:>int)) && (i < 0 || ((b:>int) <= i && (i-(b:>int)) < (b:>int))));; +q Q.int (fun i -> (Bit.highest i = Bit.min_int) = (i < 0));; +q Q.int (fun i -> ((Bit.highest i:>int) < 0) = (Bit.highest i = Bit.min_int));; +q Q.int (fun i -> let j = (Bit.highest i :> int) in j land (j-1) = 0);; + +t @@ fun () -> (Bit.highest min_int :> int) = min_int;; +t @@ fun () -> (Bit.highest 2 :> int) = 2;; +t @@ fun () -> (Bit.highest 17 :> int) = 16;; +t @@ fun () -> (Bit.highest 300 :> int) = 256;; + +q Q.(list (pair int bool)) (fun l -> + check_invariants (of_list l));; + +q Q.(list (pair int int)) (fun l -> + let l = _list_uniq l in + let m = of_list l in + List.for_all (fun (k,v) -> find k m = Some v) l);; + +q Q.(list (pair int int)) (fun l -> + let m = of_list l in + List.for_all (fun (k,_) -> mem k m) l);; + +q ~count:20 + Q.(list (pair int int)) (fun l -> + let l = _list_uniq l in let m = of_list l in + List.for_all (fun (k,v) -> find_exn k m = v) l);; + +q ~count:20 + Q.(list (pair int int)) (fun l -> + let l = _list_uniq l in let m = of_list l in + List.for_all (fun (k,_) -> mem k m && not (mem k (remove k m))) l);; + +eq ~printer:Q.Print.(list (pair int int)) + [1,1; 2, 22; 3, 3] + (of_list [1,1;2,2;3,3] + |> update 2 (function None -> assert false | Some _ -> Some 22) + |> to_list |> List.sort Stdlib.compare);; + +q Q.(list (pair int bool)) ( fun l -> + let open Q in + CCList.sort_uniq ~cmp:CCOrd.poly l = CCList.sort CCOrd.poly l ==> + equal ~eq:(=) (of_list l) (of_list (List.rev l)));; + +(* regression for #329 *) +t @@ fun () -> + let minus m1 m2 = + union (fun _key v1 v2 -> v1 - v2) m1 m2 in + + let key = 0 in + let m0 = singleton key 1 in (* a map of [key] to the value 1 *) + let m1 = minus m0 m0 in (* a map of [key] to the value 0 *) + let m2 = minus m0 m1 in (* a map of [key] to the value 1 *) + let observed = equal ~eq:(=) m2 m0 in (* [m0] and [m2] should be equal *) + assert_equal true observed; + true;; + +q + Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1,l2) -> + check_invariants (union (fun _ _ x -> x) (of_list l1) (of_list l2)));; +q + Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1,l2) -> + check_invariants (inter (fun _ _ x -> x) (of_list l1) (of_list l2)));; + +(* associativity of union *) +q Q.(let p = list (pair int int) in triple p p p) (fun (l1,l2,l3) -> + let m1 = of_list l1 and m2 = of_list l2 and m3 = of_list l3 in + let f _ x y = max x y in + equal ~eq:(=) (union f (union f m1 m2) m3) (union f m1 (union f m2 m3)));; + +t @@ fun () -> + assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp)) + (of_list [1, "1"; 2, "2"; 3, "3"; 4, "4"]) + (union (fun _ a _ -> a) + (of_list [1, "1"; 3, "3"]) (of_list [2, "2"; 4, "4"])); + true;; + +t @@ fun () -> + assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp)) + (of_list [1, "1"; 2, "2"; 3, "3"; 4, "4"]) + (union (fun _ a _ -> a) + (of_list [1, "1"; 2, "2"; 3, "3"]) (of_list [2, "2"; 4, "4"])); + true;; + +q Q.(list (pair int bool)) (fun l -> + equal ~eq:(=) (of_list l) (union (fun _ a _ -> a) (of_list l)(of_list l)));; + +let union_l l1 l2 = + let l2' = List.filter (fun (x,_) -> not @@ List.mem_assoc x l1) l2 in + _list_uniq (l1 @ l2') + +let inter_l l1 l2 = + let l2' = List.filter (fun (x,_) -> List.mem_assoc x l1) l2 in + _list_uniq l2';; + +q Q.(pair (small_list (pair small_int unit)) (small_list (pair small_int unit))) + (fun (l1,l2) -> + union_l l1 l2 = _list_uniq @@ to_list (union (fun _ _ _ ->())(of_list l1) (of_list l2)));; + +q Q.(pair (small_list (pair small_int unit)) (small_list (pair small_int unit))) + (fun (l1,l2) -> + inter_l l1 l2 = _list_uniq @@ to_list (inter (fun _ _ _ ->()) (of_list l1) (of_list l2)));; + +t @@ fun () -> + assert_equal ~cmp:(equal ~eq:(=)) ~printer:(CCFormat.to_string (pp CCString.pp)) + (singleton 2 "2") + (inter (fun _ a _ -> a) + (of_list [1, "1"; 2, "2"; 3, "3"]) (of_list [2, "2"; 4, "4"])); + true;; + +q Q.(list (pair int bool)) (fun l -> + equal ~eq:(=) (of_list l) (inter (fun _ a _ -> a) (of_list l)(of_list l)));; + +(* associativity of inter *) +q Q.(let p = list (pair int int) in triple p p p) (fun (l1,l2,l3) -> + let m1 = of_list l1 and m2 = of_list l2 and m3 = of_list l3 in + let f _ x y = max x y in + equal ~eq:(=) (inter f (inter f m1 m2) m3) (inter f m1 (inter f m2 m3)));; + +q Q.(pair (fun2 Observable.int Observable.int bool) (small_list (pair int int))) (fun (f,l) -> + let QCheck.Fun(_,f) = f in + _list_uniq (List.filter (fun (x,y) -> f x y) l) = + (_list_uniq @@ to_list @@ filter f @@ of_list l) +);; + +q Q.(pair (fun2 Observable.int Observable.int @@ option bool) (small_list (pair int int))) (fun (f,l) -> + let QCheck.Fun(_,f) = f in + _list_uniq (CCList.filter_map (fun (x,y) -> CCOption.map (CCPair.make x) @@ f x y) l) = + (_list_uniq @@ to_list @@ filter_map f @@ of_list l) +);; + +let merge_union _x o = match o with + | `Left v | `Right v | `Both (v,_) -> Some v +let merge_inter _x o = match o with + | `Left _ | `Right _ -> None + | `Both (v,_) -> Some v;; + +q Q.(let p = small_list (pair small_int small_int) in pair p p) (fun (l1,l2) -> + check_invariants + (merge ~f:merge_union (of_list l1) (of_list l2)));; + +q Q.(let p = small_list (pair small_int small_int) in pair p p) (fun (l1,l2) -> + check_invariants + (merge ~f:merge_inter (of_list l1) (of_list l2)));; + +q Q.(let p = small_list (pair small_int unit) in pair p p) (fun (l1,l2) -> + let l1 = _list_uniq l1 and l2 = _list_uniq l2 in + equal ~eq:Stdlib.(=) + (union (fun _ v1 _ -> v1) (of_list l1) (of_list l2)) + (merge ~f:merge_union (of_list l1) (of_list l2)));; + +q Q.(let p = small_list (pair small_int unit) in pair p p) (fun (l1,l2) -> + let l1 = _list_uniq l1 and l2 = _list_uniq l2 in + equal ~eq:Stdlib.(=) + (inter (fun _ v1 _ -> v1) (of_list l1) (of_list l2)) + (merge ~f:merge_inter (of_list l1) (of_list l2)));; + +q Q.(list (pair int int)) (fun l -> + let l = List.map (fun (k,v) -> abs k,v) l in + let rec is_sorted = function [] | [_] -> true + | x::y::tail -> x <= y && is_sorted (y::tail) in + of_list l |> to_list |> List.rev_map fst |> is_sorted);; + +q Q.(list (pair int int)) (fun l -> + of_list l |> cardinal = List.length (l |> List.map fst |> CCList.sort_uniq ~cmp:CCInt.compare));; +q Q.(list (pair small_int int)) (fun l -> + of_list l |> cardinal = List.length (l |> List.map fst |> CCList.sort_uniq ~cmp:CCInt.compare));; + +eq ~printer:Q.Print.int + 1 (let t = of_list [(197151390, 0); (197151390, 0)] in cardinal t);; + +t @@ fun () -> + doubleton 1 "a" 2 "b" |> to_gen |> of_gen |> to_list + |> List.sort Stdlib.compare = [1, "a"; 2, "b"];; + +q Q.(list (pair int bool)) (fun l -> + let m = of_list l in equal ~eq:(=) m (m |> to_gen |> of_gen));; + +q Q.(list (pair int bool)) ( fun l -> + let m1 = of_list l and m2 = of_list (List.rev l) in + compare ~cmp:Stdlib.compare m1 m2 = 0);; + +q Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1, l2) -> + let l1 = List.map (fun (k,v) -> abs k,v) l1 in + let l2 = List.map (fun (k,v) -> abs k,v) l2 in + let m1 = of_list l1 and m2 = of_list l2 in + let c = compare ~cmp:Stdlib.compare m1 m2 + and c' = compare ~cmp:Stdlib.compare m2 m1 in + (c = 0) = (c' = 0) && (c < 0) = (c' > 0) && (c > 0) = (c' < 0));; + +q Q.(pair (list (pair int bool)) (list (pair int bool))) (fun (l1, l2) -> + let l1 = List.map (fun (k,v) -> abs k,v) l1 in + let l2 = List.map (fun (k,v) -> abs k,v) l2 in + let m1 = of_list l1 and m2 = of_list l2 in + (compare ~cmp:Stdlib.compare m1 m2 = 0) = equal ~eq:(=) m1 m2);; + +q Q.(list (pair int bool)) (fun l -> + let m = of_list l in equal ~eq:(=) m (m |> to_seq |> of_seq));; + +let test_count = 2_500 + +open QCheck + +type instr_tree = + | Empty + | Singleton of int * int + | Add of int * int * instr_tree + | Remove of int * instr_tree + | Union of instr_tree * instr_tree + | Inter of instr_tree * instr_tree + +let rec to_string (a:instr_tree): string = + let int_to_string = string_of_int in + match a with + | Empty -> "Empty" + | Singleton (k,v) -> Printf.sprintf "Singleton(%d,%d)" k v + | Add (k,v,t) -> Printf.sprintf "Add(%d,%d," k v ^ (to_string t) ^ ")" + | Remove (n,t) -> "Remove (" ^ (int_to_string n) ^ ", " ^ (to_string t) ^ ")" + | Union (t,t') -> "Union (" ^ (to_string t) ^ ", " ^ (to_string t') ^ ")" + | Inter (t,t') -> "Inter (" ^ (to_string t) ^ ", " ^ (to_string t') ^ ")" + +let merge_f _ x y = min x y + +let rec interpret t : _ t = match t with + | Empty -> empty + | Singleton (k,v) -> singleton k v + | Add (k,v,t) -> add k v (interpret t) + | Remove (n,t) -> remove n (interpret t) + | Union (t,t') -> + let s = interpret t in + let s' = interpret t' in + union merge_f s s' + | Inter (t,t') -> + let s = interpret t in + let s' = interpret t' in + inter merge_f s s' + +let tree_gen int_gen : instr_tree Q.Gen.t = + let open Gen in + sized + (fix (fun recgen n -> match n with + | 0 -> oneof [return Empty; + Gen.map2 (fun i j -> Singleton (i,j)) int_gen int_gen] + | _ -> + frequency + [ (1, return Empty); + (1, map2 (fun k v -> Singleton (k,v)) int_gen int_gen); + (2, map3 (fun i j t -> Add (i,j,t)) int_gen int_gen (recgen (n-1))); + (2, map2 (fun i t -> Remove (i,t)) int_gen (recgen (n-1))); + (2, map2 (fun l r -> Union (l,r)) (recgen (n/2)) (recgen (n/2))); + (2, map2 (fun l r -> Inter (l,r)) (recgen (n/2)) (recgen (n/2))); + ])) + +let (<+>) = Q.Iter.(<+>) + +let rec tshrink t : instr_tree Q.Iter.t = match t with + | Empty -> Iter.empty + | Singleton (k,v) -> + (Iter.return Empty) + <+> (Iter.map (fun k' -> Singleton (k',v)) (Shrink.int k)) + <+> (Iter.map (fun v' -> Singleton (k,v')) (Shrink.int v)) + | Add (k,v,t) -> + (Iter.of_list [Empty; t; Singleton (k,v)]) + <+> (Iter.map (fun t' -> Add (k,v,t')) (tshrink t)) + <+> (Iter.map (fun k' -> Add (k',v,t)) (Shrink.int k)) + <+> (Iter.map (fun v' -> Add (k,v',t)) (Shrink.int v)) + | Remove (i,t) -> + (Iter.of_list [Empty; t]) + <+> (Iter.map (fun t' -> Remove (i,t')) (tshrink t)) + <+> (Iter.map (fun i' -> Remove (i',t)) (Shrink.int i)) + | Union (t0,t1) -> + (Iter.of_list [Empty;t0;t1]) + <+> (Iter.map (fun t0' -> Union (t0',t1)) (tshrink t0)) + <+> (Iter.map (fun t1' -> Union (t0,t1')) (tshrink t1)) + | Inter (t0,t1) -> + (Iter.of_list [Empty;t0;t1]) + <+> (Iter.map (fun t0' -> Inter (t0',t1)) (tshrink t0)) + <+> (Iter.map (fun t1' -> Inter (t0,t1')) (tshrink t1)) + +let arb_int = + frequency + [(5,small_signed_int); + (3,int); + (1, oneofl [min_int;max_int])] + +let arb_tree = + make ~print:to_string ~shrink:tshrink + (tree_gen arb_int.gen) + +let empty_m = [] +let singleton_m k v = [k,v] +let mem_m i s = List.mem_assoc i s +let rec remove_m i s = match s with + | [] -> [] + | (j,v)::s' -> if i=j then s' else (j,v)::(remove_m i s') +let add_m k v s = List.sort Stdlib.compare ((k,v)::remove_m k s) +let rec union_m s s' = match s,s' with + | [], _ -> s' + | _, [] -> s + | (k1,v1)::is,(k2,v2)::js -> + if k1k2 then (k2,v2)::(union_m s js) else + (k1,min v1 v2)::(union_m is js) +let rec inter_m s s' = match s with + | [] -> [] + | (k,v)::s -> + if List.mem_assoc k s' + then (k,min v (List.assoc k s'))::(inter_m s s') + else inter_m s s';; + +let abstract s = List.sort Stdlib.compare (fold (fun k v acc -> (k,v)::acc) s []);; + +(* A bunch of agreement properties *) + +eq empty_m (let s = empty in abstract s);; + +q ~count:test_count + (Q.pair arb_int arb_int) (fun (k,v) -> + abstract (singleton k v) = singleton_m k v);; + +q ~count:test_count + Q.(pair arb_tree arb_int) + (fun (t,n) -> + let s = interpret t in + mem n s = mem_m n (abstract s));; + +q ~count:test_count + (triple arb_tree arb_int arb_int) + (fun (t,k,v) -> + let s = interpret t in + abstract (add k v s) = add_m k v (abstract s));; + +q ~count:test_count + (pair arb_tree arb_int) + (fun (t,n) -> + let s = interpret t in + abstract (remove n s) = remove_m n (abstract s));; + +q ~count:test_count + (pair arb_tree arb_tree) + (fun (t,t') -> + let s = interpret t in + let s' = interpret t' in + abstract (union merge_f s s') = union_m (abstract s) (abstract s'));; + +q ~count:test_count + Q.(pair arb_tree arb_tree) + (fun (t,t') -> + let s = interpret t in + let s' = interpret t' in + abstract (inter merge_f s s') = inter_m (abstract s) (abstract s'));; diff --git a/tests/data/t_lazylist.ml b/tests/data/t_lazylist.ml new file mode 100644 index 00000000..e11ddc46 --- /dev/null +++ b/tests/data/t_lazylist.ml @@ -0,0 +1,21 @@ + + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCLazy_list;; + +q Q.(list int) (fun l -> length (of_list l) = List.length l);; + +eq [2;4;6] (of_list [1;2;3;4;5;6;7] |> filter ~f:(fun x -> x mod 2=0) |> to_list);; +eq [2;4;6] (of_gen Gen.(1 -- max_int) |> filter ~f:(fun x -> x mod 2=0) |> take 3 |> to_list);; + +q Q.(pair (list int) (list int)) (fun (l1,l2) -> + length (append (of_list l1) (of_list l2)) = List.length l1 + List.length l2);; + +eq [1] (default ~default:(return 1) empty |> to_list);; + +q Q.(list int) (fun l -> l = (Gen.of_list l |> of_gen |> to_list));; + +q Q.(list int) (fun l -> l = to_list (of_list l));; + +q Q.(list int) (fun l -> l = (of_list l |> to_gen |> Gen.to_list));; diff --git a/tests/data/t_misc.ml b/tests/data/t_misc.ml new file mode 100644 index 00000000..c4d4e89b --- /dev/null +++ b/tests/data/t_misc.ml @@ -0,0 +1,166 @@ + + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test + +module Mixmap = struct + open CCMixmap;; + + t @@ fun () -> + let module M = CCMixmap.Make(CCInt) in + + let inj_int = CCMixmap.create_inj() in + let inj_str = CCMixmap.create_inj() in + let inj_list_int = CCMixmap.create_inj() in + + let m = + M.empty + |> M.add ~inj:inj_int 1 1 + |> M.add ~inj:inj_str 2 "2" + |> M.add ~inj:inj_list_int 3 [3;3;3] + in + + assert_equal (M.get ~inj:inj_int 1 m) (Some 1) ; + assert_equal (M.get ~inj:inj_str 1 m) None ; + assert_equal (M.get ~inj:inj_str 2 m) (Some "2") ; + assert_equal (M.get ~inj:inj_int 2 m) None ; + assert_equal (M.get ~inj:inj_list_int 3 m) (Some [3;3;3]) ; + assert_equal (M.get ~inj:inj_str 3 m) None ; + true + +end + +module Mixset = struct + open CCMixset ;; + + t @@ fun () -> + let k1 : int key = newkey () in + let k2 : int key = newkey () in + let k3 : string key = newkey () in + let set = + empty + |> set ~key:k1 1 + |> set ~key:k2 2 + |> set ~key:k3 "3" + in + assert (get ~key:k1 set = Some 1); + assert (get ~key:k2 set = Some 2); + assert (get ~key:k3 set = Some "3"); + true + +end + +module Mixtbl = struct + open CCFun + open CCMixtbl;; + + t @@ fun () -> + let inj_int = create_inj () in + let tbl = create 10 in + assert_equal None (get ~inj:inj_int tbl "a"); + set ~inj:inj_int tbl "a" 1; + assert_equal (Some 1) (get ~inj:inj_int tbl "a"); + let inj_string = create_inj () in + set ~inj:inj_string tbl "b" "Hello"; + assert_equal (Some "Hello") (get ~inj:inj_string tbl "b"); + assert_equal None (get ~inj:inj_string tbl "a"); + assert_equal (Some 1) (get ~inj:inj_int tbl "a"); + set ~inj:inj_string tbl "a" "Bye"; + assert_equal None (get ~inj:inj_int tbl "a"); + assert_equal (Some "Bye") (get ~inj:inj_string tbl "a"); + true;; + + t @@ fun () -> + let inj_int = create_inj () in + let tbl = create 5 in + set ~inj:inj_int tbl "foo" 1; + set ~inj:inj_int tbl "bar" 2; + assert_equal 2 (length tbl); + assert_equal 2 (find ~inj:inj_int tbl "bar"); + set ~inj:inj_int tbl "foo" 42; + assert_equal 2 (length tbl); + remove tbl "bar"; + assert_equal 1 (length tbl); + true;; + + t @@ fun () -> + let inj_int = create_inj () in + let inj_str = create_inj () in + let tbl = create 5 in + set ~inj:inj_int tbl "foo" 1; + set ~inj:inj_int tbl "bar" 2; + set ~inj:inj_str tbl "baaz" "hello"; + assert_equal 3 (length tbl); + clear tbl; + assert_equal 0 (length tbl); + true;; + + t @@ fun () -> + let inj_int = create_inj () in + let inj_str = create_inj () in + let tbl = create 5 in + set ~inj:inj_int tbl "foo" 1; + set ~inj:inj_int tbl "bar" 2; + set ~inj:inj_str tbl "baaz" "hello"; + assert_bool "mem foo int" (mem ~inj:inj_int tbl "foo"); + assert_bool "mem bar int" (mem ~inj:inj_int tbl "bar"); + assert_bool "not mem baaz int" (not (mem ~inj:inj_int tbl "baaz")); + assert_bool "not mem foo str" (not (mem ~inj:inj_str tbl "foo")); + assert_bool "not mem bar str" (not (mem ~inj:inj_str tbl "bar")); + assert_bool "mem baaz str" (mem ~inj:inj_str tbl "baaz"); + true;; + + t @@ fun () -> + let inj_int = create_inj () in + let inj_str = create_inj () in + let tbl = create 5 in + set ~inj:inj_int tbl "foo" 1; + set ~inj:inj_int tbl "bar" 2; + set ~inj:inj_str tbl "baaz" "hello"; + let l = keys_iter tbl |> Iter.to_list in + assert_equal ["baaz"; "bar"; "foo"] (List.sort compare l); + true;; + + t @@ fun () -> + let inj_int = create_inj () in + let inj_str = create_inj () in + let tbl = create 5 in + set ~inj:inj_int tbl "foo" 1; + set ~inj:inj_int tbl "bar" 2; + set ~inj:inj_str tbl "baaz" "hello"; + set ~inj:inj_str tbl "str" "rts"; + let l_int = bindings_of ~inj:inj_int tbl |> Iter.to_list in + assert_equal ["bar", 2; "foo", 1] (List.sort compare l_int); + let l_str = bindings_of ~inj:inj_str tbl |> Iter.to_list in + assert_equal ["baaz", "hello"; "str", "rts"] (List.sort compare l_str); + true;; + +end + +module Multiset = struct + open CCMultiSet;; + + t @@ fun () -> let module S = CCMultiSet.Make(String) in + S.count (S.add_mult S.empty "a" 5) "a" = 5;; + t @@ fun () -> let module S = CCMultiSet.Make(String) in + S.count (S.remove_mult (S.add_mult S.empty "a" 5) "a" 3) "a" = 2;; + t @@ fun () -> let module S = CCMultiSet.Make(String) in + S.count (S.remove_mult (S.add_mult S.empty "a" 4) "a" 6) "a" = 0;; +end + +module PersistentArray = struct + open CCPersistentArray;; + + t @@ fun () -> + of_list [ of_list [1]; of_list []; of_list [2;3;4]; of_list [5]; of_list [6;7]] + |> flatten |> to_list = [1;2;3;4;5;6;7];; + + t @@ fun () -> + of_list [ of_list []; of_list []; of_list []] |> flatten |> length = 0;; + + t @@ fun () -> of_list [] |> flatten |> length = 0;; + + q Q.(list int) (fun l -> + of_list l |> to_gen |> of_gen |> to_list = l);; + +end diff --git a/tests/data/t_mutheap.ml b/tests/data/t_mutheap.ml new file mode 100644 index 00000000..7cd4e0e1 --- /dev/null +++ b/tests/data/t_mutheap.ml @@ -0,0 +1,76 @@ + + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCMutHeap;; + +type elt = { + x: string; + mutable rank: int; + mutable idx: int; +} +module Elt = struct + type t = elt + let idx x = x.idx + let set_idx x i = x.idx <- i + let lt a b = + if a.rank = b.rank then a.x < b.x else a.rank < b.rank +end +module H = CCMutHeap.Make(Elt);; + +t @@ fun () -> + let h = H.create() in + let x1 = {x="a"; rank=10; idx= -1} in + let x2 = {x="b"; rank=10; idx= -1} in + let x3 = {x="c"; rank=10; idx= -1} in + H.insert h x1; + assert (H.in_heap x1); + assert (not (H.in_heap x2)); + assert (not (H.in_heap x3)); + H.insert h x2; + H.insert h x3; + + assert (Elt.lt x1 x2); + assert (Elt.lt x2 x3); + + let x = H.remove_min h in + assert (x == x1); + + let x = H.remove_min h in + assert (x == x2); + + let x = H.remove_min h in + assert (x == x3); + + assert (try ignore (H.remove_min h); false with Not_found -> true); + true;; + +t @@ fun () -> + let h = H.create() in + let x1 = {x="a"; rank=10; idx= -1} in + let x2 = {x="b"; rank=10; idx= -1} in + let x3 = {x="c"; rank=10; idx= -1} in + H.insert h x1; + H.insert h x2; + H.insert h x3; + + x3.rank <- 2; + H.decrease h x3; + + assert (Elt.lt x3 x1); + assert (Elt.lt x3 x2); + + let x = H.remove_min h in + assert (x == x3); + + x1.rank <- 20; + H.increase h x1; + + let x = H.remove_min h in + assert (x == x2); + + let x = H.remove_min h in + assert (x == x1); + + assert (try ignore (H.remove_min h); false with Not_found -> true); + true;; diff --git a/tests/data/t_persistenthashtbl.ml b/tests/data/t_persistenthashtbl.ml new file mode 100644 index 00000000..bd44074d --- /dev/null +++ b/tests/data/t_persistenthashtbl.ml @@ -0,0 +1,162 @@ + + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCPersistentHashtbl;; + +module H = Make(CCInt) + +let my_list = + [ 1, "a"; + 2, "b"; + 3, "c"; + 4, "d"; + ] + +let my_iter = Iter.of_list my_list + +let _list_uniq = CCList.sort_uniq + ~cmp:(fun a b -> Stdlib.compare (fst a) (fst b)) + +let _list_int_int = Q.( + map_same_type _list_uniq + (list_of_size Gen.(0 -- 40) (pair small_int small_int)) +);; + +t @@ fun () -> + let h = H.of_iter my_iter in + assert_equal "a" (H.find h 1); + assert_raises ((=)Not_found) (fun () -> H.find h 5); + let h' = H.replace h 5 "e" in + assert_equal "a" (H.find h' 1); + assert_equal "e" (H.find h' 5); + assert_equal "a" (H.find h 1); + assert_raises ((=)Not_found) (fun () -> H.find h 5); + true;; + +t @@ fun () -> + let n = 10000 in + let seq = Iter.map (fun i -> i, string_of_int i) Iter.(0--n) in + let h = H.of_iter seq in + Iter.iter + (fun (k,v) -> + assert_equal ~printer:(fun x -> x) v (H.find h k)) + seq; + assert_raises ((=)Not_found) (fun () -> H.find h (n+1)); + true;; + +q _list_int_int + (fun l -> + let h = H.of_list l in + List.for_all + (fun (k,v) -> + try + H.find h k = v + with Not_found -> false) + l + );; + +t @@ fun () -> + let h = H.of_iter + Iter.(map (fun i -> i, string_of_int i) + (0 -- 200)) in + assert_equal 201 (H.length h); + true;; + +q _list_int_int (fun l -> + let h = H.of_list l in + H.length h = List.length l +);; + +t @@ fun () -> + let h = H.of_iter my_iter in + assert_equal "a" (H.find h 1); + assert_raises ((=)Not_found) (fun () -> H.find h 5); + let h1 = H.add h 5 "e" in + assert_equal "a" (H.find h1 1); + assert_equal "e" (H.find h1 5); + assert_equal "a" (H.find h 1); + let h2 = H.add h1 5 "ee" in + assert_equal "ee" (H.find h2 5); + assert_raises ((=)Not_found) (fun () -> H.find h 5); + let h3 = H.remove h2 1 in + assert_equal "ee" (H.find h3 5); + assert_raises ((=)Not_found) (fun () -> H.find h3 1); + let h4 = H.remove h3 5 in + assert_equal "e" (H.find h4 5); + assert_equal "ee" (H.find h3 5); + true;; + +t @@ fun () -> + let h = H.of_iter my_iter in + assert_equal (H.find h 2) "b"; + assert_equal (H.find h 3) "c"; + assert_equal (H.find h 4) "d"; + assert_equal (H.length h) 4; + let h = H.remove h 2 in + assert_equal (H.find h 3) "c"; + assert_equal (H.length h) 3; + assert_raises ((=)Not_found) (fun () -> H.find h 2); + true;; + +t @@ fun () -> + let open Iter.Infix in + let n = 10000 in + let seq = Iter.map (fun i -> i, string_of_int i) (0 -- n) in + let h = H.of_iter seq in + assert_equal (n+1) (H.length h); + let h = Iter.fold (fun h i -> H.remove h i) h (0 -- 500) in + assert_equal (n-500) (H.length h); + assert_bool "is_empty" (H.is_empty (H.create 16)); + true;; + +q _list_int_int (fun l -> + let h = H.of_list l in + let h = List.fold_left (fun h (k,_) -> H.remove h k) h l in + H.is_empty h);; + +t @@ fun () -> + let t1 = H.of_list [1, "a"; 2, "b1"] in + let t2 = H.of_list [2, "b2"; 3, "c"] in + let t = H.merge + ~f:(fun _ -> function + | `Right v2 -> Some v2 + | `Left v1 -> Some v1 + | `Both (s1,s2) -> if s1 < s2 then Some s1 else Some s2) + t1 t2 + in + assert_equal ~printer:string_of_int 3 (H.length t); + assert_equal "a" (H.find t 1); + assert_equal "b1" (H.find t 2); + assert_equal "c" (H.find t 3); + true;; + +q _list_int_int (fun l -> + let l1, l2 = List.partition (fun (x,_) -> x mod 2 = 0) l in + let h1 = H.of_list l1 in + let h2 = H.add_list h1 l2 in + List.for_all + (fun (k,v) -> H.find h2 k = v) + l + && + List.for_all + (fun (k,v) -> H.find h1 k = v) + l1 + && + List.length l1 = H.length h1 + && + List.length l = H.length h2 +);; + +t @@ fun () -> + let h = H.of_iter my_iter in + let l = Iter.to_list (H.to_iter h) in + assert_equal my_list (List.sort compare l); + true;; + +t @@ fun () -> + let h = H.of_iter my_iter in + assert_equal "b" (H.find h 2); + assert_equal "a" (H.find h 1); + assert_raises ((=)Not_found) (fun () -> H.find h 42); + true;; diff --git a/tests/data/t_ral.ml b/tests/data/t_ral.ml new file mode 100644 index 00000000..d3aec76f --- /dev/null +++ b/tests/data/t_ral.ml @@ -0,0 +1,139 @@ + + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCRAL;; + +q Q.(pair (pair small_int int) (list int)) (fun ((i,v),l) -> + l=[] || + (let i = (abs i) mod (List.length l) in + let ral = of_list l in let ral = set ral i v in + get_exn ral i = v));; + +q Q.(list small_int) (fun l -> + let l1 = of_list l in + CCList.mapi (fun i x -> i,x) l + |> List.for_all (fun (i,x) -> get_exn l1 i = x));; + +t @@ fun () -> let l = of_list[1;2;3] in hd l = 1;; +t @@ fun () -> let l = of_list[1;2;3] in tl l |> to_list = [2;3];; + +q Q.(list_of_size Gen.(1--100) int) (fun l -> + let open Q in + let l' = of_list l in + (not (is_empty l')) ==> (equal ~eq:CCInt.equal l' (cons (hd l') (tl l'))) );; + +eq ~printer:Q.Print.(list int) + [1;2;4] (to_list @@ remove (of_list [1;2;3;4]) 2);; + +eq ~printer:Q.Print.(pair int (list int)) + (3,[1;2;4]) (CCPair.map_snd to_list @@ get_and_remove_exn (of_list [1;2;3;4]) 2);; + +q Q.small_int (fun n -> + let l = CCList.(0 -- n) in + let l' = of_list l |> mapi ~f:(fun i x ->i,x) in + List.mapi (fun i x->i,x) l = to_list l' +);; + +q Q.(pair (list small_int)(fun2 Observable.int Observable.int bool)) (fun (l,f) -> + let f = Q.Fn.apply f in + mapi ~f (of_list l) |> to_list = List.mapi f l );; + +q Q.(list int) (fun l -> + let f x = x+1 in + of_list l |> rev_map ~f |> to_list = List.rev_map f l);; + +q Q.(list small_int) (fun l -> + let l = of_list l in rev (rev l) = l);; +q Q.(list small_int) (fun l -> + let l1 = of_list l in length l1 = List.length l);; + +q Q.(pair (list int) (list int)) (fun (l1,l2) -> + append (of_list l1) (of_list l2) = of_list (l1 @ l2));; + +t @@ fun () -> of_list [1;2;3;4;5;6] |> filter ~f:(fun x -> x mod 2=0) |> to_list = [2;4;6];; + +q Q.(pair (fun1 Observable.int (small_list int)) (small_list int)) (fun (f,l) -> + let f x = Q.Fn.apply f x in + let f' x = f x |> of_list in + of_list l |> flat_map f' |> to_list = CCList.(flat_map f l));; + +t @@ fun () -> + flatten (of_list [of_list [1]; of_list []; of_list [2;3]]) = + of_list [1;2;3;];; + +q Q.(small_list (small_list int)) (fun l -> + of_list l |> map ~f:of_list |> flatten |> to_list = CCList.flatten l);; + +t @@ fun () -> + app (of_list [(+) 2; ( * ) 10]) (of_list [1;10]) |> to_list = + [3; 12; 10; 100];; + +t @@ fun () -> take 3 (of_list CCList.(1--10)) |> to_list = [1;2;3];; +t @@ fun () -> take 5 (of_list CCList.(1--10)) |> to_list = [1;2;3;4;5];; +t @@ fun () -> take 0 (of_list CCList.(1--10)) |> to_list = [];; + +q Q.(pair small_int (list int)) (fun (n,l) -> + of_list l |> take n |> to_list = CCList.take n l);; + +q Q.(list int) (fun l -> + let f x = x mod 7 <> 0 in + of_list l |> take_while ~f |> to_list = CCList.take_while f l);; +q Q.(pair (fun1 Observable.int bool) (list int)) (fun (f,l) -> + let f x = Q.Fn.apply f x in + of_list l |> take_while ~f |> to_list = CCList.take_while f l);; + +t @@ fun () -> of_list [1;2;3] |> drop 2 |> length = 1;; + +q Q.(pair small_int (list int)) (fun (n,l) -> + of_list l |> drop n |> to_list = CCList.drop n l);; + +t @@ fun () -> drop 3 (of_list CCList.(1--10)) |> to_list = CCList.(4--10);; +t @@ fun () -> drop 5 (of_list CCList.(1--10)) |> to_list = [6;7;8;9;10];; +t @@ fun () -> drop 0 (of_list CCList.(1--10)) |> to_list = CCList.(1--10);; +t @@ fun () -> drop 15 (of_list CCList.(1--10)) |> to_list = [];; + +q Q.(list_of_size Gen.(0 -- 200) int) (fun l -> + let f x = x mod 10 <> 0 in + of_list l |> drop_while ~f |> to_list = CCList.drop_while f l);; + +q Q.(pair (list int)(list int)) (fun (l1,l2) -> + equal ~eq:CCInt.equal (of_list l1) (of_list l2) = (l1=l2));; + +q Q.(pair small_int (small_list int)) (fun (n,l) -> + of_list l |> repeat n |> to_list = CCList.(repeat n l));; + +t @@ fun () -> range 0 3 |> to_list = [0;1;2;3];; +t @@ fun () -> range 3 0 |> to_list = [3;2;1;0];; +t @@ fun () -> range 17 17 |> to_list = [17];; + +q Q.(pair small_int small_int) (fun (i,j) -> + range i j |> to_list = CCList.(i -- j) );; + +let eq' = eq ~printer:CCFormat.(to_string (hbox (list int)));; +eq' [1;2;3;4] (1 --^ 5 |> to_list);; +eq' [5;4;3;2] (5 --^ 1 |> to_list);; +eq' [1] (1 --^ 2 |> to_list);; +eq' [] (0 --^ 0 |> to_list);; + +q Q.(pair (list small_int) (list small_int)) (fun (l1,l2) -> + add_list (of_list l2) l1 |> to_list = l1 @ l2);; + +q Q.(list int) (fun l -> to_list (of_list l) = l);; + +q Q.(array int) (fun a -> + of_array a |> to_array = a);; + +q Q.(list small_int) (fun l -> + of_list l |> to_iter |> Iter.to_list = l);; +q Q.(list small_int) (fun l -> + Iter.of_list l |> of_iter |> to_list = l);; + +t @@ fun () -> add_iter (of_list [3;4]) (Iter.of_list [1;2]) |> to_list = [1;2;3;4];; + +q Q.(list small_int) (fun l -> of_list l |> to_gen |> Gen.to_list = l);; +q Q.(list small_int) (fun l -> + Gen.of_list l |> of_gen |> to_list = l);; + +q Q.(pair (list int)(list int)) (fun (l1,l2) -> + compare ~cmp:CCInt.compare (of_list l1) (of_list l2) = (Stdlib.compare l1 l2));; diff --git a/tests/data/t_ringbuffer.ml b/tests/data/t_ringbuffer.ml new file mode 100644 index 00000000..51a81f8d --- /dev/null +++ b/tests/data/t_ringbuffer.ml @@ -0,0 +1,394 @@ + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCRingBuffer;; + +open Q.Gen +let g_char = map Char.chr (Char.code 'A' -- Char.code 'z') +let g_str = string_size ~gen:g_char (0--10) +let a_str = Q.set_gen g_str Q.string;; + +t @@ fun () -> + let b = Byte.of_array (Bytes.of_string "abc") in + let b' = Byte.copy b in + Byte.clear b; + Byte.to_array b' = (Bytes.of_string "abc") && Byte.to_array b = Bytes.empty ;; + +q a_str (fun s -> let s = Bytes.of_string s in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + Byte.capacity b >= s_len);; + +q a_str (fun s -> let s = Bytes.of_string s in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + let b' = Byte.copy b in + try Byte.iteri b + ~f:(fun i c -> if Byte.get_front b' i <> c then raise Exit); true + with Exit -> false);; + +q a_str (fun s -> let s = Bytes.of_string s in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + Byte.push_back b 'X'; + Byte.peek_back_exn b = 'X');; + +q (Q.pair a_str a_str) (fun (s,s') -> + let b = Byte.create (max (String.length s+String.length s') 64) in + let s = Bytes.of_string s in let s' = Bytes.of_string s' in + Byte.blit_from b s 0 (Bytes.length s); + Byte.blit_from b s' 0 (Bytes.length s'); + Byte.length b = Bytes.length s + Bytes.length s');; + +q (Q.pair a_str a_str) (fun (s,s') -> + let s = Bytes.of_string s in let s' = Bytes.of_string s' in + let b = Byte.create (max (Bytes.length s + Bytes.length s') 64) in + Byte.blit_from b s 0 (Bytes.length s); + Byte.blit_from b s' 0 (Bytes.length s'); + Byte.length b = Bytes.length s + Bytes.length s');; + +q a_str (fun s -> let s = Bytes.of_string s in + let b = Byte.create (max 64 (Bytes.length s)) in + Byte.blit_from b s 0 (Bytes.length s); + let to_buf = Bytes.create (Bytes.length s) in + let len = Byte.blit_into b to_buf 0 (Bytes.length s) in + to_buf = s && len = Bytes.length s);; + +q a_str (fun s -> let s = Bytes.of_string s in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + Byte.skip b s_len; + Byte.is_empty b);; + +q a_str (fun s -> let s = Bytes.of_string s in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + try let front = Byte.take_front_exn b in + front = Bytes.get s 0 with Byte.Empty -> s_len = 0);; + +q a_str (fun s -> let s = Bytes.of_string s in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + try let back = Byte.take_back_exn b in + back = Bytes.get s (Bytes.length s - 1) + with Byte.Empty -> s_len = 0);; + +q a_str (fun s -> let s = Bytes.of_string s in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + try let () = Byte.junk_front b in + s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0);; + +q a_str (fun s -> let s = Bytes.of_string s in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + try let () = Byte.junk_back b in + s_len - 1 = Byte.length b with Byte.Empty -> s_len = 0);; + +q (Q.pair a_str a_str) (fun (s,s') -> + let s = Bytes.of_string s in let s' = Bytes.of_string s' in + let b = Byte.create (max (Bytes.length s+Bytes.length s') 64) in + Byte.blit_from b s 0 (Bytes.length s); + Byte.blit_from b s' 0 (Bytes.length s'); + let h = Bytes.of_string "hello world" in + Byte.blit_from b h 0 (Bytes.length h); (* big enough *) + let l = Byte.length b in let l' = l/2 in Byte.skip b l'; + Byte.length b + l' = l);; + +q a_str (fun s -> let s = Bytes.of_string s in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + Byte.clear b; + Byte.length b = 0);; + +q a_str (fun s -> let s = Bytes.of_string s in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + try Byte.iteri b ~f:(fun i c -> if Byte.get_front b i <> c then raise Exit); + true with Exit -> false);; + +q (Q.pair Q.small_int a_str) (fun (i, s) -> + let s = Bytes.of_string (s ^ " ") in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + let index = abs (i mod Byte.length b) in + let front = Byte.get_front b index in + front = Bytes.get s index);; + +q (Q.pair Q.small_int a_str) (fun (i, s) -> + let s = Bytes.of_string (s ^ " ") in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + let index = abs (i mod Byte.length b) in + let back = Byte.get_back b index in + back = Bytes.get s (s_len - index - 1));; + +q a_str (fun s -> let s = Bytes.of_string s in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + let l = Byte.to_list b in + let explode s = let rec exp i l = + if i < 0 then l else exp (i - 1) (Bytes.get s i :: l) in + exp (Bytes.length s - 1) [] in + explode s = l);; + +q a_str (fun s -> let s = Bytes.of_string s in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + try let back = Byte.peek_front_exn b in + back = Bytes.get s 0 with Byte.Empty -> s_len = 0);; + +q a_str (fun s -> let s = Bytes.of_string s in + let s_len = Bytes.length s in + let b = Byte.create (max s_len 64) in + Byte.blit_from b s 0 s_len; + try let back = Byte.peek_back_exn b in + back = Bytes.get s (s_len - 1) with Byte.Empty -> s_len = 0);; + +q a_str (fun s -> let s = Bytes.of_string s in + let b = Byte.of_array s in let s' = Byte.to_array b in + s = s');; + +module BI = CCRingBuffer.Make(struct type t = int let dummy=0 end);; + +(* try to trigger an error on resize + see issue #126 *) +t @@ fun () -> + let b = BI.create 50 in + let st = Random.State.make [| 0 |] in + for _i = 1 to 100_000 do + if Random.State.float st 1.0 < 0.5 then + BI.push_back b 0 + else + let _ = BI.take_front b in () + done; + true;; + +(* Test against reference implementation (lists) on a succession of + operations. + + Remarks on semantics: + + JUNK_FRONT/JUNK_BACK: try to remove if not empty + SKIP: if at least n elements, skip; else nop +*) + +module BS = CCRingBuffer.Byte + +type op = +| Push_back of char +| Take_front +| Take_back +| Peek_front +| Peek_back +| Junk_front +| Junk_back +| Skip of int +| Blit of string * int * int +| Z_if_full + +let str_of_op = function +| Push_back c -> Printf.sprintf "push_back(%C)" c +| Take_front -> Printf.sprintf "take_front" +| Take_back -> Printf.sprintf "take_back" +| Peek_front -> Printf.sprintf "peek_front" +| Peek_back -> Printf.sprintf "peek_back" +| Junk_front -> Printf.sprintf "junk_front" +| Junk_back -> Printf.sprintf "junk_back" +| Skip n -> Printf.sprintf "skip(%d)" n +| Blit (s,i,len) -> Printf.sprintf "blit(%S,%d,%d)" s i len +| Z_if_full -> "zero_if_full" + +let push_back c = Push_back c +let skip n = assert (n>=0); Skip n +let blit s i len = +if i<0 || len<0 || i+len > String.length s then ( + failwith ("wrong blit: " ^ str_of_op (Blit (s,i,len))); +); +Blit (s,i,len) + +let shrink_op = +let open Q.Iter in +function + | Push_back c -> Q.Shrink.char c >|= push_back + | Take_front | Take_back | Junk_back | Junk_front + | Z_if_full | Peek_front | Peek_back + -> empty + | Skip n -> Q.Shrink.int n >|= skip + | Blit (s,i,len) -> + let s_i = + Q.Shrink.int i >>= fun i' -> + assert (i' <= i && i' + len <= String.length s); + if i' <= 0 then empty else return (blit s i' len) + and s_len = + Q.Shrink.int len >>= fun len'-> + assert (len' <= len && i + len' <= String.length s); + if len' <= 0 then empty else return (blit s i len') + and s_s = + Q.Shrink.string s >>= fun s' -> + if i+len > String.length s' then empty else return (blit s' i len) + in + append s_i (append s_len s_s) + +let len_op size acc = function +| Push_back _ -> min size (acc + 1) +| Take_front | Take_back | Junk_front | Junk_back -> max (acc-1) 0 +| Skip n -> if acc >= n then acc-n else acc +| Z_if_full | Peek_front | Peek_back -> acc +| Blit (_,_,len) -> min size (acc + len) + +let apply_op b = function +| Push_back c -> BS.push_back b c; None +| Take_front -> BS.take_front b +| Take_back -> BS.take_back b +| Junk_front -> (try BS.junk_front b with BS.Empty -> ()); None +| Junk_back -> (try BS.junk_back b with BS.Empty -> ()); None +| Peek_front -> BS.peek_front b +| Peek_back -> BS.peek_back b +| Skip n -> if n <= BS.length b then BS.skip b n; None +| Blit (s,i,len) -> + assert(i+len <= String.length s); + BS.blit_from b (Bytes.unsafe_of_string s) i len; None +| Z_if_full -> if BS.is_full b then Some '0' else None + +let gen_op = +let open Q.Gen in +let g_blit = + string_size ~gen:g_char (5--20) >>= fun s -> + (0 -- String.length s) >>= fun len -> + assert (len >= 0 && len <= String.length s); + (0--(String.length s-len)) >|= fun i -> + blit s i len +in +frequency + [ 3, return Take_back; + 3, return Take_front; + 1, return Junk_back; + 1, return Junk_front; + 1, return Peek_front; + 1, return Peek_back; + 2, g_blit; + 1, (0--5 >|= skip); + 2, map push_back g_char; + 1, return Z_if_full; + ] + +let arb_op = +Q.make + ~shrink:shrink_op + ~print:str_of_op + gen_op + +let arb_ops = Q.list_of_size Q.Gen.(0 -- 20) arb_op + +module L_impl = struct + type t = { + size: int; + mutable l: char list; + } + + let create size = {size; l=[]} + + let normalize_ b = + let n = List.length b.l in + if n>b.size then b.l <- CCList.drop (n-b.size) b.l + + let push_back b c = b.l <- b.l @ [c]; normalize_ b + let take_front b = match b.l with + | [] -> None + | c :: l -> b.l <- l; Some c + let peek_front b = match b.l with [] -> None | x::_ -> Some x + let take_back b = + let n = List.length b.l in + if n=0 then None + else ( + let init, last = CCList.take_drop (n-1) b.l in + let x = List.hd last in + b.l <- init; + Some x + ) + let peek_back b = match b.l with [] -> None | l -> Some (List.hd (List.rev l)) + let junk_front b = ignore (take_front b) + let junk_back b = ignore (take_back b) + let skip b n = + if n <= List.length b.l then ( + CCInt.range' 0 n (fun _ -> junk_front b) + ) + + let blit b s i len = + for j=i to i+len-1 do push_back b (String.get s j) done + + let apply_op b = function + | Push_back c -> push_back b c; None + | Take_front -> take_front b + | Take_back -> take_back b + | Peek_front -> peek_front b + | Peek_back -> peek_back b + | Junk_back -> junk_back b; None + | Junk_front -> junk_front b; None + | Skip n -> skip b n; None + | Blit (s,i,len) -> blit b s i len; None + | Z_if_full -> if b.size = List.length b.l then Some '0' else None + + let to_list b = b.l +end;; + +(* check that a lot of operations can be applied without failure, + and that the result has correct length *) +q ~count:3_000 + arb_ops (fun ops -> + let size = 64 in + let b = BS.create size in + List.iter (fun o-> ignore (apply_op b o)) ops; + BS.length b = List.fold_left (len_op size) 0 ops);; + +(* check identical behavior with list implem *) +q ~count:3_000 + arb_ops (fun ops -> + let size = 64 in + let b = BS.create size in + let l = L_impl.create size in + let l1 = CCList.filter_map (apply_op b) ops in + let l2 = CCList.filter_map (L_impl.apply_op l) ops in + l1=l2 && BS.to_list b = L_impl.to_list l);; + +(* check that deleted elements can be GCed *) +module BO = CCRingBuffer.Make(struct type t = int option let dummy=None end) +let make_bo () = + let b = BO.create 1000 in + for i = 1 to BO.capacity b do + BO.push_back b (Some i) + done; + b + +let test_no_major_blocks clear = + Gc.full_major (); + let live_blocks_before = (Gc.stat ()).live_blocks in + let b = make_bo () in + clear b; + Gc.full_major (); + let live_blocks_after = (Gc.stat ()).live_blocks in + assert (BO.length b = 0); + let diff = live_blocks_after - live_blocks_before in + diff < BO.capacity b / 2;; + +t @@ fun () -> test_no_major_blocks (fun b -> for _ = 1 to BO.length b do BO.junk_front b; done);; +t @@ fun () -> test_no_major_blocks (fun b -> for _ = 1 to BO.length b do BO.junk_back b; done);; +t @@ fun () -> test_no_major_blocks (fun b -> for _ = 1 to BO.length b do ignore (BO.take_front b); done);; +t @@ fun () -> test_no_major_blocks (fun b -> for _ = 1 to BO.length b do ignore (BO.take_back b); done);; +t @@ fun () -> test_no_major_blocks (fun b -> BO.skip b (BO.length b));; +t @@ fun () -> test_no_major_blocks (fun b -> BO.clear b);; diff --git a/tests/data/t_simplequeue.ml b/tests/data/t_simplequeue.ml new file mode 100644 index 00000000..acb83924 --- /dev/null +++ b/tests/data/t_simplequeue.ml @@ -0,0 +1,36 @@ + + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCSimple_queue;; + +q Q.(list small_int) (fun l -> + let q = of_list l in + equal CCInt.equal (Gen.unfold pop q |> of_gen) q);; + +q Q.(list small_int) (fun l -> + equal CCInt.equal (of_list l |> rev) (of_list (List.rev l)));; +q Q.(list small_int) (fun l -> + let q = of_list l in + equal CCInt.equal q (q |> rev |> rev));; + +q Q.(list small_int)(fun l -> + length (of_list l) = List.length l);; + +q Q.(list small_int)(fun l -> + equal CCInt.equal (of_list l) (List.fold_left snoc empty l));; + +q Q.(list small_int) (fun l -> + equal CCInt.equal + (of_iter (Iter.of_list l)) + (of_list l));; +q Q.(list small_int) (fun l -> + l = (of_list l |> to_iter |> Iter.to_list));; + +q Q.(pair (list small_int)(list small_int)) (fun (l1,l2) -> + equal CCInt.equal (of_list l1)(of_list l2) = (l1=l2));; + +q Q.(pair (list small_int)(list small_int)) (fun (l1,l2) -> + equal CCInt.equal + (append (of_list l1)(of_list l2)) + (of_list (List.append l1 l2)));; diff --git a/tests/data/t_trie.ml b/tests/data/t_trie.ml new file mode 100644 index 00000000..bfc715e2 --- /dev/null +++ b/tests/data/t_trie.ml @@ -0,0 +1,134 @@ + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCTrie;; + +module T = MakeList(CCInt) +module S = String + +let l1 = [ [1;2], "12"; [1], "1"; [2;1], "21"; [1;2;3], "123"; [], "[]" ] +let t1 = T.of_list l1 + +let small_l l = List.fold_left (fun acc (k,_) -> List.length k+acc) 0 l + +let s1 = String.of_list ["cat", 1; "catogan", 2; "foo", 3];; + +t @@ fun () -> String.of_list ["a", 1; "b", 2] |> String.size = 2;; +t @@ fun () -> String.of_list ["a", 1; "b", 2; "a", 3] |> String.size = 2;; +t @@ fun () -> String.of_list ["a", 1; "b", 2] |> String.find_exn "a" = 1;; +t @@ fun () -> String.of_list ["a", 1; "b", 2] |> String.find_exn "b" = 2;; +t @@ fun () -> String.of_list ["a", 1; "b", 2] |> String.find "c" = None;; +t @@ fun () -> s1 |> String.find_exn "cat" = 1;; +t @@ fun () -> s1 |> String.find_exn "catogan" = 2;; +t @@ fun () -> s1 |> String.find_exn "foo" = 3;; +t @@ fun () -> s1 |> String.find "cato" = None;; + +t @@ fun () -> T.add [3] "3" t1 |> T.find_exn [3] = "3";; +t @@ fun () -> T.add [3] "3" t1 |> T.find_exn [1;2] = "12";; +t @@ fun () -> T.remove [1;2] t1 |> T.find [1;2] = None;; +t @@ fun () -> T.remove [1;2] t1 |> T.find [1] = Some "1";; +t @@ fun () -> T.remove [1;2] t1 |> T.find [] = Some "[]";; + +eq ~printer:CCFun.id + "ca" (String.longest_prefix "carte" s1);; +eq ~printer:CCFun.id + "" (String.longest_prefix "yolo" s1);; +eq ~printer:CCFun.id + "cat" (String.longest_prefix "cat" s1);; +eq ~printer:CCFun.id + "catogan" (String.longest_prefix "catogan" s1);; + +q Q.(pair (list (pair (printable_string_of_size Gen.(0 -- 30)) int)) printable_string) (fun (l,s) -> + let m = String.of_list l in + let s' = String.longest_prefix s m in + CCString.prefix ~pre:s' s);; + +t @@ fun () -> + T.fold (fun acc k v -> (k,v) :: acc) [] t1 + |> List.sort Stdlib.compare = List.sort Stdlib.compare l1;; + +eq ~printer:Q.Print.(list (pair (list int) string)) + (List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Stdlib.compare) + (T.mapi (fun _ v -> v ^ "!") t1 + |> T.to_list |> List.sort Stdlib.compare);; + +eq ~printer:Q.Print.(list (pair (list int) string)) + (List.map (fun (k, v) -> (k, v ^ "!")) l1 |> List.sort Stdlib.compare) + (T.map (fun v -> v ^ "!") t1 + |> T.to_list |> List.sort Stdlib.compare);; + +q ~count:30 + Q.(let p = list_of_size Gen.(0--100) (pair printable_string small_int) in pair p p) + (fun (l1,l2) -> + let t1 = S.of_list l1 and t2 = S.of_list l2 in + let t = S.merge (fun a _ -> Some a) t1 t2 in + S.to_iter t |> Iter.for_all + (fun (k,v) -> S.find k t1 = Some v || S.find k t2 = Some v) && + S.to_iter t1 |> Iter.for_all (fun (k,_) -> S.find k t <> None) && + S.to_iter t2 |> Iter.for_all (fun (k,_) -> S.find k t <> None));; + +t @@ fun () -> T.size t1 = List.length l1 + +let eq' = eq ~printer:CCFormat.(to_string (list (pair (list int) string)));; +eq' [ [1], "1"; [1;2], "12"; [1;2;3], "123"; [2;1], "21" ] + (T.above [1] t1 |> Iter.to_list);; +eq' [ [1;2], "12"; [1;2;3], "123"; [2;1], "21" ] + (T.above [1;1] t1 |> Iter.to_list);; +eq' [ [1;2], "12"; [1], "1"; [], "[]" ] + (T.below [1;2] t1 |> Iter.to_list);; +eq' [ [1], "1"; [], "[]" ] + (T.below [1;1] t1 |> Iter.to_list);; + +(* NOTE: Regression test. See #158 *) +t @@ fun () -> + let module TPoly = Make (struct + type t = (unit -> char) list + type char_ = char + let compare = compare + let to_iter a k = List.iter (fun c -> k (c ())) a + let of_list l = List.map (fun c -> (fun () -> c)) l + end) + in + let trie = TPoly.of_list [[fun () -> 'a'], 1; [fun () -> 'b'], 2] in + ignore (TPoly.below [fun () -> 'a'] trie |> Iter.to_list); + true;; + +q ~count:30 + Q.(list_of_size Gen.(0--100) (pair printable_string small_int)) (fun l -> + let t = S.of_list l in + S.check_invariants t);; + +let rec sorted ~rev = function + | [] | [_] -> true + | x :: ((y ::_) as tl) -> + (if rev then x >= y else x <= y) && sorted ~rev tl + +let gen_str = Q.small_printable_string;; + +q ~count:200 + Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) + (fun l -> let t = String.of_list l in + List.for_all (fun (k,_) -> + String.above k t |> Iter.for_all (fun (k',_) -> k' >= k)) + l);; + +q ~count:200 + Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) + (fun l -> let t = String.of_list l in + List.for_all (fun (k,_) -> + String.below k t |> Iter.for_all (fun (k',_) -> k' <= k)) + l);; + +q ~count:200 + Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) + (fun l -> let t = String.of_list l in + List.for_all (fun (k,_) -> + String.above k t |> Iter.to_list |> sorted ~rev:false) + l);; + +q ~count:200 + Q.(list_of_size Gen.(1 -- 20) (pair gen_str small_int)) + (fun l -> let t = String.of_list l in + List.for_all (fun (k,_) -> + String.below k t |> Iter.to_list |> sorted ~rev:true) + l);; diff --git a/tests/data/t_wbt.ml b/tests/data/t_wbt.ml new file mode 100644 index 00000000..ebf2aeab --- /dev/null +++ b/tests/data/t_wbt.ml @@ -0,0 +1,100 @@ + + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCWBTree;; + +module M = Make(CCInt) + +type op = + | Add of int * int + | Remove of int + | Remove_min + +let gen_op = CCRandom.(choose_exn + [ return Remove_min + ; map (fun x->Remove x) small_int + ; pure (fun x y->Add (x,y)) <*> small_int <*> small_int]) +and pp_op =let open Printf in +function Add (x,y) -> sprintf "Add %d %d" x y + | Remove x -> sprintf "Remove %d" x | Remove_min -> "Remove_min" + +let apply_ops l m = List.fold_left + (fun m -> function + | Add (i,b) -> M.add i b m + | Remove i -> M.remove i m + | Remove_min -> + try let _, _, m' = M.extract_min m in m' with Not_found -> m + ) m l + +let op = Q.make ~print:pp_op gen_op + +let _list_uniq = CCList.sort_uniq ~cmp:(CCFun.compose_binop fst Stdlib.compare);; + +q ~count:200 + Q.(list op) (fun l -> let m = apply_ops l M.empty in M.balanced m);; + +q Q.(list (pair small_int bool)) (fun l -> + let m = M.of_list l in + M.balanced m);; +q Q.(list (pair small_int small_int)) (fun l -> + let l = _list_uniq l in let m = M.of_list l in + List.for_all (fun (k,v) -> M.get_exn k m = v) l);; +q Q.(list (pair small_int small_int)) (fun l -> + let l = _list_uniq l in let m = M.of_list l in + M.cardinal m = List.length l);; + +q Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) (fun l -> + let m = M.of_list l in + List.for_all (fun (k,_) -> + M.mem k m && (let m' = M.remove k m in not (M.mem k m'))) l);; +q Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) (fun l -> + let m = M.of_list l in + List.for_all (fun (k,_) -> let m' = M.remove k m in M.balanced m') l);; + +t @@ fun () -> + let m = CCList.(0 -- 1000 |> map (fun i->i,i) |> M.of_list) in + List.for_all (fun i -> M.nth_exn i m = (i,i)) CCList.(0--1000);; + +q ~count:1_000 + Q.(list_of_size Gen.(0 -- 30) (pair small_int small_int)) (fun l -> + let l = CCList.sort_uniq ~cmp:(CCFun.compose_binop fst compare) l in + let m = M.of_list l in + List.for_all + (fun (k,v) -> match M.get_rank k m with + | `First | `After _ -> true + | `At n -> (k,v) = M.nth_exn n m) + l);; + +q ~count:20 + Q.(list_of_size Gen.(1 -- 100) (pair small_int small_int)) ( fun lst -> + let lst = _list_uniq lst in + let m = M.of_list lst in + List.for_all (fun (k,v) -> + let l, v', r = M.split k m in + v' = Some v + && (M.to_iter l |> Iter.for_all (fun (k',_) -> k' < k)) + && (M.to_iter r |> Iter.for_all (fun (k',_) -> k' > k)) + && M.balanced m + && M.cardinal l + M.cardinal r + 1 = List.length lst + ) lst);; + +t @@ fun () -> + let m1 = M.of_list [1, 1; 2, 2; 4, 4] in + let m2 = M.of_list [1, 1; 3, 3; 4, 4; 7, 7] in + let m = M.merge ~f:(fun _ -> CCOption.map2 (+)) m1 m2 in + assert_bool "balanced" (M.balanced m); + assert_equal + ~cmp:(CCList.equal (CCPair.equal CCInt.equal CCInt.equal)) + ~printer:CCFormat.(to_string (list (pair int int))) + [1, 2; 4, 8] + (M.to_list m |> List.sort Stdlib.compare); + true;; + +q Q.(let p = list (pair small_int small_int) in pair p p) (fun (l1, l2) -> + let l1 = _list_uniq l1 and l2 = _list_uniq l2 in + let m1 = M.of_list l1 and m2 = M.of_list l2 in + let m = M.merge ~f:(fun _ v1 v2 -> match v1 with + | None -> v2 | Some _ as r -> r) m1 m2 in + List.for_all (fun (k,v) -> M.get_exn k m = v) l1 && + List.for_all (fun (k,v) -> M.mem k m1 || M.get_exn k m = v) l2);; diff --git a/tests/data/t_zipper.ml b/tests/data/t_zipper.ml new file mode 100644 index 00000000..14b01aec --- /dev/null +++ b/tests/data/t_zipper.ml @@ -0,0 +1,23 @@ + + +module Test = (val Containers_testlib.make ~__FILE__()) +open Test +open CCZipper;; + +t @@ fun () -> (is_empty empty);; +t @@ fun () -> not ([42] |> make |> right |> is_empty);; + +let zip_gen = Q.(pair (small_list int)(small_list int));; + +q zip_gen (fun z -> + to_list z = List.rev (to_rev_list z));; + +q zip_gen (fun g -> + is_focused g = (focused g |> CCOption.is_some));; + +q Q.(triple int (list small_int)(list small_int)) (fun (x,l,r) -> + insert x (l,r) |> remove = (l,r));; + +eq ([1], [2]) (drop_after ([1], [2;3]));; +eq ([1], []) (drop_after ([1], []));; +eq ([1], []) (drop_after_and_focused ([1], [2;3]));;