Skip to content

Commit a2aefc5

Browse files
polytypicpolytypic
committed
Refactor to make tests better scoped
1 parent d144446 commit a2aefc5

File tree

1 file changed

+89
-93
lines changed

1 file changed

+89
-93
lines changed

‎test/kcas/test.ml‎

Lines changed: 89 additions & 93 deletions
Original file line numberDiff line numberDiff line change
@@ -32,6 +32,13 @@ let assert_kcas loc expected_v =
3232
let present_v = Loc.get loc in
3333
assert (present_v == expected_v)
3434

35+
let run_domains = function
36+
| [] -> ()
37+
| main :: others ->
38+
let others = List.map Domain.spawn others in
39+
main ();
40+
List.iter Domain.join others
41+
3542
let test_non_linearizable () =
3643
let barrier = Barrier.make 2
3744
and n_iter = 100_000
@@ -70,91 +77,74 @@ let test_non_linearizable () =
7077
test_finished := true
7178
in
7279

73-
[ thread2; thread1 ] |> List.map Domain.spawn |> List.iter Domain.join
80+
run_domains [ thread2; thread1 ]
81+
82+
(* *)
7483

75-
(* test 1 *)
7684
let test_set () =
7785
let a = Loc.make 0 in
7886
assert_kcas a 0;
7987
Loc.set a 1;
8088
assert_kcas a 1
8189

82-
(* test 2 *)
83-
let thread1 barrier test_finished (a1, a2) () =
84-
let c1 = [ Op.make_cas a1 0 1; Op.make_cas a2 0 1 ] in
85-
let c2 = [ Op.make_cas a1 1 0; Op.make_cas a2 1 0 ] in
86-
87-
Barrier.await barrier;
88-
89-
for _ = 1 to nb_iter do
90-
assert_kcas a1 0;
91-
assert_kcas a2 0;
90+
(* *)
9291

93-
let out1 = Op.atomically c1 in
94-
assert out1;
92+
let test_casn () =
93+
let barrier = Barrier.make 3 in
94+
let test_finished = Atomic.make false in
9595

96-
assert_kcas a1 1;
97-
assert_kcas a2 1;
96+
let a1 = Loc.make 0 in
97+
let a2 = Loc.make 0 in
9898

99-
let out2 = Op.atomically c2 in
100-
assert out2
101-
done;
102-
Atomic.set test_finished true
99+
let thread1 () =
100+
let c1 = [ Op.make_cas a1 0 1; Op.make_cas a2 0 1 ] in
101+
let c2 = [ Op.make_cas a1 1 0; Op.make_cas a2 1 0 ] in
103102

104-
let thread2 barrier test_finished (a1, a2) () =
105-
let c1 = [ Op.make_cas a1 1 0; Op.make_cas a2 0 1 ] in
106-
let c2 = [ Op.make_cas a1 0 1; Op.make_cas a2 1 0 ] in
103+
Barrier.await barrier;
107104

108-
Barrier.await barrier;
105+
for _ = 1 to nb_iter do
106+
assert_kcas a1 0;
107+
assert_kcas a2 0;
109108

110-
while not (Atomic.get test_finished) do
111-
let out1 = Op.atomically c1 in
112-
let out2 = Op.atomically c2 in
113-
assert (not out1);
114-
assert (not out2)
115-
done
109+
let out1 = Op.atomically c1 in
110+
assert out1;
116111

117-
let thread3 barrier test_finished (a1, a2) () =
118-
let c1 = [ Op.make_cas a1 0 1; Op.make_cas a2 1 0 ] in
119-
let c2 = [ Op.make_cas a1 1 0; Op.make_cas a2 0 1 ] in
112+
assert_kcas a1 1;
113+
assert_kcas a2 1;
120114

121-
Barrier.await barrier;
115+
let out2 = Op.atomically c2 in
116+
assert out2
117+
done;
118+
Atomic.set test_finished true
119+
and thread2 () =
120+
let c1 = [ Op.make_cas a1 1 0; Op.make_cas a2 0 1 ] in
121+
let c2 = [ Op.make_cas a1 0 1; Op.make_cas a2 1 0 ] in
122122

123-
while not (Atomic.get test_finished) do
124-
let out1 = Op.atomically c1 in
125-
let out2 = Op.atomically c2 in
126-
assert (not out1);
127-
assert (not out2)
128-
done
123+
Barrier.await barrier;
129124

130-
let test_casn () =
131-
let barrier = Barrier.make 3 in
132-
let test_finished = Atomic.make false in
125+
while not (Atomic.get test_finished) do
126+
let out1 = Op.atomically c1 in
127+
let out2 = Op.atomically c2 in
128+
assert (not out1);
129+
assert (not out2)
130+
done
131+
and thread3 () =
132+
let c1 = [ Op.make_cas a1 0 1; Op.make_cas a2 1 0 ] in
133+
let c2 = [ Op.make_cas a1 1 0; Op.make_cas a2 0 1 ] in
133134

134-
let a1 = Loc.make 0 in
135-
let a2 = Loc.make 0 in
135+
Barrier.await barrier;
136136

