summaryrefslogtreecommitdiff
path: root/testsuite/tests/lib-systhreads/testfork2.ml
blob: bea41022d47cf7e859a3ba13cf68ea4fe1eae155 (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
 include systhreads;
 hassysthreads;
 not-bsd;
 libunix;
 {
   bytecode;
 }{
   native;
 }
*)

(* POSIX threads and fork() *)

let alloc_string () = ignore(String.make 2048 '0')

let compute_thread () =
  Thread.create begin fun () ->
    alloc_string ()
  end ()

let fork () =
  match Unix.fork() with
  | 0 ->
      alloc_string ();
      print_string "passed";
      print_newline ();
      Thread.delay 1.0;
      exit 0
  | pid ->
      Thread.delay 4.0;
      exit 0

let main () =
  ignore(compute_thread ());
  ignore(compute_thread ());
  ignore(compute_thread ());
  fork ()

let _ = main()