simon/ocaml-containers
1
0
Fork 0
mirror of https://github.com/c-cube/ocaml-containers.git synced 2026-01-28 11:54:51 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

wip: convert tests into testlib

Browse source
This commit is contained in:
Simon Cruanes 2022-07-02 14:46:44 -04:00
parent 91ddccc782
commit 1111c0fa9a
No known key found for this signature in database
GPG key ID: EBFFF6F283F3A2B4
29 changed files with 997 additions and 1056 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

311
src/data/CCBV.ml
View file

@ -4,10 +4,6 @@
(* TODO: move to [bytes] and replace all [mod] and [/] with bitshifts (* TODO: move to [bytes] and replace all [mod] and [/] with bitshifts
because width_=8 *) because width_=8 *)
(*$inject
let ppli = CCFormat.(Dump.list int)
*)
let width_ = Sys.word_size - 1 let width_ = Sys.word_size - 1
(** We use OCamls ints to store the bits. We index them from the (** We use OCamls ints to store the bits. We index them from the
@ -62,25 +58,8 @@ let create ~size default =
{ a; size } { a; size }
) )
(*$Q
(Q.pair Q.small_int Q.bool) (fun (size, b) -> create ~size b |> length = size)
*)
(*$T
create ~size:17 true |> cardinal = 17
create ~size:32 true |> cardinal = 32
create ~size:132 true |> cardinal = 132
create ~size:200 false |> cardinal = 0
create ~size:29 true |> to_sorted_list = CCList.range 0 28
*)
let copy bv = { bv with a = Array.copy bv.a } let copy bv = { bv with a = Array.copy bv.a }
(*$Q
(Q.list Q.small_int) (fun l -> \
let bv = of_list l in to_list bv = to_list (copy bv))
*)
let capacity bv = width_ * Array.length bv.a let capacity bv = width_ * Array.length bv.a
let cardinal bv = let cardinal bv =
@ -93,10 +72,6 @@ let cardinal bv =
!n !n
) )
(*$Q
Q.small_int (fun size -> create ~size true |> cardinal = size)
*)
let really_resize_ bv ~desired ~current size = let really_resize_ bv ~desired ~current size =
let a' = Array.make desired 0 in let a' = Array.make desired 0 in
Array.blit bv.a 0 a' 0 current; Array.blit bv.a 0 a' 0 current;
@ -127,15 +102,6 @@ let resize bv size =
then () then ()
else grow_ bv size else grow_ bv size
(*$R
let bv1 = CCBV.create ~size:87 true in
assert_equal ~printer:string_of_int 87 (CCBV.cardinal bv1);
*)
(*$Q
Q.small_int (fun n -> CCBV.cardinal (CCBV.create ~size:n true) = n)
*)
let is_empty bv = let is_empty bv =
try try
for i = 0 to Array.length bv.a - 1 do for i = 0 to Array.length bv.a - 1 do
@ -153,22 +119,6 @@ let get bv i =
then (Array.unsafe_get bv.a n) land (1 lsl i) <> 0 then (Array.unsafe_get bv.a n) land (1 lsl i) <> 0
else false else false
(*$R
let bv = CCBV.create ~size:99 false in
assert_bool "32 must be false" (not (CCBV.get bv 32));
assert_bool "88 must be false" (not (CCBV.get bv 88));
assert_bool "5 must be false" (not (CCBV.get bv 5));
CCBV.set bv 32;
CCBV.set bv 88;
CCBV.set bv 5;
assert_bool "32 must be true" (CCBV.get bv 32);
assert_bool "88 must be true" (CCBV.get bv 88);
assert_bool "5 must be true" (CCBV.get bv 5);
assert_bool "33 must be false" (not (CCBV.get bv 33));
assert_bool "44 must be false" (not (CCBV.get bv 44));
assert_bool "1 must be false" (not (CCBV.get bv 1));
*)
let set bv i = let set bv i =
if i < 0 then invalid_arg "set: negative index" if i < 0 then invalid_arg "set: negative index"
else ( else (
@ -178,11 +128,6 @@ let set bv i =
Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) lor (1 lsl j)) Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) lor (1 lsl j))
) )
(*$T
let bv = create ~size:3 false in set bv 0; get bv 0
let bv = create ~size:3 false in set bv 1; not (get bv 0)
*)
let reset bv i = let reset bv i =
if i < 0 then invalid_arg "reset: negative index" if i < 0 then invalid_arg "reset: negative index"
else ( else (
@ -192,10 +137,6 @@ let reset bv i =
Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) land (lnot (1 lsl j))) Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) land (lnot (1 lsl j)))
) )
(*$T
let bv = create ~size:3 false in set bv 0; reset bv 0; not (get bv 0)
*)
let flip bv i = let flip bv i =
if i < 0 then invalid_arg "reset: negative index" if i < 0 then invalid_arg "reset: negative index"
else ( else (
@ -205,48 +146,13 @@ let flip bv i =
Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) lxor (1 lsl j)) Array.unsafe_set bv.a n ((Array.unsafe_get bv.a n) lxor (1 lsl j))
) )
(*$R
let bv = of_list [1;10; 11; 30] in
flip bv 10;
assert_equal ~printer:Q.Print.(list int) [1;11;30] (to_sorted_list bv);
assert_equal ~printer:Q.Print.bool false (get bv 10);
flip bv 10;
assert_equal ~printer:Q.Print.bool true (get bv 10);
flip bv 5;
assert_equal ~printer:Q.Print.(list int) [1;5;10;11;30] (to_sorted_list bv);
assert_equal ~printer:Q.Print.bool true (get bv 5);
flip bv 100;
assert_equal ~printer:Q.Print.(list int) [1;5;10;11;30;100] (to_sorted_list bv);
assert_equal ~printer:Q.Print.bool true (get bv 100);
*)
let clear bv = let clear bv =
Array.fill bv.a 0 (Array.length bv.a) 0 Array.fill bv.a 0 (Array.length bv.a) 0
(*$T
let bv = create ~size:37 true in cardinal bv = 37 && (clear bv; cardinal bv= 0)
*)
(*$R
let bv = CCBV.of_list [1; 5; 200] in
assert_equal ~printer:string_of_int 3 (CCBV.cardinal bv);
CCBV.clear bv;
assert_equal ~printer:string_of_int 0 (CCBV.cardinal bv);
assert_bool "must be empty" (CCBV.is_empty bv);
*)
let equal x y : bool = let equal x y : bool =
x.size = y.size && x.size = y.size &&
x.a = y.a x.a = y.a
(*$T
equal (of_list [1; 3; 4]) (of_list [1; 3; 4])
equal (empty()) (empty())
not (equal (empty ()) (of_list [1]))
not (equal (empty ()) (of_list [2; 5]))
not (equal (of_list [1;3]) (of_list [2; 3]))
*)
let iter bv f = let iter bv f =
let len = array_length_of_size bv.size in let len = array_length_of_size bv.size in
assert (len <= Array.length bv.a); assert (len <= Array.length bv.a);
@ -267,95 +173,14 @@ let iter bv f =
done done
) )
(*$R
List.iter
(fun size ->
let bv = create ~size false in
set bv 5;
let n = ref 0 in
iter bv (fun i b -> incr n; assert_equal b (i=5));
assert_bool "exactly size" (!n = size))
[30; 100; 255; 256;10_000]
*)
(*$inject
let iter_zip s k = s (fun x y -> k(x,y))
*)
(*$= & ~printer:Q.Print.(list (pair int bool))
[] (iter (create ~size:0 false) |> iter_zip |> Iter.to_list)
[0, false; 1, true; 2, false] \
(iter (let bv = create ~size:3 false in set bv 1; bv) |> iter_zip |> Iter.to_list)
*)
(*$Q
Q.(small_int) (fun n -> \
assert (n >= 0); \
let bv = create ~size:n true in \
let l = iter bv |> iter_zip |> Iter.to_list in \
List.length l = n && List.for_all (fun (_,b) -> b) l)
*)
let[@inline] iter_true bv f = let[@inline] iter_true bv f =
iter bv (fun i b -> if b then f i else ()) iter bv (fun i b -> if b then f i else ())
(*$T
of_list [1;5;7] |> iter_true |> Iter.to_list |> List.sort CCOrd.compare = [1;5;7]
*)
(*$inject
let _gen = Q.Gen.(map of_list (list nat))
let _pp bv = Q.Print.(list string) (List.map string_of_int (to_list bv))
let _small bv = length bv
let gen_bv = Q.make ~small:_small ~print:_pp _gen
*)
(*$QR
gen_bv (fun bv ->
let l' = Iter.to_rev_list (CCBV.iter_true bv) in
let bv' = CCBV.of_list l' in
CCBV.cardinal bv = CCBV.cardinal bv'
)
*)
let to_list bv = let to_list bv =
let l = ref [] in let l = ref [] in
iter_true bv (fun i -> l := i :: !l); iter_true bv (fun i -> l := i :: !l);
!l !l
(*$R
let bv = CCBV.of_list [1; 5; 156; 0; 222] in
assert_equal ~printer:string_of_int 5 (CCBV.cardinal bv);
CCBV.set bv 201;
assert_equal ~printer:string_of_int 6 (CCBV.cardinal bv);
let l = CCBV.to_list bv in
let l = List.sort compare l in
assert_equal [0;1;5;156;201;222] l;
*)
(*$= & ~printer:(CCFormat.to_string ppli)
[1;2;3;4;64;130] (of_list [1;2;3;4;64;130] |> to_sorted_list)
*)
(*$Q
Q.(small_list small_nat) (fun l -> \
let l = List.sort_uniq CCOrd.compare l in \
let l2 = of_list l |> to_sorted_list in \
if l=l2 then true else Q.Test.fail_reportf "l1=%a, l2=%a" ppli l ppli l2)
Q.(small_list small_nat) (fun l -> \
let bv = of_list l in \
let l1 = bv |> to_sorted_list in \
let l2 = \
(CCList.init (length bv) (get bv) |> List.mapi (fun i b->i,b) \
|>CCList.filter_map (function (i,true) -> Some i| _ ->None)) in \
if l1=l2 then true else Q.Test.fail_reportf "l1=%a, l2=%a" ppli l1 ppli l2)
*)
(*$= & ~cmp:equal ~printer:(CCFormat.to_string pp)
(of_list [0]) (let bv=empty() in set bv 0; bv)
*)
let to_sorted_list bv = let to_sorted_list bv =
List.rev (to_list bv) List.rev (to_list bv)
@ -366,12 +191,6 @@ let of_list l =
List.iter (fun i -> set bv i) l; List.iter (fun i -> set bv i) l;
bv bv
(*$T
of_list [1;32;64] |> CCFun.flip get 64
of_list [1;32;64] |> CCFun.flip get 32
of_list [1;31;63] |> CCFun.flip get 63
*)
exception FoundFirst of int exception FoundFirst of int
let first_exn bv = let first_exn bv =
@ -385,19 +204,10 @@ let first bv =
try Some (first_exn bv) try Some (first_exn bv)
with Not_found -> None with Not_found -> None
(*$T
of_list [50; 10; 17; 22; 3; 12] |> first = Some 3
*)
let filter bv p = let filter bv p =
iter_true bv iter_true bv
(fun i -> if not (p i) then reset bv i) (fun i -> if not (p i) then reset bv i)
(*$T
let bv = of_list [1;2;3;4;5;6;7] in filter bv (fun x->x mod 2=0); \
to_sorted_list bv = [2;4;6]
*)
let negate_self b = let negate_self b =
let len = Array.length b.a in let len = Array.length b.a in
for n = 0 to len - 1 do for n = 0 to len - 1 do
@ -408,10 +218,6 @@ let negate_self b =
let l = Array.length b.a - 1 in let l = Array.length b.a - 1 in
Array.unsafe_set b.a l (lsb_masks_.(r) land (Array.unsafe_get b.a l)) Array.unsafe_set b.a l (lsb_masks_.(r) land (Array.unsafe_get b.a l))
(*$= & ~printer:(CCFormat.to_string ppli)
[0;3;4;6] (let v = of_list [1;2;5;7;] in negate_self v; to_sorted_list v)
*)
let negate b = let negate b =
let a = Array.map (lnot) b.a in let a = Array.map (lnot) b.a in
let r = b.size mod width_ in let r = b.size mod width_ in
@ -421,10 +227,6 @@ let negate b =
); );
{ a ; size = b.size } { a ; size = b.size }
(*$Q
Q.small_int (fun size -> create ~size false |> negate |> cardinal = size)
*)
let union_into_no_resize_ ~into bv = let union_into_no_resize_ ~into bv =
assert (Array.length into.a >= Array.length bv.a); assert (Array.length into.a >= Array.length bv.a);
for i = 0 to Array.length bv.a - 1 do for i = 0 to Array.length bv.a - 1 do
@ -452,47 +254,6 @@ let union b1 b2 =
into into
) )
(*$R
let bv1 = CCBV.of_list [1;2;3;4] in
let bv2 = CCBV.of_list [4;200;3] in
let bv = CCBV.union bv1 bv2 in
let l = List.sort compare (CCBV.to_list bv) in
assert_equal ~printer:(CCFormat.(to_string (Dump.list int)))
[1;2;3;4;200] l;
()
*)
(*$R
let bv1 = CCBV.of_list [1;2;3;4;64;130] in
let bv2 = CCBV.of_list [4;64;3;120] in
let bv = CCBV.union bv1 bv2 in
assert_equal ~cmp:equal ~printer:(CCFormat.to_string pp)
(of_list [1;2;3;4;64;120;130]) bv;
()
*)
(*$R
let bv1 = CCBV.of_list [1;2;3;4] in
let bv2 = CCBV.of_list [4;200;3] in
let bv = CCBV.union bv1 bv2 in
assert_equal ~cmp:equal ~printer:(CCFormat.to_string pp)
(of_list [1;2;3;4;200]) bv;
()
*)
(*$R
let v1 = CCBV.empty () in
let () = CCBV.set v1 64 in
let v2 = CCBV.diff (CCBV.empty ()) (CCBV.empty ()) in
let v3 = CCBV.union v1 v2 in
assert_equal ~printer:(CCFormat.to_string pp) ~cmp:CCBV.equal v1 v3
*)
(*$T
union (of_list [1;2;3;4;5]) (of_list [7;3;5;6]) |> to_sorted_list = CCList.range 1 7
*)
let inter_into_no_resize_ ~into bv = let inter_into_no_resize_ ~into bv =
assert (Array.length into.a <= Array.length bv.a); assert (Array.length into.a <= Array.length bv.a);
for i = 0 to (Array.length into.a) - 1 do for i = 0 to (Array.length into.a) - 1 do
@ -518,28 +279,6 @@ let inter b1 b2 =
into into
) )
(*$T
inter (of_list [1;2;3;4]) (of_list [2;4;6;1]) |> to_sorted_list = [1;2;4]
*)
(*$R
let bv1 = CCBV.of_list [1;2;3;4;200;201] in
let bv2 = CCBV.of_list [4;200;3] in
let bv = CCBV.inter bv1 bv2 in
let l = List.sort compare (CCBV.to_list bv) in
assert_equal ~printer:(CCFormat.(to_string (Dump.list int)))
[3;4;200] l;
()
*)
(*$R
let bv1 = CCBV.of_list [1;2;3;4] in
let bv2 = CCBV.of_list [4;200;3] in
CCBV.inter_into ~into:bv1 bv2;
let l = List.sort compare (CCBV.to_list bv1) in
assert_equal [3;4] l;
*)
(* Underlying size depends on the 'in_' set for diff, so we don't change (* Underlying size depends on the 'in_' set for diff, so we don't change
it's size! *) it's size! *)
let diff_into ~into bv = let diff_into ~into bv =
@ -554,21 +293,6 @@ let diff in_ not_in =
diff_into ~into not_in; diff_into ~into not_in;
into into
(*$T
diff (of_list [1;2;3]) (of_list [1;2;3]) |> to_list = [];
diff (of_list [1;2;3]) (of_list [1;2;3;4]) |> to_list = [];
diff (of_list [1;2;3;4]) (of_list [1;2;3]) |> to_list = [4];
diff (of_list [1;2;3]) (of_list [1;2;3;400]) |> to_list = [];
diff (of_list [1;2;3;400]) (of_list [1;2;3]) |> to_list = [400];
*)
(*$R
let v1 = CCBV.empty () in
set v1 65;
let v2 = CCBV.diff v1 v1 in
assert_bool (CCFormat.asprintf "bv: %a" pp v2) (CCBV.is_empty v2)
*)
let select bv arr = let select bv arr =
let l = ref [] in let l = ref [] in
begin try begin try
@ -581,13 +305,6 @@ let select bv arr =
end; end;
!l !l
(*$R
let bv = CCBV.of_list [1;2;5;400] in
let arr = [|"a"; "b"; "c"; "d"; "e"; "f"|] in
let l = List.sort compare (CCBV.select bv arr) in
assert_equal ["b"; "c"; "f"] l;
*)
let selecti bv arr = let selecti bv arr =
let l = ref [] in let l = ref [] in
begin try begin try
@ -600,29 +317,10 @@ let selecti bv arr =
end; end;
!l !l
(*$R
let bv = CCBV.of_list [1;2;5;400] in
let arr = [|"a"; "b"; "c"; "d"; "e"; "f"|] in
let l = List.sort compare (CCBV.selecti bv arr) in
assert_equal [("b",1); ("c",2); ("f",5)] l;
*)
(*$= & ~printer:Q.Print.(list (pair int int))
[1,1; 3,3; 4,4] (selecti (of_list [1;4;3]) [| 0;1;2;3;4;5;6;7;8 |] \
|> List.sort CCOrd.compare)
*)
type 'a iter = ('a -> unit) -> unit type 'a iter = ('a -> unit) -> unit
let to_iter bv k = iter_true bv k let to_iter bv k = iter_true bv k
(*$Q
Q.(small_int) (fun i -> \
let i = max 1 i in \
let bv = create ~size:i true in \
i = (to_iter bv |> Iter.length))
*)
let of_iter seq = let of_iter seq =
let l = ref [] and maxi = ref 0 in let l = ref [] and maxi = ref 0 in
seq (fun x -> l := x :: !l; maxi := max !maxi x); seq (fun x -> l := x :: !l; maxi := max !maxi x);
@ -630,11 +328,6 @@ let of_iter seq =
List.iter (fun i -> set bv i) !l; List.iter (fun i -> set bv i) !l;
bv bv
(*$T
CCList.range 0 10 |> CCList.to_iter |> of_iter |> to_iter \
|> CCList.of_iter |> List.sort CCOrd.compare = CCList.range 0 10
*)
let pp out bv = let pp out bv =
Format.pp_print_string out "bv {"; Format.pp_print_string out "bv {";
iter bv iter bv
@ -643,8 +336,4 @@ let pp out bv =
); );
Format.pp_print_string out "}" Format.pp_print_string out "}"
(*$= & ~printer:CCFun.id
"bv {00001}" (CCFormat.to_string pp (of_list [4]))
*)
let __to_word_l bv = Array.to_list bv.a let __to_word_l bv = Array.to_list bv.a

