summaryrefslogtreecommitdiff
path: root/testsuite/tests/gc-roots/globroots_parallel_spawn_burn.ml
blob: c8b36098ac3283970b7c4d6dad0126e1234911e5 (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
(* TEST
   flags += " -w a "
   modules = "globrootsprim.c globroots.ml"
*)

open Globroots

module TestClassic = Test(Classic)
module TestGenerational = Test(Generational)

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

let _ =
  if test_size <= 1 then begin print_string "ok\n"; exit 0 end

let n = 10

let _ =
  for _ = 1 to 20 do
    let burn = fun () ->
      let module TestClassic = Test(Classic) () in
      let module TestGenerational = Test(Generational) () in
      TestClassic.test n;
      TestGenerational.test n in
    let d = Array.init 4 (fun _ -> Domain.spawn burn) in
    Array.iter Domain.join d
  done;
  let n = 128 in

  let arr_classic =
    Array.init n (fun i -> Classic.register (Int.to_string i)) in
  let d_classic_set = Array.init 4 (fun i -> Domain.spawn(fun () ->
    for j = i * (n / 4) to ((i + 1) * (n / 4) - 1) do
      Classic.set arr_classic.(j) (Int.to_string (j * 4))
    done)) in
  Array.iter Domain.join d_classic_set;
  let d_classic_remove = Array.init 4 (fun i -> Domain.spawn(fun () ->
    for j = i * (n / 4) to ((i + 1) * (n / 4) - 1) do
      Classic.remove arr_classic.(j)
    done)) in
  Array.iter Domain.join d_classic_remove;

  let arr_generational =
    Array.init 128 (fun i -> Generational.register (Int.to_string (i+1))) in
  let d_generational_set = Array.init 4 (fun i -> Domain.spawn(fun () ->
    for j = i * (n / 4) to ((i + 1) * (n / 4) - 1) do
      Generational.set arr_generational.(j) (Int.to_string (j * 4))
    done)) in
  Array.iter Domain.join d_generational_set;
  let d_generational_remove = Array.init 4 (fun i -> Domain.spawn(fun () ->
    for j = i * (n / 4) to ((i + 1) * (n / 4) - 1) do
      Generational.remove arr_generational.(j)
    done)) in
  Array.iter Domain.join d_generational_remove;

  print_string "ok\n";