summaryrefslogtreecommitdiff
path: root/testsuite/tests/parallel/pingpong.ml
blob: 8f900d6de364d78d202a47efc9b77f8cc0508292 (plain)
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
(* TEST *)

let r = ref (Some 0)

let () = Gc.minor ()


let rec even lim put =
  match !r with
  | Some n when n = lim -> ()
  | (Some n) when n mod 2 == 0 ->
     let next = Some (n + 1) in
     put next;
     even lim put
  | _ -> let _ = [!r] in even lim put

let rec odd lim put =
  match !r with
  | Some n when n = lim -> ()
  | (Some n) when n mod 2 == 1 ->
     let next = Some (n + 1) in
     put next;
     odd lim put
  | _ -> let _ = [!r] in odd lim put


let go n put =
  r := Some 0;
  let d = Domain.spawn (fun () -> even n put) in
  odd n put;
  (match !r with
  | Some n ->
     Printf.printf "%d\n%!" n
  | None ->
     assert false);
  Domain.join d


let () =
  go 100_000 (fun x -> r := x)