14
src/data/CCBijection.ml
View file

@ -117,17 +117,3 @@ module Make(L : OrderedType)(R : OrderedType) = struct
let to_iter m yield = MapL.iter (fun k v -> yield (k,v)) m.left let to_iter m yield = MapL.iter (fun k v -> yield (k,v)) m.left
end end
(*$inject
open Containers
module M = Make(Int)(String)
*)
(*$=
2 (M.of_list [1,"1"; 2, "2"] |> M.cardinal)
"1" (M.of_list [1,"1"; 2, "2"] |> M.find_left 1)
"2" (M.of_list [1,"1"; 2, "2"] |> M.find_left 2)
1 (M.of_list [1,"1"; 2, "2"] |> M.find_right "1")
2 (M.of_list [1,"1"; 2, "2"] |> M.find_right "2")
*)

60
src/data/CCBitField.ml
View file

@ -7,59 +7,6 @@ exception Frozen
let max_width = Sys.word_size - 2 let max_width = Sys.word_size - 2
(*$R
let module B = CCBitField.Make(struct end) in
let x = B.mk_field () in
let y = B.mk_field () in
let z = B.mk_field () in
let f = B.empty |> B.set x true |> B.set y true in
assert_bool "z_false" (not (B.get z f)) ;
assert_bool "z_true" (f |> B.set z true |> B.get z);
*)
(*$R
let module B = CCBitField.Make(struct end) in
let _ = B.mk_field () in
B.freeze();
assert_bool "must raise"
(try ignore (B.mk_field()); false with Frozen -> true);
*)
(*$R
let module B = CCBitField.Make(struct end) in
let x = B.mk_field () in
let y = B.mk_field () in
let z = B.mk_field () in
let u = B.mk_field () in
B.freeze();
let f = B.empty
|> B.set y true
|> B.set z true
in
assert_equal ~printer:CCInt.to_string 6 (f :> int) ;
assert_equal false (B.get x f) ;
assert_equal true (B.get y f) ;
assert_equal true (B.get z f);
let f' = B.set u true f in
assert_equal false (B.get x f') ;
assert_equal true (B.get y f') ;
assert_equal true (B.get z f');
assert_equal true (B.get u f');
()
*)
module type S = sig module type S = sig
type t = private int type t = private int
(** Generative type of bitfields. Each instantiation of the functor (** Generative type of bitfields. Each instantiation of the functor
@ -94,13 +41,6 @@ let rec all_bits_ acc w =
let acc = acc lor (1 lsl w-1) in let acc = acc lor (1 lsl w-1) in
all_bits_ acc (w-1) all_bits_ acc (w-1)
(*$T
all_bits_ 0 1 = 1
all_bits_ 0 2 = 3
all_bits_ 0 3 = 7
all_bits_ 0 4 = 15
*)
(* increment and return previous value *) (* increment and return previous value *)
let get_then_incr n = let get_then_incr n =
let x = !n in let x = !n in

44
src/data/CCCache.ml
View file

@ -55,20 +55,6 @@ let with_cache_rec ?(cb=default_callback_) c f =
let rec f' x = with_cache ~cb c (f f') x in let rec f' x = with_cache ~cb c (f f') x in
f' f'
(*$R
let c = unbounded ~eq:Int64.equal 256 in
let fib = with_cache_rec c
(fun self n -> match n with
| 1L | 2L -> 1L
| _ -> CCInt64.(self (n-1L) + self (n-2L))
)
in
assert_equal 55L (fib 10L);
assert_equal 832040L (fib 30L);
assert_equal 12586269025L (fib 50L);
assert_equal 190392490709135L (fib 70L)
*)
let size c = c.size () let size c = c.size ()
let iter c f = c.iter f let iter c f = c.iter f
@ -311,36 +297,6 @@ let lru (type a) ~eq ?(hash=default_hash_) size =
iter=L.iter c; iter=L.iter c;
} }
(*$T
let eq (i1,_)(i2,_) = i1=i2 and hash (i,_) = CCInt.hash i in \
let c = lru ~eq ~hash 2 in \
ignore (with_cache c CCFun.id (1, true)); \
ignore (with_cache c CCFun.id (1, false)); \
with_cache c CCFun.id (1, false) = (1, true)
*)
(*$T
let f = (let r = ref 0 in fun _ -> incr r; !r) in \
let c = lru ~eq:CCInt.equal 2 in \
let res1 = with_cache c f 1 in \
let res2 = with_cache c f 2 in \
let res3 = with_cache c f 3 in \
let res1_bis = with_cache c f 1 in \
res1 <> res2 && res2 <> res3 && res3 <> res1_bis && res1_bis <> res1
*)
(*$R
let f = (let r = ref 0 in fun _ -> incr r; !r) in
let c = lru ~eq:CCEqual.unit 2 in
let x = with_cache c f () in
assert_equal 1 x;
assert_equal 1 (size c);
clear c ;
assert_equal 0 (size c);
let y = with_cache c f () in
assert_equal 2 y ;
*)
module UNBOUNDED(X:HASH) = struct module UNBOUNDED(X:HASH) = struct
module H = Hashtbl.Make(X) module H = Hashtbl.Make(X)

228
src/data/CCDeque.ml
View file

@ -27,24 +27,6 @@ type 'a t = {
} }
(** The deque, a double linked list of cells *) (** The deque, a double linked list of cells *)
(*$inject
let plist l = CCFormat.(to_string (list int)) l
let pint i = string_of_int i
*)
(*$R
let q = create () in
add_iter_back q Iter.(3 -- 5);
assert_equal [3;4;5] (to_list q);
add_iter_front q Iter.(of_list [2;1]);
assert_equal [1;2;3;4;5] (to_list q);
push_front q 0;
assert_equal [0;1;2;3;4;5] (to_list q);
assert_equal 5 (take_back q);
assert_equal 0 (take_front q);
assert_equal 4 (length q);
*)
exception Empty exception Empty
let create () = let create () =
@ -55,15 +37,6 @@ let clear q =
q.size <- 0; q.size <- 0;
() ()
(*$R
let q = of_iter Iter.(1 -- 100) in
assert_equal 100 (length q);
clear q;
assert_equal 0 (length q);
assert_raises Empty (fun () -> peek_front q);
assert_raises Empty (fun () -> peek_back q);
*)
let incr_size_ d = d.size <- d.size + 1 let incr_size_ d = d.size <- d.size + 1
let decr_size_ d = d.size <- d.size - 1 let decr_size_ d = d.size <- d.size - 1
@ -121,24 +94,6 @@ let peek_front d = match peek_front_opt d with
| None -> raise Empty | None -> raise Empty
| Some x -> x | Some x -> x
(*$T
of_list [1;2;3] |> peek_front = 1
try (ignore (of_list [] |> peek_front); false) with Empty -> true
*)
(*$R
let d = of_iter Iter.(1 -- 10) in
let printer = pint in
OUnit2.assert_equal ~printer 1 (peek_front d);
push_front d 42;
OUnit2.assert_equal ~printer 42 (peek_front d);
OUnit2.assert_equal ~printer 42 (take_front d);
OUnit2.assert_equal ~printer 1 (take_front d);
OUnit2.assert_equal ~printer 2 (take_front d);
OUnit2.assert_equal ~printer 3 (take_front d);
OUnit2.assert_equal ~printer 10 (peek_back d);
*)
let peek_back_opt d = let peek_back_opt d =
match d.cur with match d.cur with
| Empty -> None | Empty -> None
@ -151,23 +106,6 @@ let peek_back_opt d =
let peek_back d = match peek_back_opt d with let peek_back d = match peek_back_opt d with
| None -> raise Empty | None -> raise Empty
| Some x -> x | Some x -> x
(*$T
of_list [1;2;3] |> peek_back = 3
try (ignore (of_list [] |> peek_back); false) with Empty -> true
*)
(*$R
let d = of_iter Iter.(1 -- 10) in
let printer = pint in
OUnit2.assert_equal ~printer 1 (peek_front d);
push_back d 42;
OUnit2.assert_equal ~printer 42 (peek_back d);
OUnit2.assert_equal ~printer 42 (take_back d);
OUnit2.assert_equal ~printer 10 (take_back d);
OUnit2.assert_equal ~printer 9 (take_back d);
OUnit2.assert_equal ~printer 8 (take_back d);
OUnit2.assert_equal ~printer 1 (peek_front d);
*)
let take_back_node_ n = match n.cell with let take_back_node_ n = match n.cell with
| One x -> (true, x) | One x -> (true, x)
@ -203,22 +141,11 @@ let take_back d = match take_back_opt d with
| None -> raise Empty | None -> raise Empty
| Some x -> x | Some x -> x
(*$T
let q = of_list [1] in take_back q = 1 && to_list q = []
let q = of_list [1;2] in take_back q = 2 && to_list q = [1]
let q = of_list [1;2;3] in take_back q = 3 && to_list q = [1;2]
let q = of_list [1;2;3;4;5;6;7;] in take_back q = 7 && to_list q = [1;2;3;4;5;6]
*)
let take_front_node_ n = match n.cell with let take_front_node_ n = match n.cell with
| One x -> (true, x) | One x -> (true, x)
| Two (x,y) -> n.cell <- One y; (false, x) | Two (x,y) -> n.cell <- One y; (false, x)
| Three (x,y,z) -> n.cell <- Two (y,z); (false, x) | Three (x,y,z) -> n.cell <- Two (y,z); (false, x)
(*$T
let q = of_list [1;2;3] in take_front q = 1 && to_list q = [2;3]
*)
let take_front_opt d = let take_front_opt d =
match d.cur with match d.cur with
| Empty -> None | Empty -> None
@ -247,16 +174,8 @@ let take_front d = match take_front_opt d with
let remove_back d = ignore (take_back_opt d) let remove_back d = ignore (take_back_opt d)
(*$T remove_back
let q = of_list [1;2;3;4;5;6;7] in remove_back q; to_list q = [1;2;3;4;5;6]
*)
let remove_front d = ignore (take_front_opt d) let remove_front d = ignore (take_front_opt d)
(*$T remove_front
let q = of_list [1;2;3;4;5;6;7] in remove_front q; to_list q = [2;3;4;5;6;7]
*)
let update_front d f = let update_front d f =
match d.cur with match d.cur with
| Empty -> () | Empty -> ()
@ -285,23 +204,6 @@ let update_front d f =
| Some x -> cur.cell <- Three (x,y,z) | Some x -> cur.cell <- Three (x,y,z)
end end
(*$T update_front
let q = of_list [1;2;3;4;5;6;7] in update_front q (fun _ -> None); to_list q = [2;3;4;5;6;7]
let q = of_list [1;2;3;4;5;6;7] in update_front q (fun _ -> Some 9); to_list q = [9;2;3;4;5;6;7]
*)
(*$Q update_front
Q.(list int) (fun l -> \
let q = of_list l in \
update_front q (fun _ -> None); \
let output_list = if l = [] then [] else List.tl l in \
to_list q = output_list)
Q.(list int) (fun l -> \
let q = of_list l in \
update_front q (fun x -> Some (x + 42)); \
let output_list = if l = [] then [] else List.((hd l + 42)::(tl l)) in \
to_list q = output_list)
*)
let update_back d f = let update_back d f =
match d.cur with match d.cur with
| Empty -> () | Empty -> ()
@ -326,23 +228,6 @@ let update_back d f =
| Some z -> n.cell <- Three (x,y,z) | Some z -> n.cell <- Three (x,y,z)
end end
(*$T update_back
let q = of_list [1;2;3;4;5;6;7] in update_back q (fun _ -> None); to_list q = [1;2;3;4;5;6]
let q = of_list [1;2;3;4;5;6;7] in update_back q (fun _ -> Some 9); to_list q = [1;2;3;4;5;6;9]
*)
(*$Q update_back
Q.(list int) (fun l -> \
let q = of_list l in \
update_back q (fun _ -> None); \
let output_list = if l = [] then [] else List.(rev l |> tl) in \
(to_list q |> List.rev) = output_list)
Q.(list int) (fun l -> \
let q = of_list l in \
update_back q (fun x -> Some (x + 42)); \
let output_list = if l = [] then [] else List.(rev l |> fun l -> (hd l + 42)::(tl l)) in \
(to_list q |> List.rev) = output_list)
*)
let iter f d = let iter f d =
let rec iter f ~first n = let rec iter f ~first n =
begin match n.cell with begin match n.cell with
@ -357,29 +242,10 @@ let iter f d =
| Node cur -> | Node cur ->
iter f ~first:cur cur iter f ~first:cur cur
(*$T
let n = ref 0 in iter (fun _ -> incr n) (of_list [1;2;3]); !n = 3
*)
(*$R
let d = of_iter Iter.(1 -- 5) in
let s = Iter.from_iter (fun k -> iter k d) in
let l = Iter.to_list s in
OUnit2.assert_equal ~printer:plist [1;2;3;4;5] l;
*)
let append_front ~into q = iter (push_front into) q let append_front ~into q = iter (push_front into) q
let append_back ~into q = iter (push_back into) q let append_back ~into q = iter (push_back into) q
(*$R
let q = of_list [3;4] in
append_front ~into:q (of_list [2;1]);
assert_equal [1;2;3;4] (to_list q);
append_back ~into:q (of_list [5;6]);
assert_equal [1;2;3;4;5;6] (to_list q);
*)
let fold f acc d = let fold f acc d =
let rec aux ~first f acc n = let rec aux ~first f acc n =
let acc = match n.cell with let acc = match n.cell with
@ -394,26 +260,8 @@ let fold f acc d =
| Node cur -> | Node cur ->
aux ~first:cur f acc cur aux ~first:cur f acc cur
(*$T
fold (+) 0 (of_list [1;2;3]) = 6
fold (fun acc x -> x::acc) [] (of_list [1;2;3]) = [3;2;1]
*)
let length d = d.size let length d = d.size
(*$Q
Q.(list int) (fun l -> \
let q = of_list l in \
append_front ~into:q (of_list l); \
append_back ~into:q (of_list l); \
length q = 3 * List.length l)
*)
(*$R
let d = of_iter Iter.(1 -- 10) in
OUnit2.assert_equal ~printer:pint 10 (length d)
*)
type 'a iter = ('a -> unit) -> unit type 'a iter = ('a -> unit) -> unit
type 'a gen = unit -> 'a option type 'a gen = unit -> 'a option
@ -421,14 +269,6 @@ let add_iter_back q seq = seq (fun x -> push_back q x)
let add_iter_front q seq = seq (fun x -> push_front q x) let add_iter_front q seq = seq (fun x -> push_front q x)
(*$R
let q = of_list [4;5] in
add_iter_front q Iter.(of_list [3;2;1]);
assert_equal [1;2;3;4;5] (to_list q);
add_iter_back q Iter.(of_list [6;7]);
assert_equal [1;2;3;4;5;6;7] (to_list q);
*)
let of_iter seq = let of_iter seq =
let deque = create () in let deque = create () in
seq (fun x -> push_back deque x); seq (fun x -> push_back deque x);
@ -436,24 +276,11 @@ let of_iter seq =
let to_iter d k = iter k d let to_iter d k = iter k d
(*$Q
Q.(list int) (fun l -> \
Iter.of_list l |> of_iter |> to_iter |> Iter.to_list = l)
*)
let of_list l = let of_list l =
let q = create() in let q = create() in
List.iter (push_back q) l; List.iter (push_back q) l;
q q
(*$R
let q = of_list [1;2;3] in
assert_equal 1 (take_front q);
assert_equal 3 (take_back q);
assert_equal 2 (take_front q);
assert_equal true (is_empty q)
*)
let to_rev_list q = fold (fun l x -> x::l) [] q let to_rev_list q = fold (fun l x -> x::l) [] q
let to_list q = List.rev (to_rev_list q) let to_list q = List.rev (to_rev_list q)
@ -546,37 +373,11 @@ let filter_in_place (d:_ t) f : unit =
cur.cell <- c; cur.cell <- c;
loop ~stop_at:cur cur.next loop ~stop_at:cur cur.next
(*$R
let q = of_list [1;2;3;4;5;6] in
filter_in_place q (fun x -> x mod 2 = 0);
assert_equal [2;4;6] (to_list q)
*)
(*$R
let q = of_list [2;1;4;6;10;20] in
filter_in_place q (fun x -> x mod 2 = 0);
assert_equal [2;4;6;10;20] (to_list q)
*)
(*$Q
Q.(list small_nat) (fun l -> \
let f = fun x -> x mod 2=0 in \
let q = of_list l in \
(filter_in_place q f; to_list q) = (List.filter f l))
*)
let filter f q = let filter f q =
let q' = create() in let q' = create() in
iter (fun x -> if f x then push_back q' x) q; iter (fun x -> if f x then push_back q' x) q;
q' q'
(*$Q
Q.(list small_nat) (fun l -> \
let f = fun x -> x mod 2=0 in \
let q = filter f (of_list l) in \
(to_list q) = (List.filter f l))
*)
let filter_map f q = let filter_map f q =
let q' = create() in let q' = create() in
iter (fun x -> match f x with None -> () | Some y -> push_back q' y) q; iter (fun x -> match f x with None -> () | Some y -> push_back q' y) q;
@ -613,35 +414,12 @@ let to_gen q =
in in
next next
(*$T
of_list [1;2;3] |> to_gen |> of_gen |> to_list = [1;2;3]
*)
(*$Q
Q.(list int) (fun l -> \
of_list l |> to_gen |> of_gen |> to_list = l)
*)
(* naive implem of copy, for now *) (* naive implem of copy, for now *)
let copy d = let copy d =
let d' = create () in let d' = create () in
iter (fun x -> push_back d' x) d; iter (fun x -> push_back d' x) d;
d' d'
(*$R
let q = of_list [1;2;3;4] in
assert_equal 4 (length q);
let q' = copy q in
let cmp = equal ~eq:CCInt.equal in
assert_equal 4 (length q');
assert_equal ~cmp q q';
push_front q 0;
assert_bool "not equal" (not (cmp q q'));
assert_equal 5 (length q);
push_front q' 0;
assert_equal ~cmp q q'
*)
let equal ~eq a b = let equal ~eq a b =
let rec aux eq a b = match a() , b() with let rec aux eq a b = match a() , b() with
| None, None -> true | None, None -> true
@ -660,12 +438,6 @@ let compare ~cmp a b =
if c=0 then aux cmp a b else c if c=0 then aux cmp a b else c
in aux cmp (to_gen a) (to_gen b) in aux cmp (to_gen a) (to_gen b)
(*$Q
Q.(pair (list int) (list int)) (fun (l1,l2) -> \
CCOrd.equiv (compare ~cmp:Stdlib.compare (of_list l1) (of_list l2)) \
(CCList.compare Stdlib.compare l1 l2))
*)
type 'a printer = Format.formatter -> 'a -> unit type 'a printer = Format.formatter -> 'a -> unit
let pp pp_x out d = let pp pp_x out d =

7
src/testlib/containers_testlib.ml
View file

@ -105,6 +105,8 @@ module type S = sig
?printer:('a -> string) -> ?cmp:('a -> 'a -> bool) -> ?printer:('a -> string) -> ?cmp:('a -> 'a -> bool) ->
'a -> 'a -> unit 'a -> 'a -> unit
val assert_bool : string -> bool -> unit
val assert_failure : string -> 'a val assert_failure : string -> 'a
val assert_raises : (exn -> bool) -> (unit -> 'b) -> unit val assert_raises : (exn -> bool) -> (unit -> 'b) -> unit
@ -142,6 +144,11 @@ module Make_test(X:sig val file: string end) = struct
failwith @@ spf "not equal: lhs=%s, rhs=%s" (p x) (p y) failwith @@ spf "not equal: lhs=%s, rhs=%s" (p x) (p y)
) )
let assert_bool what b =
if not b then (
failwith what
)
let assert_failure s = failwith s let assert_failure s = failwith s
let assert_raises check f = let assert_raises check f =

2
src/testlib/containers_testlib.mli
View file

@ -19,6 +19,8 @@ module type S = sig
?printer:('a -> string) -> ?cmp:('a -> 'a -> bool) -> ?printer:('a -> string) -> ?cmp:('a -> 'a -> bool) ->
'a -> 'a -> unit 'a -> 'a -> unit
val assert_bool : string -> bool -> unit
val assert_failure : string -> 'a val assert_failure : string -> 'a
val assert_raises : (exn -> bool) -> (unit -> 'b) -> unit val assert_raises : (exn -> bool) -> (unit -> 'b) -> unit

43
src/threads/CCBlockingQueue.ml
View file

@ -62,20 +62,6 @@ let take q =
Condition.broadcast q.cond; Condition.broadcast q.cond;
x) x)
(*$R
let q = create 1 in
let t1 = CCThread.spawn (fun () -> push q 1; push q 2) in
let t2 = CCThread.spawn (fun () -> push q 3; push q 4) in
let l = CCLock.create [] in
let t3 = CCThread.spawn (fun () -> for i = 1 to 4 do
let x = take q in
CCLock.update l (fun l -> x :: l)
done)
in
Thread.join t1; Thread.join t2; Thread.join t3;
assert_equal [1;2;3;4] (List.sort Stdlib.compare (CCLock.get l))
*)
let push_list q l = let push_list q l =
(* push elements until it's not possible. (* push elements until it's not possible.
Assumes the lock is acquired. *) Assumes the lock is acquired. *)
@ -131,35 +117,6 @@ let take_list q n =
in in
aux [] q n aux [] q n
(*$R
let n = 1000 in
let lists = [| CCList.(1 -- n) ; CCList.(n+1 -- 2*n); CCList.(2*n+1 -- 3*n) |] in
let q = create 2 in
let senders = CCThread.Arr.spawn 3
(fun i ->
if i=1
then push_list q lists.(i) (* test push_list *)
else List.iter (push q) lists.(i)
)
in
let res = CCLock.create [] in
let receivers = CCThread.Arr.spawn 3
(fun i ->
if i=1 then
let l = take_list q n in
CCLock.update res (fun acc -> l @ acc)
else
for _j = 1 to n do
let x = take q in
CCLock.update res (fun acc -> x::acc)
done
)
in
CCThread.Arr.join senders; CCThread.Arr.join receivers;
let l = CCLock.get res |> List.sort Stdlib.compare in
assert_equal CCList.(1 -- 3*n) l
*)
let try_take q = let try_take q =
with_lock_ q with_lock_ q
(fun () -> (fun () ->

63
src/threads/CCLock.ml
View file

@ -25,16 +25,6 @@ let with_lock l f =
Mutex.unlock l.mutex; Mutex.unlock l.mutex;
raise e raise e
(*$R
let l = create 0 in
let try_incr l =
update l (fun x -> Thread.yield(); x+1)
in
for i = 1 to 10 do ignore (Thread.create try_incr l) done;
Thread.delay 0.10 ;
assert_equal 10 (get l)
*)
let try_with_lock l f = let try_with_lock l f =
if Mutex.try_lock l.mutex if Mutex.try_lock l.mutex
then then
@ -64,35 +54,11 @@ let with_lock_as_ref l ~f =
Mutex.unlock l.mutex; Mutex.unlock l.mutex;
raise e raise e
(*$R
let l = create 0 in
let test_it l =
with_lock_as_ref l
~f:(fun r ->
(* increment and decrement *)
for j = 0 to 100 do
let x = LockRef.get r in
LockRef.set r (x+10);
if j mod 5=0 then Thread.yield ();
let y = LockRef.get r in
LockRef.set r (y - 10);
done
)
in
for i = 1 to 100 do ignore (Thread.create test_it l) done;
Thread.delay 0.10;
assert_equal 0 (get l)
*)
let mutex l = l.mutex let mutex l = l.mutex
let update l f = let update l f =
with_lock l (fun x -> l.content <- f x) with_lock l (fun x -> l.content <- f x)
(*$T
let l = create 5 in update l (fun x->x+1); get l = 6
*)
let update_map l f = let update_map l f =
with_lock l with_lock l
(fun x -> (fun x ->
@ -100,10 +66,6 @@ let update_map l f =
l.content <- x'; l.content <- x';
y) y)
(*$T
let l = create 5 in update_map l (fun x->x+1, string_of_int x) = "5" && get l = 6
*)
let get l = let get l =
Mutex.lock l.mutex; Mutex.lock l.mutex;
let x = l.content in let x = l.content in
@ -115,28 +77,10 @@ let set l x =
l.content <- x; l.content <- x;
Mutex.unlock l.mutex Mutex.unlock l.mutex
(*$T
let l = create 0 in set l 4; get l = 4
let l = create 0 in set l 4; set l 5; get l = 5
*)
let incr l = update l Stdlib.succ let incr l = update l Stdlib.succ
let decr l = update l Stdlib.pred let decr l = update l Stdlib.pred
(*$R
let l = create 0 in
let a = Array.init 100 (fun _ -> Thread.create (fun _ -> incr l) ()) in
Array.iter Thread.join a;
assert_equal ~printer:CCInt.to_string 100 (get l)
*)
(*$T
let l = create 0 in incr l ; get l = 1
let l = create 0 in decr l ; get l = ~-1
*)
let incr_then_get l = let incr_then_get l =
Mutex.lock l.mutex; Mutex.lock l.mutex;
l.content <- l.content + 1; l.content <- l.content + 1;
@ -165,13 +109,6 @@ let get_then_decr l =
Mutex.unlock l.mutex; Mutex.unlock l.mutex;
x x
(*$T
let l = create 0 in 1 = incr_then_get l && 1 = get l
let l = create 0 in 0 = get_then_incr l && 1 = get l
let l = create 10 in 9 = decr_then_get l && 9 = get l
let l = create 10 in 10 = get_then_decr l && 9 = get l
*)
let get_then_set l = let get_then_set l =
Mutex.lock l.mutex; Mutex.lock l.mutex;
let x = l.content in let x = l.content in

172
src/threads/CCPool.ml
View file

@ -15,13 +15,6 @@ end
exception Stopped exception Stopped
(*$inject
module P = Make(struct let max_size = 30 end)
module P2 = Make(struct let max_size = 15 end)
module Fut = P.Fut
module Fut2 = P2.Fut
*)
(** {2 Thread pool} *) (** {2 Thread pool} *)
module Make(P : PARAM) = struct module Make(P : PARAM) = struct
type job = type job =
@ -293,38 +286,6 @@ module Make(P : PARAM) = struct
let make f = make1 f () let make f = make1 f ()
(*$R
List.iter
(fun n ->
let l = Iter.(1 -- n) |> Iter.to_list in
let l = List.rev_map (fun i ->
Fut.make
(fun () ->
Thread.delay 0.01;
1
)) l in
let l' = List.map Fut.get l in
OUnit2.assert_equal n (List.fold_left (+) 0 l');
)
[ 10; 300; ]
*)
(*$R
List.iter
(fun n ->
let l = Iter.(1 -- n) |> Iter.to_list in
let l = List.rev_map (fun i ->
Fut2.make
(fun () ->
Thread.delay 0.01;
1
)) l in
let l' = List.map Fut2.get l in
OUnit2.assert_equal n (List.fold_left (+) 0 l');
)
[ 10; 300; ]
*)
let make2 f x y = let make2 f x y =
let cell = create_cell() in let cell = create_cell() in
@ -439,27 +400,6 @@ module Make(P : PARAM) = struct
let app_async f x = app_ ~async:true f x let app_async f x = app_ ~async:true f x
(*$R
let a = Fut.make (fun () -> 1) in
let b = Fut.return 42 in
let c = Fut.monoid_product CCPair.make a b in
OUnit2.assert_equal (1,42) (Fut.get c)
*)
(*$R
let a = Fut.make (fun () -> 1) in
let b = Fut.make (fun () -> 42) in
let c = Fut.monoid_product CCPair.make a b in
OUnit2.assert_equal (1,42) (Fut.get c)
*)
(*$R
let a = Fut.make (fun () -> 1) in
let b = Fut.map succ @@ Fut.make (fun () -> 41) in
let c = Fut.monoid_product CCPair.make a b in
OUnit2.assert_equal (1,42) (Fut.get c)
*)
let monoid_product f x y = match x, y with let monoid_product f x y = match x, y with
| Return x, Return y -> Return (f x y) | Return x, Return y -> Return (f x y)
| FailNow e, _ | FailNow e, _
@ -568,96 +508,6 @@ module Make(P : PARAM) = struct
sequence_ (L_ l) sequence_ (L_ l)
(fun () -> List.rev_map get_nolock_ l) (fun () -> List.rev_map get_nolock_ l)
(*$=
[2;3] (Fut.get @@ Fut.map_l (fun x -> Fut.return (x+1)) [1;2])
[] (Fut.get @@ Fut.map_l (fun x -> Fut.return (x+1)) [])
*)
(*$R
let l = CCList.(1 -- 50) in
let l' = l
|> List.map
(fun x -> Fut.make (fun () -> Thread.delay 0.1; x*10))
|> Fut.sequence_l
|> Fut.map (List.fold_left (+) 0)
in
let expected = List.fold_left (fun acc x -> acc + 10 * x) 0 l in
OUnit2.assert_equal expected (Fut.get l')
*)
(*$R
let l = CCList.(1 -- 100_000) in
let l' = l
|> CCList.map
(fun x -> Fut.make (fun () -> 1))
|> Fut.sequence_l
|> Fut.map (List.fold_left (+) 0)
in
let expected = 100_000 in
OUnit2.assert_equal expected (Fut.get l')
*)
(*$R
let l = CCList.(1 -- 50) in
let l' = l
|> List.map
(fun x -> Fut.make (fun () -> Thread.delay 0.1; if x = 5 then raise Exit; x))
|> Fut.sequence_l
|> Fut.map (List.fold_left (+) 0)
in
OUnit2.assert_raises Exit (fun () -> Fut.get l')
*)
(*$R
let rec fib x = if x<2 then 1 else fib (x-1)+fib(x-2) in
let l =
CCList.(1--10_000)
|> List.rev_map
(fun x-> Fut.make (fun () -> Thread.yield(); fib (x mod 20)))
|> Fut.(map_l (fun x->x>|= fun x->x+1))
in
OUnit2.assert_bool "not done" (Fut.state l = Waiting);
let l' = Fut.get l in
OUnit2.assert_equal 10_000 (List.length l');
*)
(*$R
let l = CCList.(1 -- 50) in
let l' = l
|> List.map
(fun x -> Fut2.make (fun () -> Thread.delay 0.1; x*10))
|> Fut2.sequence_l
|> Fut2.map (List.fold_left (+) 0)
in
let expected = List.fold_left (fun acc x -> acc + 10 * x) 0 l in
OUnit2.assert_equal expected (Fut2.get l')
*)
(*$R
let l = CCList.(1 -- 50) in
let l' = l
|> List.map
(fun x -> Fut2.make (fun () -> Thread.delay 0.1; if x = 5 then raise Exit; x))
|> Fut2.sequence_l
|> Fut2.map (List.fold_left (+) 0)
in
OUnit2.assert_raises Exit (fun () -> Fut2.get l')
*)
(*$R
let rec fib x = if x<2 then 1 else fib (x-1)+fib(x-2) in
let l =
CCList.(1--10_000)
|> List.rev_map
(fun x-> Fut2.make (fun () -> Thread.yield(); fib (x mod 20)))
|> Fut2.(map_l (fun x->x>|= fun x->x+1))
in
OUnit2.assert_bool "not done" (Fut2.state l = Waiting);
let l' = Fut2.get l in
OUnit2.assert_equal 10_000 (List.length l');
*)
let choose_ let choose_
: type a. a t array_or_list -> a t : type a. a t array_or_list -> a t
= fun aol -> = fun aol ->
@ -682,28 +532,6 @@ module Make(P : PARAM) = struct
let sleep time = make1 Thread.delay time let sleep time = make1 Thread.delay time
(*$R
let start = Unix.gettimeofday () in
let pause = 0.2 and n = 10 in
let l = CCList.(1 -- n)
|> List.map (fun _ -> Fut.make (fun () -> Thread.delay pause))
in
List.iter Fut.get l;
let stop = Unix.gettimeofday () in
OUnit2.assert_bool "some_parallelism" (stop -. start < float_of_int n *. pause);
*)
(*$R
let start = Unix.gettimeofday () in
let pause = 0.2 and n = 10 in
let l = CCList.(1 -- n)
|> List.map (fun _ -> Fut2.make (fun () -> Thread.delay pause))
in
List.iter Fut2.get l;
let stop = Unix.gettimeofday () in
OUnit2.assert_bool "some_parallelism" (stop -. start < float_of_int n *. pause);
*)
module Infix = struct module Infix = struct
let (>>=) x f = flat_map f x let (>>=) x f = flat_map f x
let (>>) a f = and_then a f let (>>) a f = and_then a f

58
src/threads/CCSemaphore.ml
View file

@ -40,18 +40,6 @@ let release m t =
release_once_locked_ m t; release_once_locked_ m t;
() ()
(*$R
let s = create 1 in
let r = CCLock.create false in
let _ = Thread.create (fun s -> acquire 5 s; CCLock.set r true) s in
Thread.yield ();
assert_equal false (CCLock.get r);
release 4 s;
Thread.delay 0.2;
assert_equal true (CCLock.get r);
assert_equal 0 (get s)
*)
let with_acquire ~n t ~f = let with_acquire ~n t ~f =
acquire n t; acquire n t;
try try
@ -62,22 +50,6 @@ let with_acquire ~n t ~f =
release n t; release n t;
raise e raise e
(*$R
let s = create 5 in
let n = CCLock.create 0 in
let a = Array.init 100 (fun i ->
Thread.create (fun _ ->
for _i = 1 to 100 do
with_acquire ~n:(1 + (i mod 5)) s
~f:(fun () -> Thread.yield(); CCLock.incr n)
done)
())
in
Array.iter Thread.join a;
assert_equal ~printer:CCInt.to_string 5 (get s);
assert_equal ~printer:CCInt.to_string 10_000 (CCLock.get n)
*)
let wait_until_at_least ~n t ~f = let wait_until_at_least ~n t ~f =
Mutex.lock t.mutex; Mutex.lock t.mutex;
while t.n < n do while t.n < n do
@ -86,33 +58,3 @@ let wait_until_at_least ~n t ~f =
assert (t.n >= n); assert (t.n >= n);
Mutex.unlock t.mutex; Mutex.unlock t.mutex;
f () f ()
(*$R
let output s = () in
let s = create 2 in
let res = CCLock.create false in
let id = Thread.create
(fun () ->
output "start";
wait_until_at_least ~n:5 s
~f:(fun () ->
assert (get s >= 5);
output "modify now";
CCLock.set res true)
) ()
in
output "launched thread";
Thread.yield();
assert_bool "start" (not (CCLock.get res));
output "release 2";
release 2 s;
Thread.yield();
assert_bool "after release 2" (not (CCLock.get res));
output "release 1";
release 1 s;
(* should work now *)
Thread.delay 0.2;
Thread.join id;
output "check";
assert_bool "after release 1" (CCLock.get res)
*)

20
src/threads/CCThread.ml
View file

@ -28,14 +28,6 @@ module Arr = struct
let join a = Array.iter Thread.join a let join a = Array.iter Thread.join a
end end
(*$R
let l = CCLock.create 0 in
let a = Arr.spawn 101 (fun i -> CCLock.update l ((+) i)) in
Arr.join a;
let n = Iter.(1 -- 100 |> fold (+) 0) in
assert_equal ~printer:CCInt.to_string n (CCLock.get l)
*)
module Barrier = struct module Barrier = struct
type t = { type t = {
lock: Mutex.t; lock: Mutex.t;
@ -71,15 +63,3 @@ module Barrier = struct
let activated b = with_lock_ b (fun () -> b.activated) let activated b = with_lock_ b (fun () -> b.activated)
end end
(*$R
let b = Barrier.create () in
let res = CCLock.create 0 in
let t1 = spawn (fun _ -> Barrier.wait b; CCLock.incr res)
and t2 = spawn (fun _ -> Barrier.wait b; CCLock.incr res) in
Thread.delay 0.2;
assert_equal 0 (CCLock.get res);
Barrier.activate b;
Thread.join t1; Thread.join t2;
assert_equal 2 (CCLock.get res)
*)

40
src/threads/CCTimer.ml
View file

@ -1,8 +1,4 @@
(* This file is free software, part of containers. See file "license" for more details. *)
(** {1 Event timer} *)
type job = type job =
| Job : float * (unit -> 'a) -> job | Job : float * (unit -> 'a) -> job
@ -153,27 +149,6 @@ let every ?delay timer d ~f =
| None -> run() | None -> run()
| Some d -> after timer d ~f:run | Some d -> after timer d ~f:run
(*$R
let start = Unix.gettimeofday() in
let timer = create() in
let res = CCLock.create 0 in
let sem = CCSemaphore.create 1 in
CCSemaphore.acquire 1 sem;
let stop = ref 0. in
every timer 0.1
~f:(fun () ->
if CCLock.incr_then_get res > 5 then (
stop := Unix.gettimeofday();
CCSemaphore.release 1 sem;
raise ExitEvery
));
CCSemaphore.acquire 1 sem; (* wait *)
OUnit2.assert_equal ~printer:CCInt.to_string 6 (CCLock.get res);
OUnit2.assert_bool "delay >= 0.5" (!stop -. start >= 0.49999);
OUnit2.assert_bool "delay < 2." (!stop -. start < 2.);
*)
(* NOTE: could be tighter bounds, but travis' mac OS seems to be dog slow. *)
let active timer = not timer.stop let active timer = not timer.stop
(** Stop the given timer, cancelling pending tasks *) (** Stop the given timer, cancelling pending tasks *)
@ -188,18 +163,3 @@ let stop timer =
awaken_ timer; awaken_ timer;
) )
) )
(*$R
(* scenario: n := 1; n := n*4 ; n := n+2; res := n *)
let timer = create () in
let n = CCLock.create 1 in
let res = CCLock.create 0 in
after timer 0.3
~f:(fun () -> CCLock.update n (fun x -> x+2));
ignore (Thread.create
(fun _ -> Thread.delay 0.4; CCLock.set res (CCLock.get n)) ());
after timer 0.1
~f:(fun () -> CCLock.update n (fun x -> x * 4));
Thread.delay 0.6 ;
OUnit2.assert_equal ~printer:Q.Print.int 6 (CCLock.get res);
*)

4
src/threads/CCTimer.mli
View file

@ -1,7 +1,5 @@
(* This file is free software, part of containers. See file "license" for more details. *) (** Event timer
(** {1 Event timer}
Used to be part of [CCFuture]. Used to be part of [CCFuture].
@since 0.16 *) @since 0.16 *)

5
tests/data/dune Normal file
View file

@ -0,0 +1,5 @@
(test
(name t)
(flags :standard -strict-sequence -warn-error -a+8 -open CCShims_)
(modes native)
(libraries containers containers-data containers_testlib iter))

8
tests/data/t.ml Normal file
View file

@ -0,0 +1,8 @@
Containers_testlib.run_all ~descr:"containers-data" [
T_bv.Test.get();
T_bijection.Test.get();
T_bitfield.Test.get();
T_cache.Test.get();
T_deque.Test.get();
];;

13
tests/data/t_bijection.ml Normal file
View file

@ -0,0 +1,13 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCBijection;;
module M = Make(Int)(String);;
eq 2 (M.of_list [1,"1"; 2, "2"] |> M.cardinal);;
eq "1" (M.of_list [1,"1"; 2, "2"] |> M.find_left 1);;
eq "2" (M.of_list [1,"1"; 2, "2"] |> M.find_left 2);;
eq 1 (M.of_list [1,"1"; 2, "2"] |> M.find_right "1");;
eq 2 (M.of_list [1,"1"; 2, "2"] |> M.find_right "2");;

59
tests/data/t_bitfield.ml Normal file
View file

@ -0,0 +1,59 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCBitField;;
t @@ fun () ->
let module B = CCBitField.Make(struct end) in
let x = B.mk_field () in
let y = B.mk_field () in
let z = B.mk_field () in
let f = B.empty |> B.set x true |> B.set y true in
assert_bool "z_false" (not (B.get z f)) ;
assert_bool "z_true" (f |> B.set z true |> B.get z);
true;;
t @@ fun () ->
let module B = CCBitField.Make(struct end) in
let _ = B.mk_field () in
B.freeze();
assert_bool "must raise"
(try ignore (B.mk_field()); false with Frozen -> true);
true;;
t @@ fun () ->
let module B = CCBitField.Make(struct end) in
let x = B.mk_field () in
let y = B.mk_field () in
let z = B.mk_field () in
let u = B.mk_field () in
B.freeze();
let f = B.empty
|> B.set y true
|> B.set z true
in
assert_equal ~printer:CCInt.to_string 6 (f :> int) ;
assert_equal false (B.get x f) ;
assert_equal true (B.get y f) ;
assert_equal true (B.get z f);
let f' = B.set u true f in
assert_equal false (B.get x f') ;
assert_equal true (B.get y f') ;
assert_equal true (B.get z f');
assert_equal true (B.get u f');
true;;
t @@ fun () -> all_bits_ 0 1 = 1;;
t @@ fun () -> all_bits_ 0 2 = 3;;
t @@ fun () -> all_bits_ 0 3 = 7;;
t @@ fun () -> all_bits_ 0 4 = 15;;

249
tests/data/t_bv.ml Normal file
View file

@ -0,0 +1,249 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCBV;;
let ppli = CCFormat.(Dump.list int);;
q (Q.pair Q.small_int Q.bool) (fun (size, b) -> create ~size b |> length = size);;
t @@ fun () -> create ~size:17 true |> cardinal = 17;;
t @@ fun () -> create ~size:32 true |> cardinal = 32;;
t @@ fun () -> create ~size:132 true |> cardinal = 132;;
t @@ fun () -> create ~size:200 false |> cardinal = 0;;
t @@ fun () -> create ~size:29 true |> to_sorted_list = CCList.range 0 28;;
q (Q.list Q.small_int) (fun l ->
let bv = of_list l in to_list bv = to_list (copy bv));;
q Q.small_int (fun size -> create ~size true |> cardinal = size);;
t @@ fun () ->
let bv1 = CCBV.create ~size:87 true in
assert_equal ~printer:string_of_int 87 (CCBV.cardinal bv1);
true;;
q Q.small_int (fun n -> CCBV.cardinal (CCBV.create ~size:n true) = n);;
t @@ fun () ->
let bv = CCBV.create ~size:99 false in
assert_bool "32 must be false" (not (CCBV.get bv 32));
assert_bool "88 must be false" (not (CCBV.get bv 88));
assert_bool "5 must be false" (not (CCBV.get bv 5));
CCBV.set bv 32;
CCBV.set bv 88;
CCBV.set bv 5;
assert_bool "32 must be true" (CCBV.get bv 32);
assert_bool "88 must be true" (CCBV.get bv 88);
assert_bool "5 must be true" (CCBV.get bv 5);
assert_bool "33 must be false" (not (CCBV.get bv 33));
assert_bool "44 must be false" (not (CCBV.get bv 44));
assert_bool "1 must be false" (not (CCBV.get bv 1));
true;;
t @@ fun () -> let bv = create ~size:3 false in set bv 0; get bv 0;;
t @@ fun () -> let bv = create ~size:3 false in set bv 1; not (get bv 0);;
t @@ fun () -> let bv = create ~size:3 false in set bv 0; reset bv 0; not (get bv 0);;
t @@ fun () ->
let bv = of_list [1;10; 11; 30] in
flip bv 10;
assert_equal ~printer:Q.Print.(list int) [1;11;30] (to_sorted_list bv);
assert_equal ~printer:Q.Print.bool false (get bv 10);
flip bv 10;
assert_equal ~printer:Q.Print.bool true (get bv 10);
flip bv 5;
assert_equal ~printer:Q.Print.(list int) [1;5;10;11;30] (to_sorted_list bv);
assert_equal ~printer:Q.Print.bool true (get bv 5);
flip bv 100;
assert_equal ~printer:Q.Print.(list int) [1;5;10;11;30;100] (to_sorted_list bv);
assert_equal ~printer:Q.Print.bool true (get bv 100);
true;;
t @@ fun () -> let bv = create ~size:37 true in cardinal bv = 37 && (clear bv; cardinal bv= 0);;
t @@ fun () ->
let bv = CCBV.of_list [1; 5; 200] in
assert_equal ~printer:string_of_int 3 (CCBV.cardinal bv);
CCBV.clear bv;
assert_equal ~printer:string_of_int 0 (CCBV.cardinal bv);
assert_bool "must be empty" (CCBV.is_empty bv);
true;;
t @@ fun () -> equal (of_list [1; 3; 4]) (of_list [1; 3; 4]);;
t @@ fun () -> equal (empty()) (empty());;
t @@ fun () -> not (equal (empty ()) (of_list [1]));;
t @@ fun () -> not (equal (empty ()) (of_list [2; 5]));;
t @@ fun () -> not (equal (of_list [1;3]) (of_list [2; 3]));;
t @@ fun () ->
List.iter
(fun size ->
let bv = create ~size false in
set bv 5;
let n = ref 0 in
iter bv (fun i b -> incr n; assert_equal b (i=5));
assert_bool "exactly size" (!n = size))
[30; 100; 255; 256;10_000];
true;;
let iter_zip s k = s (fun x y -> k(x,y));;
let eq' = eq ~printer:Q.Print.(list (pair int bool)) ;;
eq' [] (iter (create ~size:0 false) |> iter_zip |> Iter.to_list);;
eq' [0, false; 1, true; 2, false]
(iter (let bv = create ~size:3 false in set bv 1; bv) |> iter_zip |> Iter.to_list);;
q Q.(small_int) (fun n ->
assert (n >= 0);
let bv = create ~size:n true in
let l = iter bv |> iter_zip |> Iter.to_list in
List.length l = n && List.for_all (fun (_,b) -> b) l);;
t @@ fun () -> of_list [1;5;7] |> iter_true |> Iter.to_list |> List.sort CCOrd.poly = [1;5;7];;
let _gen = Q.Gen.(map of_list (list nat))
let _pp bv = Q.Print.(list string) (List.map string_of_int (to_list bv))
let _small bv = length bv
let gen_bv = Q.make ~small:_small ~print:_pp _gen;;
q gen_bv (fun bv ->
let l' = Iter.to_rev_list (CCBV.iter_true bv) in
let bv' = CCBV.of_list l' in
CCBV.cardinal bv = CCBV.cardinal bv'
);;
t @@ fun () ->
let bv = CCBV.of_list [1; 5; 156; 0; 222] in
assert_equal ~printer:string_of_int 5 (CCBV.cardinal bv);
CCBV.set bv 201;
assert_equal ~printer:string_of_int 6 (CCBV.cardinal bv);
let l = CCBV.to_list bv in
let l = List.sort compare l in
assert_equal [0;1;5;156;201;222] l;
true;;
eq ~printer:(CCFormat.to_string ppli)
[1;2;3;4;64;130] (of_list [1;2;3;4;64;130] |> to_sorted_list);;
q Q.(small_list small_nat) (fun l ->
let l = List.sort_uniq CCOrd.poly l in
let l2 = of_list l |> to_sorted_list in
if l=l2 then true else Q.Test.fail_reportf "l1=%a, l2=%a" ppli l ppli l2);;
q Q.(small_list small_nat) (fun l ->
let bv = of_list l in
let l1 = bv |> to_sorted_list in
let l2 =
(CCList.init (length bv) (get bv) |> List.mapi (fun i b->i,b)
|>CCList.filter_map (function (i,true) -> Some i| _ ->None)) in
if l1=l2 then true else Q.Test.fail_reportf "l1=%a, l2=%a" ppli l1 ppli l2) ;;
eq ~cmp:equal ~printer:(CCFormat.to_string pp)
(of_list [0]) (let bv=empty() in set bv 0; bv);;
t @@ fun () -> of_list [1;32;64] |> CCFun.flip get 64;;
t @@ fun () -> of_list [1;32;64] |> CCFun.flip get 32;;
t @@ fun () -> of_list [1;31;63] |> CCFun.flip get 63;;
t @@ fun () -> of_list [50; 10; 17; 22; 3; 12] |> first = Some 3;;
t @@ fun () -> let bv = of_list [1;2;3;4;5;6;7] in filter bv (fun x->x mod 2=0);
to_sorted_list bv = [2;4;6];;
eq ~printer:(CCFormat.to_string ppli)
[0;3;4;6] (let v = of_list [1;2;5;7;] in negate_self v; to_sorted_list v);;
q Q.small_int (fun size -> create ~size false |> negate |> cardinal = size);;
t @@ fun () ->
let bv1 = CCBV.of_list [1;2;3;4] in
let bv2 = CCBV.of_list [4;200;3] in
let bv = CCBV.union bv1 bv2 in
let l = List.sort compare (CCBV.to_list bv) in
assert_equal ~printer:(CCFormat.(to_string (Dump.list int)))
[1;2;3;4;200] l;
true;;
t @@ fun () ->
let bv1 = CCBV.of_list [1;2;3;4;64;130] in
let bv2 = CCBV.of_list [4;64;3;120] in
let bv = CCBV.union bv1 bv2 in
assert_equal ~cmp:equal ~printer:(CCFormat.to_string pp)
(of_list [1;2;3;4;64;120;130]) bv;
true;;
t @@ fun () ->
let bv1 = CCBV.of_list [1;2;3;4] in
let bv2 = CCBV.of_list [4;200;3] in
let bv = CCBV.union bv1 bv2 in
assert_equal ~cmp:equal ~printer:(CCFormat.to_string pp)
(of_list [1;2;3;4;200]) bv;
true;;
t @@ fun () ->
let v1 = CCBV.empty () in
let () = CCBV.set v1 64 in
let v2 = CCBV.diff (CCBV.empty ()) (CCBV.empty ()) in
let v3 = CCBV.union v1 v2 in
assert_equal ~printer:(CCFormat.to_string pp) ~cmp:CCBV.equal v1 v3;
true;;
t @@ fun () -> union (of_list [1;2;3;4;5]) (of_list [7;3;5;6]) |> to_sorted_list = CCList.range 1 7;;
t @@ fun () -> inter (of_list [1;2;3;4]) (of_list [2;4;6;1]) |> to_sorted_list = [1;2;4];;
t @@ fun () ->
let bv1 = CCBV.of_list [1;2;3;4;200;201] in
let bv2 = CCBV.of_list [4;200;3] in
let bv = CCBV.inter bv1 bv2 in
let l = List.sort compare (CCBV.to_list bv) in
assert_equal ~printer:(CCFormat.(to_string (Dump.list int)))
[3;4;200] l;
true;;
t @@ fun () ->
let bv1 = CCBV.of_list [1;2;3;4] in
let bv2 = CCBV.of_list [4;200;3] in
CCBV.inter_into ~into:bv1 bv2;
let l = List.sort compare (CCBV.to_list bv1) in
assert_equal [3;4] l;
true;;
t @@ fun () -> diff (of_list [1;2;3]) (of_list [1;2;3]) |> to_list = [];;
t @@ fun () -> diff (of_list [1;2;3]) (of_list [1;2;3;4]) |> to_list = [];;
t @@ fun () -> diff (of_list [1;2;3;4]) (of_list [1;2;3]) |> to_list = [4];;
t @@ fun () -> diff (of_list [1;2;3]) (of_list [1;2;3;400]) |> to_list = [];;
t @@ fun () -> diff (of_list [1;2;3;400]) (of_list [1;2;3]) |> to_list = [400];;
t @@ fun () ->
let v1 = CCBV.empty () in
set v1 65;
let v2 = CCBV.diff v1 v1 in
CCBV.is_empty v2 ;;
t @@ fun () ->
let bv = CCBV.of_list [1;2;5;400] in
let arr = [|"a"; "b"; "c"; "d"; "e"; "f"|] in
let l = List.sort compare (CCBV.select bv arr) in
assert_equal ["b"; "c"; "f"] l;
true;;
t @@ fun () ->
let bv = CCBV.of_list [1;2;5;400] in
let arr = [|"a"; "b"; "c"; "d"; "e"; "f"|] in
let l = List.sort compare (CCBV.selecti bv arr) in
assert_equal [("b",1); ("c",2); ("f",5)] l;
true;;
eq ~printer:Q.Print.(list (pair int int))
[1,1; 3,3; 4,4] (selecti (of_list [1;4;3]) [| 0;1;2;3;4;5;6;7;8 |]
|> List.sort CCOrd.poly);;
q Q.(small_int) (fun i ->
let i = max 1 i in
let bv = create ~size:i true in
i = (to_iter bv |> Iter.length));;
t @@ fun () -> CCList.range 0 10 |> CCList.to_iter |> of_iter |> to_iter
|> CCList.of_iter |> List.sort CCOrd.poly = CCList.range 0 10;;
eq ~printer:CCFun.id
"bv {00001}" (CCFormat.to_string pp (of_list [4]));;

47
tests/data/t_cache.ml Normal file
View file

@ -0,0 +1,47 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCCache;;
t @@ fun () ->
let c = unbounded ~eq:Int64.equal 256 in
let fib = with_cache_rec c
(fun self n -> match n with
| 1L | 2L -> 1L
| _ -> CCInt64.(self (n-1L) + self (n-2L))
)
in
assert_equal 55L (fib 10L);
assert_equal 832040L (fib 30L);
assert_equal 12586269025L (fib 50L);
assert_equal 190392490709135L (fib 70L);
true;;
t @@ fun () ->
let eq (i1,_)(i2,_) = i1=i2 and hash (i,_) = CCInt.hash i in
let c = lru ~eq ~hash 2 in
ignore (with_cache c CCFun.id (1, true));
ignore (with_cache c CCFun.id (1, false));
with_cache c CCFun.id (1, false) = (1, true);;
t @@ fun () ->
let f = (let r = ref 0 in fun _ -> incr r; !r) in
let c = lru ~eq:CCInt.equal 2 in
let res1 = with_cache c f 1 in
let res2 = with_cache c f 2 in
let res3 = with_cache c f 3 in
let res1_bis = with_cache c f 1 in
res1 <> res2 && res2 <> res3 && res3 <> res1_bis && res1_bis <> res1;;
t @@ fun () ->
let f = (let r = ref 0 in fun _ -> incr r; !r) in
let c = lru ~eq:CCEqual.unit 2 in
let x = with_cache c f () in
assert_equal 1 x;
assert_equal 1 (size c);
clear c ;
assert_equal 0 (size c);
let y = with_cache c f () in
assert_equal 2 y;
true;;

193
tests/data/t_deque.ml Normal file
View file

@ -0,0 +1,193 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCDeque;;
let plist l = CCFormat.(to_string (list int)) l
let pint i = string_of_int i;;
t @@ fun () ->
let q = create () in
add_iter_back q Iter.(3 -- 5);
assert_equal [3;4;5] (to_list q);
add_iter_front q Iter.(of_list [2;1]);
assert_equal [1;2;3;4;5] (to_list q);
push_front q 0;
assert_equal [0;1;2;3;4;5] (to_list q);
assert_equal 5 (take_back q);
assert_equal 0 (take_front q);
assert_equal 4 (length q);
true;;
t @@ fun () ->
let q = of_iter Iter.(1 -- 100) in
assert_equal 100 (length q);
clear q;
assert_equal 0 (length q);
assert_raises ((=)Empty) (fun () -> peek_front q);
assert_raises ((=)Empty) (fun () -> peek_back q);
true;;
t @@ fun () -> of_list [1;2;3] |> peek_front = 1;;
t @@ fun () -> try (ignore (of_list [] |> peek_front); false) with Empty -> true;;
t @@ fun () ->
let d = of_iter Iter.(1 -- 10) in
let printer = pint in
assert_equal ~printer 1 (peek_front d);
push_front d 42;
assert_equal ~printer 42 (peek_front d);
assert_equal ~printer 42 (take_front d);
assert_equal ~printer 1 (take_front d);
assert_equal ~printer 2 (take_front d);
assert_equal ~printer 3 (take_front d);
assert_equal ~printer 10 (peek_back d);
true;;
t @@ fun () -> of_list [1;2;3] |> peek_back = 3;;
t @@ fun () -> try (ignore (of_list [] |> peek_back); false) with Empty -> true;;
t @@ fun () ->
let d = of_iter Iter.(1 -- 10) in
let printer = pint in
assert_equal ~printer 1 (peek_front d);
push_back d 42;
assert_equal ~printer 42 (peek_back d);
assert_equal ~printer 42 (take_back d);
assert_equal ~printer 10 (take_back d);
assert_equal ~printer 9 (take_back d);
assert_equal ~printer 8 (take_back d);
assert_equal ~printer 1 (peek_front d);
true;;
t @@ fun () -> let q = of_list [1] in take_back q = 1 && to_list q = [];;
t @@ fun () -> let q = of_list [1;2] in take_back q = 2 && to_list q = [1];;
t @@ fun () -> let q = of_list [1;2;3] in take_back q = 3 && to_list q = [1;2];;
t @@ fun () -> let q = of_list [1;2;3;4;5;6;7;] in take_back q = 7 && to_list q = [1;2;3;4;5;6];;
t @@ fun () -> let q = of_list [1;2;3] in take_front q = 1 && to_list q = [2;3];;
t @@ fun () -> let q = of_list [1;2;3;4;5;6;7] in remove_back q; to_list q = [1;2;3;4;5;6];;
t @@ fun () -> let q = of_list [1;2;3;4;5;6;7] in remove_front q; to_list q = [2;3;4;5;6;7];;
t @@ fun () -> let q = of_list [1;2;3;4;5;6;7] in update_front q (fun _ -> None); to_list q = [2;3;4;5;6;7];;
t @@ fun () -> let q = of_list [1;2;3;4;5;6;7] in update_front q (fun _ -> Some 9); to_list q = [9;2;3;4;5;6;7];;
q Q.(list int) (fun l ->
let q = of_list l in
update_front q (fun _ -> None);
let output_list = if l = [] then [] else List.tl l in
to_list q = output_list) ;;
q Q.(list int) (fun l ->
let q = of_list l in
update_front q (fun x -> Some (x + 42));
let output_list = if l = [] then [] else List.((hd l + 42)::(tl l)) in
to_list q = output_list) ;;
t @@ fun () -> let q = of_list [1;2;3;4;5;6;7] in update_back q (fun _ -> None); to_list q = [1;2;3;4;5;6];;
t @@ fun () -> let q = of_list [1;2;3;4;5;6;7] in update_back q (fun _ -> Some 9); to_list q = [1;2;3;4;5;6;9];;
q Q.(list int) (fun l ->
let q = of_list l in
update_back q (fun _ -> None);
let output_list = if l = [] then [] else List.(rev l |> tl) in
(to_list q |> List.rev) = output_list);;
q Q.(list int) (fun l ->
let q = of_list l in
update_back q (fun x -> Some (x + 42));
let output_list = if l = [] then [] else List.(rev l |> fun l -> (hd l + 42)::(tl l)) in
(to_list q |> List.rev) = output_list);;
t @@ fun () -> let n = ref 0 in iter (fun _ -> incr n) (of_list [1;2;3]); !n = 3;;
t @@ fun () ->
let d = of_iter Iter.(1 -- 5) in
let s = Iter.from_iter (fun k -> iter k d) in
let l = Iter.to_list s in
assert_equal ~printer:plist [1;2;3;4;5] l;
true;;
t @@ fun () ->
let q = of_list [3;4] in
append_front ~into:q (of_list [2;1]);
assert_equal [1;2;3;4] (to_list q);
append_back ~into:q (of_list [5;6]);
assert_equal [1;2;3;4;5;6] (to_list q);
true;;
t @@ fun () -> fold (+) 0 (of_list [1;2;3]) = 6;;
t @@ fun () -> fold (fun acc x -> x::acc) [] (of_list [1;2;3]) = [3;2;1];;
q Q.(list int) (fun l ->
let q = of_list l in
append_front ~into:q (of_list l);
append_back ~into:q (of_list l);
length q = 3 * List.length l);;
t @@ fun () ->
let d = of_iter Iter.(1 -- 10) in
assert_equal ~printer:pint 10 (length d);
true;;
t @@ fun () ->
let q = of_list [4;5] in
add_iter_front q Iter.(of_list [3;2;1]);
assert_equal [1;2;3;4;5] (to_list q);
add_iter_back q Iter.(of_list [6;7]);
assert_equal [1;2;3;4;5;6;7] (to_list q);
true;;
q Q.(list int) (fun l ->
Iter.of_list l |> of_iter |> to_iter |> Iter.to_list = l);;
t @@ fun () ->
let q = of_list [1;2;3] in
assert_equal 1 (take_front q);
assert_equal 3 (take_back q);
assert_equal 2 (take_front q);
assert_equal true (is_empty q);
true;;
t @@ fun () ->
let q = of_list [1;2;3;4;5;6] in
filter_in_place q (fun x -> x mod 2 = 0);
assert_equal [2;4;6] (to_list q);
true;;
t @@ fun () ->
let q = of_list [2;1;4;6;10;20] in
filter_in_place q (fun x -> x mod 2 = 0);
assert_equal [2;4;6;10;20] (to_list q);
true;;
q Q.(list small_nat) (fun l ->
let f = fun x -> x mod 2=0 in
let q = of_list l in
(filter_in_place q f; to_list q) = (List.filter f l));;
q Q.(list small_nat) (fun l ->
let f = fun x -> x mod 2=0 in
let q = filter f (of_list l) in
(to_list q) = (List.filter f l));;
t @@ fun () -> of_list [1;2;3] |> to_gen |> of_gen |> to_list = [1;2;3];;
q Q.(list int) (fun l ->
of_list l |> to_gen |> of_gen |> to_list = l);;
t @@ fun () ->
let q = of_list [1;2;3;4] in
assert_equal 4 (length q);
let q' = copy q in
let cmp = equal ~eq:CCInt.equal in
assert_equal 4 (length q');
assert_equal ~cmp q q';
push_front q 0;
assert_bool "not equal" (not (cmp q q'));
assert_equal 5 (length q);
push_front q' 0;
assert_equal ~cmp q q';
true;;
q Q.(pair (list int) (list int)) (fun (l1,l2) ->
CCOrd.equiv (compare ~cmp:Stdlib.compare (of_list l1) (of_list l2))
(CCList.compare Stdlib.compare l1 l2));;

5
tests/thread/dune Normal file
View file

@ -0,0 +1,5 @@
(test
(name t)
(flags :standard -strict-sequence -warn-error -a+8 -open CCShims_)
(modes native)
(libraries containers containers-thread containers_testlib iter threads))

9
tests/thread/t.ml Normal file
View file

@ -0,0 +1,9 @@
Containers_testlib.run_all ~descr:"containers-thread" [
T_bq.Test.get();
T_lock.Test.get();
T_pool.Test.get();
T_semaphore.Test.get();
T_thread.Test.get();
T_timer.Test.get();
];;

47
tests/thread/t_bq.ml Normal file
View file

@ -0,0 +1,47 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCBlockingQueue;;
t @@ fun () ->
let q = create 1 in
let t1 = CCThread.spawn (fun () -> push q 1; push q 2) in
let t2 = CCThread.spawn (fun () -> push q 3; push q 4) in
let l = CCLock.create [] in
let t3 = CCThread.spawn (fun () -> for _i = 1 to 4 do
let x = take q in
CCLock.update l (fun l -> x :: l)
done)
in
Thread.join t1; Thread.join t2; Thread.join t3;
assert_equal [1;2;3;4] (List.sort Stdlib.compare (CCLock.get l));
true;;
t @@ fun () ->
let n = 1000 in
let lists = [| CCList.(1 -- n) ; CCList.(n+1 -- 2*n); CCList.(2*n+1 -- 3*n) |] in
let q = create 2 in
let senders = CCThread.Arr.spawn 3
(fun i ->
if i=1
then push_list q lists.(i) (* test push_list *)
else List.iter (push q) lists.(i)
)
in
let res = CCLock.create [] in
let receivers = CCThread.Arr.spawn 3
(fun i ->
if i=1 then
let l = take_list q n in
CCLock.update res (fun acc -> l @ acc)
else
for _j = 1 to n do
let x = take q in
CCLock.update res (fun acc -> x::acc)
done
)
in
CCThread.Arr.join senders; CCThread.Arr.join receivers;
let l = CCLock.get res |> List.sort Stdlib.compare in
assert_equal CCList.(1 -- 3*n) l;
true

53
tests/thread/t_lock.ml Normal file
View file

@ -0,0 +1,53 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test;;
open CCLock;;
t @@ fun () ->
let l = create 0 in
let try_incr l =
update l (fun x -> Thread.yield(); x+1)
in
for _i = 1 to 10 do ignore (Thread.create try_incr l) done;
Thread.delay 0.10 ;
assert_equal 10 (get l);
true;;
t @@ fun () ->
let l = create 0 in
let test_it l =
with_lock_as_ref l
~f:(fun r ->
(* increment and decrement *)
for j = 0 to 100 do
let x = LockRef.get r in
LockRef.set r (x+10);
if j mod 5=0 then Thread.yield ();
let y = LockRef.get r in
LockRef.set r (y - 10);
done
)
in
for _i = 1 to 100 do ignore (Thread.create test_it l) done;
Thread.delay 0.10;
0 =get l;;
t @@ fun () -> let l = create 5 in update l (fun x->x+1); get l = 6;;
t @@ fun () -> let l = create 5 in update_map l (fun x->x+1, string_of_int x) = "5" && get l = 6;;
t @@ fun () -> let l = create 0 in set l 4; get l = 4;;
t @@ fun () -> let l = create 0 in set l 4; set l 5; get l = 5;;
t @@ fun () ->
let l = create 0 in
let a = Array.init 100 (fun _ -> Thread.create (fun _ -> incr l) ()) in
Array.iter Thread.join a;
assert_equal ~printer:CCInt.to_string 100 (get l);
true;;
t @@ fun () -> let l = create 0 in incr l ; get l = 1;;
t @@ fun () -> let l = create 0 in decr l ; get l = ~-1;;
t @@ fun () -> let l = create 0 in 1 = incr_then_get l && 1 = get l;;
t @@ fun () -> let l = create 0 in 0 = get_then_incr l && 1 = get l;;
t @@ fun () -> let l = create 10 in 9 = decr_then_get l && 9 = get l;;
t @@ fun () -> let l = create 10 in 10 = get_then_decr l && 9 = get l;;

171
tests/thread/t_pool.ml Normal file
View file

@ -0,0 +1,171 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCPool;;
module P = Make(struct let max_size = 30 end)
module P2 = Make(struct let max_size = 15 end)
module Fut = P.Fut
module Fut2 = P2.Fut;;
t @@ fun () ->
List.iter
(fun n ->
let l = Iter.(1 -- n) |> Iter.to_list in
let l = List.rev_map (fun _i ->
Fut.make
(fun () ->
Thread.delay 0.01;
1
)) l in
let l' = List.map Fut.get l in
assert_equal n (List.fold_left (+) 0 l');
)
[ 10; 300; ];
true;;
t @@ fun () ->
List.iter
(fun n ->
let l = Iter.(1 -- n) |> Iter.to_list in
let l = List.rev_map (fun _i ->
Fut2.make
(fun () ->
Thread.delay 0.01;
1
)) l in
let l' = List.map Fut2.get l in
assert_equal n (List.fold_left (+) 0 l');
)
[ 10; 300; ];
true;;
t @@ fun () ->
let a = Fut.make (fun () -> 1) in
let b = Fut.return 42 in
let c = Fut.monoid_product CCPair.make a b in
assert_equal (1,42) (Fut.get c);
true;;
t @@ fun () ->
let a = Fut.make (fun () -> 1) in
let b = Fut.make (fun () -> 42) in
let c = Fut.monoid_product CCPair.make a b in
assert_equal (1,42) (Fut.get c);
true;;
t @@ fun () ->
let a = Fut.make (fun () -> 1) in
let b = Fut.map succ @@ Fut.make (fun () -> 41) in
let c = Fut.monoid_product CCPair.make a b in
assert_equal (1,42) (Fut.get c);
true;;
eq [2;3] (Fut.get @@ Fut.map_l (fun x -> Fut.return (x+1)) [1;2]);;
eq [] (Fut.get @@ Fut.map_l (fun x -> Fut.return (x+1)) []);;
t @@ fun () ->
let l = CCList.(1 -- 50) in
let l' = l
|> List.map
(fun x -> Fut.make (fun () -> Thread.delay 0.1; x*10))
|> Fut.sequence_l
|> Fut.map (List.fold_left (+) 0)
in
let expected = List.fold_left (fun acc x -> acc + 10 * x) 0 l in
assert_equal expected (Fut.get l');
true;;
t @@ fun () ->
let l = CCList.(1 -- 100_000) in
let l' = l
|> CCList.map
(fun _x -> Fut.make (fun () -> 1))
|> Fut.sequence_l
|> Fut.map (List.fold_left (+) 0)
in
let expected = 100_000 in
assert_equal expected (Fut.get l');
true;;
t @@ fun () ->
let l = CCList.(1 -- 50) in
let l' = l
|> List.map
(fun x -> Fut.make (fun () -> Thread.delay 0.1; if x = 5 then raise Exit; x))
|> Fut.sequence_l
|> Fut.map (List.fold_left (+) 0)
in
assert_raises ((=)Exit) (fun () -> Fut.get l');
true;;
t @@ fun () ->
let rec fib x = if x<2 then 1 else fib (x-1)+fib(x-2) in
let l =
CCList.(1--10_000)
|> List.rev_map
(fun x-> Fut.make (fun () -> Thread.yield(); fib (x mod 20)))
|> Fut.(map_l (fun x->x>|= fun x->x+1))
in
assert (Fut.state l = Waiting);
let l' = Fut.get l in
assert_equal 10_000 (List.length l');
true;;
t @@ fun () ->
let l = CCList.(1 -- 50) in
let l' = l
|> List.map
(fun x -> Fut2.make (fun () -> Thread.delay 0.1; x*10))
|> Fut2.sequence_l
|> Fut2.map (List.fold_left (+) 0)
in
let expected = List.fold_left (fun acc x -> acc + 10 * x) 0 l in
assert_equal expected (Fut2.get l');
true;;
t @@ fun () ->
let l = CCList.(1 -- 50) in
let l' = l
|> List.map
(fun x -> Fut2.make (fun () -> Thread.delay 0.1; if x = 5 then raise Exit; x))
|> Fut2.sequence_l
|> Fut2.map (List.fold_left (+) 0)
in
assert_raises ((=)Exit) (fun () -> Fut2.get l');
true;;
t @@ fun () ->
let rec fib x = if x<2 then 1 else fib (x-1)+fib(x-2) in
let l =
CCList.(1--10_000)
|> List.rev_map
(fun x-> Fut2.make (fun () -> Thread.yield(); fib (x mod 20)))
|> Fut2.(map_l (fun x->x>|= fun x->x+1))
in
assert (Fut2.state l = Waiting);
let l' = Fut2.get l in
assert_equal 10_000 (List.length l');
true;;
t @@ fun () ->
let start = Unix.gettimeofday () in
let pause = 0.2 and n = 10 in
let l = CCList.(1 -- n)
|> List.map (fun _ -> Fut.make (fun () -> Thread.delay pause))
in
List.iter Fut.get l;
let stop = Unix.gettimeofday () in
assert (stop -. start < float_of_int n *. pause);
true;;
t @@ fun () ->
let start = Unix.gettimeofday () in
let pause = 0.2 and n = 10 in
let l = CCList.(1 -- n)
|> List.map (fun _ -> Fut2.make (fun () -> Thread.delay pause))
in
List.iter Fut2.get l;
let stop = Unix.gettimeofday () in
assert (stop -. start < float_of_int n *. pause);
true;;

62
tests/thread/t_semaphore.ml Normal file
View file

@ -0,0 +1,62 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCSemaphore;;
t @@ fun () ->
let s = create 1 in
let r = CCLock.create false in
let _ = Thread.create (fun s -> acquire 5 s; CCLock.set r true) s in
Thread.yield ();
assert_equal false (CCLock.get r);
release 4 s;
Thread.delay 0.2;
assert_equal true (CCLock.get r);
assert_equal 0 (get s);
true;;
t @@ fun () ->
let s = create 5 in
let n = CCLock.create 0 in
let a = Array.init 100 (fun i ->
Thread.create (fun _ ->
for _i = 1 to 100 do
with_acquire ~n:(1 + (i mod 5)) s
~f:(fun () -> Thread.yield(); CCLock.incr n)
done)
())
in
Array.iter Thread.join a;
assert_equal ~printer:CCInt.to_string 5 (get s);
assert_equal ~printer:CCInt.to_string 10_000 (CCLock.get n);
true;;
t @@ fun () ->
let output _s = () in
let s = create 2 in
let res = CCLock.create false in
let id = Thread.create
(fun () ->
output "start";
wait_until_at_least ~n:5 s
~f:(fun () ->
assert (get s >= 5);
output "modify now";
CCLock.set res true)
) ()
in
output "launched thread";
Thread.yield();
assert (not (CCLock.get res));
output "release 2";
release 2 s;
Thread.yield();
assert (not (CCLock.get res));
output "release 1";
release 1 s;
(* should work now *)
Thread.delay 0.2;
Thread.join id;
output "check";
assert (CCLock.get res);
true;;

24
tests/thread/t_thread.ml Normal file
View file

@ -0,0 +1,24 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCThread;;
t @@ fun () ->
let l = CCLock.create 0 in
let a = Arr.spawn 101 (fun i -> CCLock.update l ((+) i)) in
Arr.join a;
let n = Iter.(1 -- 100 |> fold (+) 0) in
assert_equal ~printer:CCInt.to_string n (CCLock.get l);
true;;
t @@ fun () ->
let b = Barrier.create () in
let res = CCLock.create 0 in
let t1 = spawn (fun _ -> Barrier.wait b; CCLock.incr res)
and t2 = spawn (fun _ -> Barrier.wait b; CCLock.incr res) in
Thread.delay 0.2;
assert_equal 0 (CCLock.get res);
Barrier.activate b;
Thread.join t1; Thread.join t2;
assert_equal 2 (CCLock.get res);
true;;

42
tests/thread/t_timer.ml Normal file
View file

@ -0,0 +1,42 @@
module Test = (val Containers_testlib.make ~__FILE__())
open Test
open CCTimer;;
(* NOTE: could be tighter bounds, but travis' mac OS seems to be dog slow. *)
t @@ fun () ->
let start = Unix.gettimeofday() in
let timer = create() in
let res = CCLock.create 0 in
let sem = CCSemaphore.create 1 in
CCSemaphore.acquire 1 sem;
let stop = ref 0. in
every timer 0.1
~f:(fun () ->
if CCLock.incr_then_get res > 5 then (
stop := Unix.gettimeofday();
CCSemaphore.release 1 sem;
raise ExitEvery
));
CCSemaphore.acquire 1 sem; (* wait *)
assert_equal ~printer:CCInt.to_string 6 (CCLock.get res);
assert (!stop -. start >= 0.49999);
assert (!stop -. start < 2.);
true;;
t @@ fun () ->
(* scenario: n := 1; n := n*4 ; n := n+2; res := n *)
let timer = create () in
let n = CCLock.create 1 in
let res = CCLock.create 0 in
after timer 0.3
~f:(fun () -> CCLock.update n (fun x -> x+2));
ignore (Thread.create
(fun _ -> Thread.delay 0.4; CCLock.set res (CCLock.get n)) ());
after timer 0.1
~f:(fun () -> CCLock.update n (fun x -> x * 4));
Thread.delay 0.6 ;
assert_equal ~printer:Q.Print.int 6 (CCLock.get res);
true;;