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"
|