blob: 7c118630472387d21557d5531228bfe21cac6b50 (
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
|
(* TEST
include unix;
hasunix;
{
native;
}{
bytecode;
}
*)
type 'a tree = Empty | Node of 'a tree * 'a tree
let rec make d =
if d = 0 then Node(Empty, Empty)
else let d = d - 1 in Node(make d, make d)
(* you need to use Gc.quick_stat, because Gc.stat forces a major cycle *)
let major_collections () =
(Gc.quick_stat ()).major_collections
(* test to force domain to do a full GC while another is waiting *)
let _ =
let sem = Semaphore.Binary.make false in
let d = Domain.spawn (fun _ -> Semaphore.Binary.acquire sem) in
Gc.full_major ();
let n = major_collections () in
ignore (make 22);
assert ((major_collections ()) > n);
Semaphore.Binary.release sem;
Domain.join d;
print_endline "wait OK"
(* test to force domain to do a full GC while another is blocking *)
let _ =
let _ = Domain.spawn (fun _ ->
Unix.sleep 10000
) in
Gc.full_major ();
let n = major_collections () in
ignore (make 22);
assert ((major_collections ()) > n);
print_endline "sleep OK"
|
