summaryrefslogtreecommitdiff
path: root/testsuite/tests/lib-unix/common/multicore_fork_domain_alone.ml
blob: 077a3dba66fe272f7e1da99a35538320f2c44d49 (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
(* TEST
include unix
* hasunix
** not-windows
*** bytecode
*** native
*)

(* on Multicore, fork is not allowed is another domain is, and was running. *)
(* this test checks that we can't fork if a domain is currently running. *)

let expect_exn ="Unix.fork may not be called while other domains were created"

let () =
  let d = Domain.spawn (fun () -> Unix.sleep 1) in
  begin match Unix.fork () with
  | exception Failure msg ->
     if String.equal msg expect_exn then
       print_endline "OK"
     else
       Printf.printf "failed: expected Failure: %s, got %s\n" expect_exn msg
  | _ -> print_endline "NOK"
  end;
  Domain.join d