1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
let debug = false
exception Abort
module T = Condition
(* [prod] threads increment a counter and notify a condition.
A consumer watches the condition and waits until it has seen
all of them. We check that the client always sees the final value.
If [cancel] is set, we also try to cancel the client and accept
that as success too. *)
let test ~prod ~cancel () =
let t = T.create () in
let sent = Atomic.make 0 in
for _ = 1 to prod do
Atomic.spawn (fun () ->
Atomic.incr sent;
T.broadcast t
)
done;
let finished = ref false in
Atomic.spawn (fun () ->
let ctx =
Fake_sched.run @@ fun () ->
try
T.loop_no_mutex t (fun () ->
if Atomic.get sent = prod && not cancel then Some ()
else None
);
finished := true
with T.Cancel.Cancelled Abort ->
finished := true
in
if cancel then
Option.iter (fun c -> T.Cancel.cancel c Abort) ctx
);
Atomic.final (fun () ->
Atomic.check (fun () -> !finished);
if debug then (
Fmt.pr "%a@." Broadcast.dump t;
);
)
let () =
Atomic.trace (test ~prod:2 ~cancel:false);
Atomic.trace (test ~prod:2 ~cancel:true)
|
