1let debug = false
2
3open Printf
4open Ephemeron
5
6let is_true test s b = printf "%s %s: %s\n" test s (if b then "OK" else "FAIL")
7let is_false test s b = is_true test s (not b)
8
9let is_data_value test eph (v:int) =
10  match K1.get_data_copy eph with
11  | Some x ->
12      if !x = v
13      then printf "%s data set: OK\n" test
14      else printf "%s data set: FAIL(bad value %i)\n" test (!x)
15  | None -> printf "%s data set: FAIL\n" test
16
17let is_key_value test eph (v:int) =
18  match K1.get_key_copy eph with
19  | Some x ->
20      if !x = v
21      then printf "%s key set: OK\n" test
22      else printf "%s key set: FAIL(bad value %i)\n" test (!x)
23  | None -> printf "%s key unset: FAIL\n" test
24
25let is_key_unset test eph =
26  is_false test "key unset" (K1.check_key eph)
27
28let is_data_unset test eph =
29  is_false test "data unset" (K1.check_data eph)
30
31let make_ra () = ref (ref 1) [@@inline never]
32let make_rb () = ref (ref (ref 2)) [@@inline never]
33let ra = make_ra ()
34let rb = make_rb ()
35
36(** test: key alive data dangling *)
37let test1 () =
38  let test = "test1" in
39  Gc.minor ();
40  Gc.full_major ();
41  let eph : (int ref, int ref) K1.t = K1.create () in
42  K1.set_key eph (!ra);
43  K1.set_data eph (ref 42);
44  is_key_value test eph 1;
45  is_data_value test eph 42;
46  Gc.minor ();
47  is_key_value test eph 1;
48  is_data_value test eph 42;
49  Gc.full_major ();
50  is_key_value test eph 1;
51  is_data_value test eph 42;
52  ra := ref 12;
53  Gc.full_major ();
54  is_key_unset test eph;
55  is_data_unset test eph
56let () = (test1 [@inlined never]) ()
57
58(** test: key dangling data dangling *)
59let test2 () =
60  let test = "test2" in
61  Gc.minor ();
62  Gc.full_major ();
63  let eph : (int ref, int ref) K1.t = K1.create () in
64  K1.set_key eph (ref 125);
65  K1.set_data eph (ref 42);
66  is_key_value test eph 125;
67  is_data_value test eph 42;
68  ra := ref 13;
69  Gc.minor ();
70  is_key_unset test eph;
71  is_data_unset test eph
72let () = (test2 [@inlined never]) ()
73
74(** test: key dangling data alive *)
75let test3 () =
76  let test = "test3" in
77  Gc.minor ();
78  Gc.full_major ();
79  let eph : (int ref, int ref) K1.t = K1.create () in
80  K1.set_key eph (ref 125);
81  K1.set_data eph (!ra);
82  is_key_value test eph 125;
83  is_data_value test eph 13;
84  ra := ref 14;
85  Gc.minor ();
86  is_key_unset test eph;
87  is_data_unset test eph
88let () = (test3 [@inlined never]) ()
89
90(** test: key alive but one away, data dangling *)
91let test4 () =
92  let test = "test4" in
93  Gc.minor ();
94  Gc.full_major ();
95  let eph : (int ref, int ref) K1.t = K1.create () in
96  rb := ref (ref 3);
97  K1.set_key eph (!(!rb));
98  K1.set_data eph (ref 43);
99  is_key_value test eph 3;
100  is_data_value test eph 43;
101  Gc.minor ();
102  Gc.minor ();
103  is_key_value test eph 3;
104  is_data_value test eph 43
105let () = (test4 [@inlined never]) ()
106
107(** test: key dangling but one away, data dangling *)
108let test5 () =
109  let test = "test5" in
110  Gc.minor ();
111  Gc.full_major ();
112  let eph : (int ref, int ref) K1.t = K1.create () in
113  rb := ref (ref 3);
114  K1.set_key eph (!(!rb));
115  K1.set_data eph (ref 43);
116  is_key_value test eph 3;
117  is_data_value test eph 43;
118  !rb := ref 4;
119  Gc.minor ();
120  Gc.minor ();
121  is_key_unset test eph;
122  is_data_unset test eph
123let () = (test5 [@inlined never]) ()
124
125(** test: key accessible from data but all dangling *)
126let test6 () =
127  let test = "test6" in
128  Gc.minor ();
129  Gc.full_major ();
130  let eph : (int ref, int ref ref) K1.t = K1.create () in
131  rb := ref (ref 3);
132  K1.set_key eph (!(!rb));
133  K1.set_data eph (ref (!(!rb)));
134  Gc.minor ();
135  is_key_value test eph 3;
136  !rb := ref 4;
137  Gc.full_major ();
138  is_key_unset test eph;
139  is_data_unset test eph
140let () = (test6 [@inlined never]) ()
141
142(** test: ephemeron accessible from data but they are dangling *)
143type t =
144  | No
145  | Ephe of (int ref, t) K1.t
146
147let rc = ref No
148
149let test7 () =
150  let test = "test7" in
151  Gc.minor ();
152  Gc.full_major ();
153  ra := ref 42;
154  let weak : t Weak.t = Weak.create 1 in
155  let eph : (int ref, t) K1.t ref = ref (K1.create ()) in
156  rc := Ephe !eph;
157  Weak.set weak 0 (Some !rc);
158  K1.set_key !eph !ra;
159  K1.set_data !eph !rc;
160  Gc.minor ();
161  is_true test "before" (Weak.check weak 0);
162  eph := K1.create ();
163  rc := No;
164  Gc.full_major ();
165  Gc.full_major ();
166  Gc.full_major ();
167  is_false test "after" (Weak.check weak 0)
168let () = (test7 [@inlined never]) ()
169