blob: b7fddd7f8bf592646e829d1770055804f6a048b6 (
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
|
open Printf;;
(* PR#5233: Create a dangling pointer and use it to access random parts
of the heap. *)
(* The buggy weak array will end up in smuggle. *)
let smuggle = ref (Weak.create 1);;
(* This will be the weak array (W). *)
let t = ref (Weak.create 1);;
(* Set a finalisation function on W. *)
Gc.finalise (fun w -> smuggle := w) !t;;
(* Free W and run its finalisation function. *)
t := Weak.create 1;;
Gc.full_major ();;
(* smuggle now contains W, whose pointers are not erased, even
when the contents is deallocated. *)
let size = 1_000_000;;
let check o =
printf "checking...";
match o with
| None -> printf " no value\n";
| Some s ->
printf " value found / testing...";
for i = 0 to size - 1 do
if s.[i] != ' ' then failwith "bad";
done;
printf " ok\n";
;;
let f () =
Weak.set !smuggle 0 (Some (String.make size ' '));
(* Check the data just to make sure. *)
check (Weak.get !smuggle 0);
(* Get a dangling pointer in W. *)
Gc.full_major ();
(* Fill the heap with other stuff. *)
let rec fill n accu = if n = 0 then accu else fill (n-1) (123 :: accu) in
let _r : int list = fill ((Gc.stat ()).Gc.heap_words / 3) [] in
Gc.minor ();
(* Now follow the dangling pointer and exhibit the problem. *)
check (Weak.get !smuggle 0)
let () = (f [@inlined never]) ()
|