summaryrefslogtreecommitdiff
path: root/testsuite/tests/lib-threads/prodcons.ml
blob: 8c27984127d8ff864e1cb6b26a75b838caf53c38 (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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
(* TEST
 include systhreads;
 hassysthreads;
 {
   bytecode;
 }{
   native;
 }
*)

(* Classic producer-consumer *)

type 'a prodcons =
  { buffer: 'a array;
    lock: Mutex.t;
    mutable readpos: int;
    mutable writepos: int;
    notempty: Condition.t;
    notfull: Condition.t }

let create size init =
  { buffer = Array.make size init;
    lock = Mutex.create();
    readpos = 0;
    writepos = 0;
    notempty = Condition.create();
    notfull = Condition.create() }

let put p data =
  Mutex.lock p.lock;
  while (p.writepos + 1) mod Array.length p.buffer = p.readpos do
    Condition.wait p.notfull p.lock
  done;
  p.buffer.(p.writepos) <- data;
  p.writepos <- (p.writepos + 1) mod Array.length p.buffer;
  Condition.signal p.notempty;
  Mutex.unlock p.lock

let get p =
  Mutex.lock p.lock;
  while p.writepos = p.readpos do
    Condition.wait p.notempty p.lock
  done;
  let data = p.buffer.(p.readpos) in
  p.readpos <- (p.readpos + 1) mod Array.length p.buffer;
  Condition.signal p.notfull;
  Mutex.unlock p.lock;
  data

(* Test *)

let rec produce buff n max =
  put buff n;
  if n < max then produce buff (n+1) max

let rec consume buff cur max =
  let n = get buff in
  if n <> cur then false
  else if n = max then true
  else consume buff (cur + 1) max

let _ =
  let buff1 = create 20 0 and buff2 = create 30 0 in
  let ok1 = ref false and ok2 = ref false in
  let _p1 = Thread.create (fun () -> produce buff1 0 10000) ()
  and _p2 = Thread.create (fun () -> produce buff2 0 8000) ()
  and c1 = Thread.create (fun () -> ok1 := consume buff1 0 10000) () in
  ok2 := consume buff2 0 8000;
  Thread.join c1;
  if !ok1 && !ok2
  then print_string "passed\n"
  else print_string "FAILED\n"