137-
let domains = [ thread1; thread2; thread3 ] in
138-
List.map (fun f -> Domain.spawn (f barrier test_finished (a1, a2))) domains
139-
|> List.iter Domain.join
137+
while not (Atomic.get test_finished) do
138+
let out1 = Op.atomically c1 in
139+
let out2 = Op.atomically c2 in
140+
assert (not out1);
141+
assert (not out2)
142+
done
143+
in
140144

141-
(* test 3 *)
145+
run_domains [ thread1; thread2; thread3 ]
142146

143-
let thread4 barrier test_finished (a1, a2) () =
144-
Barrier.await barrier;
145-
for i = 0 to nb_iter do
146-
let c = [ Op.make_cas a1 i (i + 1); Op.make_cas a2 i (i + 1) ] in
147-
assert (Op.atomically c)
148-
done;
149-
Atomic.set test_finished true
150-
151-
let thread5 barrier test_finished (a1, a2) () =
152-
Barrier.await barrier;
153-
while not (Atomic.get test_finished) do
154-
let a = Loc.get a1 in
155-
let b = Loc.get a2 in
156-
assert (a <= b)
157-
done
147+
(* *)
158148

159149
let test_read_casn () =
160150
let barrier = Barrier.make 2 in
@@ -163,31 +153,43 @@ let test_read_casn () =
163153
let a1 = Loc.make 0 in
164154
let a2 = Loc.make 0 in
165155

166-
let domains = [ thread4; thread5 ] in
167-
List.map (fun f -> Domain.spawn (f barrier test_finished (a1, a2))) domains
168-
|> List.iter Domain.join
169-
170-
(* test 4 *)
171-
172-
let make_loc n =
173-
let rec loop n out =
174-
if n > 0 then loop (n - 1) (Loc.make 0 :: out) else out
156+
let mutator () =
157+
Barrier.await barrier;
158+
for i = 0 to nb_iter do
159+
let c = [ Op.make_cas a1 i (i + 1); Op.make_cas a2 i (i + 1) ] in
160+
assert (Op.atomically c)
161+
done;
162+
Atomic.set test_finished true
163+
and getter () =
164+
Barrier.await barrier;
165+
while not (Atomic.get test_finished) do
166+
let a = Loc.get a1 in
167+
let b = Loc.get a2 in
168+
assert (a <= b)
169+
done
175170
in
176-
loop n []
177171

178-
let make_kcas0 r_l =
179-
let rec loop r_l out =
180-
match r_l with h :: t -> loop t (Op.make_cas h 0 1 :: out) | [] -> out
181-
in
182-
loop r_l []
172+
run_domains [ mutator; getter ]
183173

184-
let make_kcas1 r_l =
185-
let rec loop r_l out =
186-
match r_l with h :: t -> loop t (Op.make_cas h 1 0 :: out) | [] -> out
187-
in
188-
loop r_l []
174+
(* *)
189175

190176
let test_stress n nb_loop =
177+
let make_loc n =
178+
let rec loop n out =
179+
if n > 0 then loop (n - 1) (Loc.make 0 :: out) else out
180+
in
181+
loop n []
182+
and make_kcas0 r_l =
183+
let rec loop r_l out =
184+
match r_l with h :: t -> loop t (Op.make_cas h 0 1 :: out) | [] -> out
185+
in
186+
loop r_l []
187+
and make_kcas1 r_l =
188+
let rec loop r_l out =
189+
match r_l with h :: t -> loop t (Op.make_cas h 1 0 :: out) | [] -> out
190+
in
191+
loop r_l []
192+
in
191193
let r_l = make_loc n in
192194
let kcas0 = make_kcas0 r_l in
193195
let kcas1 = make_kcas1 r_l in
@@ -196,7 +198,7 @@ let test_stress n nb_loop =
196198
assert (Op.atomically kcas1)
197199
done
198200

199-
(* test 5 *)
201+
(* *)
200202

201203
(** Various tests make accesses in random order to exercise the internal splay
202204
tree based transaction log handling. *)
@@ -234,8 +236,7 @@ let test_presort () =
234236
done
235237
in
236238

237-
Array.make n_domains thread
238-
|> Array.map Domain.spawn |> Array.iter Domain.join;
239+
run_domains (List.init n_domains (Fun.const thread));
239240

240241
locs |> Array.iter (fun r -> assert (Loc.get r = n_incs * n_domains))
241242

@@ -266,8 +267,7 @@ let test_presort_and_is_in_log_xt () =
266267
done
267268
in
268269

269-
Array.make n_domains thread
270-
|> Array.map Domain.spawn |> Array.iter Domain.join;
270+
run_domains (List.init n_domains (Fun.const thread));
271271

272272
let sum = locs |> Array.map Loc.get |> Array.fold_left ( + ) 0 in
273273
assert (sum = n_incs * n_locs_half * n_domains)
@@ -579,7 +579,3 @@ let () =
579579
test_mode ();
580580
test_xt ();
581581
Printf.printf "Test suite OK!\n%!"
582-
583-
(*
584-
####
585-
*)

0 commit comments

Comments
 (0)