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