summaryrefslogtreecommitdiff
path: root/testsuite/tests/parallel/domain_serial_spawn_burn.ml
blob: 7355b2550a7cf44f8dd743eebef87b700cc48201 (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
(* TEST
 include unix;
 hasunix;
 {
   bytecode;
 }{
   native;
 }
*)

open Domain

let test_size =
  try int_of_string (Sys.getenv "OCAML_TEST_SIZE")
  with Not_found | Failure _ -> 0


(* This test looks to spawn domains while doing a bunch of explicit minor and major GC calls
   from parallel domains *)

(* Don't run the test if we have only 2 cores available, it times out often. *)

let list_size =
  if test_size < 2 then begin print_endline "ok"; exit 0 end
  else if test_size = 2 then 14
  else 15

let rec burn l =
  if List.hd l > test_size then ()
  else
    burn (l @ l |> List.map (fun x -> x + 1))

let test_serial_domain_spawn () =
  for i = 1 to 250 do
    let d = Domain.spawn (fun () -> burn [0]) in
    join d
  done

let () =
  let running = ref true in
  let rec run_until_stop fn () =
    while !running do
      fn ();
    done
  in

  let domain_minor_gc = Domain.spawn (run_until_stop (fun () -> burn [8]; Gc.minor ())) in
  let domain_major_gc = Domain.spawn (run_until_stop (fun () -> burn [8]; Gc.major ())) in

  test_serial_domain_spawn ();

  running := false;
  join domain_minor_gc;
  join domain_major_gc;

  print_endline "ok"