Skip to content

Commit fbf47cd

Browse files
author
Koonwen Lee
committed
test/ds: add btree tests
1 parent 26a40f4 commit fbf47cd

File tree

4 files changed

+139
-47
lines changed

4 files changed

+139
-47
lines changed

‎test/dune

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
(tests
2-
(names test_skiplist test_obatcher)
2+
(names test_ds test_obatcher)
33
(libraries
44
logs
55
logs.fmt

‎test/test_ds.ml

Lines changed: 137 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,137 @@
1+
open Containers
2+
open QCheck
3+
4+
module Test_skiplist = struct
5+
module Isl = Ds.Batched_skiplist.Make (Int)
6+
7+
let test_insert =
8+
QCheck.Test.make ~count:1000 ~name:"inserts return true on member lookup"
9+
(QCheck.list small_int) (fun ins_l ->
10+
Picos_mux_random.run @@ fun () ->
11+
let t = Isl.init () in
12+
(* Insert all elements in l1 *)
13+
List.iter (Isl.insert t) ins_l;
14+
List.for_all (fun v -> Isl.mem t v) ins_l)
15+
16+
let test_mem =
17+
QCheck.Test.make ~count:1000 ~name:"member lookup not vacuously true"
18+
(QCheck.list_of_size (Gen.int_range 50 100) small_int)
19+
(fun l ->
20+
let l' = List.uniq ~eq:(fun i1 i2 -> Int.compare i1 i2 = 0) l in
21+
let len = List.length l' in
22+
let ins_l, mem_l = List.take_drop (len / 2) l' in
23+
Picos_mux_random.run @@ fun () ->
24+
let t = Isl.init () in
25+
(* Insert all elements in l1 *)
26+
List.iter (Isl.insert t) ins_l;
27+
List.for_all (fun v -> Bool.equal (Isl.mem t v) false) mem_l
28+
&& (not (List.is_empty ins_l))
29+
&& not (List.is_empty mem_l))
30+
31+
let test_size =
32+
QCheck.Test.make ~count:1000 ~name:"duplicate elements are not inserted"
33+
(QCheck.list_of_size (Gen.int_range 52 100) (int_range (-25) 25))
34+
(fun ins_l ->
35+
let l' = List.uniq ~eq:(fun i1 i2 -> Int.compare i1 i2 = 0) ins_l in
36+
let len = List.length l' in
37+
Picos_mux_random.run @@ fun () ->
38+
let t = Isl.init () in
39+
(* Insert all elements in l1 *)
40+
List.iter (Isl.insert t) ins_l;
41+
Isl.sz t = len && len <> List.length ins_l)
42+
43+
let suite =
44+
List.map QCheck_alcotest.to_alcotest [ test_insert; test_mem; test_size ]
45+
end
46+
47+
module Test_btree = struct
48+
module Ibtree = Ds.Batched_btree.Make (Int)
49+
50+
let test_insert =
51+
QCheck.Test.make ~count:1000
52+
~name:"inserts return true & correct element on member lookup"
53+
(QCheck.list small_int) (fun ins_l ->
54+
Picos_mux_random.run @@ fun () ->
55+
let t = Ibtree.init () in
56+
(* Insert all elements in l1 *)
57+
List.iter (fun v -> Ibtree.insert t v v) ins_l;
58+
List.for_all
59+
(fun v ->
60+
match Ibtree.search t v with None -> false | Some v' -> v = v')
61+
ins_l)
62+
63+
let test_mem =
64+
QCheck.Test.make ~count:1000 ~name:"member lookup not vacuously true"
65+
(QCheck.list_of_size (Gen.int_range 50 100) small_int)
66+
(fun l ->
67+
let l' = List.uniq ~eq:(fun i1 i2 -> Int.compare i1 i2 = 0) l in
68+
let len = List.length l' in
69+
let ins_l, mem_l = List.take_drop (len / 2) l' in
70+
Picos_mux_random.run @@ fun () ->
71+
let t = Ibtree.init () in
72+
(* Insert all elements in l1 *)
73+
List.iter (fun v -> Ibtree.insert t v v) ins_l;
74+
List.for_all (fun v -> Option.is_none (Ibtree.search t v)) mem_l
75+
&& (not (List.is_empty ins_l))
76+
&& not (List.is_empty mem_l))
77+
78+
let test_size =
79+
QCheck.Test.make ~if_assumptions_fail:(`Fatal, 1.0) ~count:1000
80+
~name:"size = elements inserted, duplicates persist"
81+
(QCheck.list_of_size (Gen.int_range 52 100) (int_range (-25) 25))
82+
(fun ins_l ->
83+
let len = List.length ins_l in
84+
let len_uniq =
85+
List.length (List.uniq ~eq:(fun i1 i2 -> Int.compare i1 i2 = 0) ins_l)
86+
in
87+
assume (len_uniq <> len);
88+
Picos_mux_random.run @@ fun () ->
89+
let t = Ibtree.init () in
90+
(* Insert all elements in l1 *)
91+
List.iter (fun v -> Ibtree.insert t v v) ins_l;
92+
Ibtree.size t = len)
93+
94+
(* Behaviour for duplicate keys are undefined *)
95+
let _test_duplicate_key =
96+
QCheck.Test.make ~count:1000 ~name:"test duplicate key insert updates value"
97+
(QCheck.list_of_size Gen.nat (tup2 int int))
98+
(fun kv_l ->
99+
assume (List.length kv_l > 0);
100+
Picos_mux_random.run @@ fun () ->
101+
let t = Ibtree.init () in
102+
(* Insert all elements in l1 *)
103+
List.iter (fun (k, v) -> Ibtree.insert t k v) kv_l;
104+
let k, _ = List.hd kv_l in
105+
let updates_overwrite =
106+
List.for_all
107+
(fun (_, v) ->
108+
Ibtree.insert t k v;
109+
match Ibtree.search t k with
110+
| None -> false
111+
| Some v' ->
112+
if v = v' then true
113+
else
114+
let t_internal = Ibtree.get_internal t in
115+
Test.fail_reportf "Search key %d, Expected %d Got %d\n%s" k
116+
v v'
117+
(Ibtree.Sequential.show ~pp_v:Format.pp_print_int
118+
Format.pp_print_int t_internal))
119+
kv_l
120+
in
121+
let expected_sz = List.length kv_l * 2 in
122+
let sz = Ibtree.size t in
123+
let duplicate_kv_persist = sz = expected_sz in
124+
if updates_overwrite && duplicate_kv_persist then true
125+
else
126+
let t_internal = Ibtree.get_internal t in
127+
Test.fail_reportf "Size expected %d Got %d\n%s" expected_sz sz
128+
(Ibtree.Sequential.show ~pp_v:Format.pp_print_int
129+
Format.pp_print_int t_internal))
130+
131+
let suite =
132+
List.map QCheck_alcotest.to_alcotest [ test_insert; test_mem; test_size ]
133+
end
134+
135+
let () =
136+
Alcotest.run "Batched data structures"
137+
[ ("Skiplist", Test_skiplist.suite); ("Btree", Test_btree.suite) ]

‎test/test_obatcher.ml

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -258,7 +258,7 @@ let test_fn_all_for sched =
258258
let name =
259259
Printf.sprintf "%s (%d domains, %d fibers)" n n_domains n_fibers
260260
in
261-
Test.make ~print:Print.int ~name gen
261+
Test.make ~count:20 ~print:Print.int ~name gen
262262
(testcase_wrapper @@ t ~n_domains ~n_fibers ~sched)
263263
|> QCheck_alcotest.to_alcotest)
264264
[ (1, 1); (cpu_cores, 1); (1, cpu_cores); (cpu_cores, cpu_cores) ])

‎test/test_skiplist.ml

Lines changed: 0 additions & 45 deletions
This file was deleted.

0 commit comments

Comments
 (0)