Fix subtle bug in test file weaklifetime.ml

[damiendoligez]

This fixes the bug reported by @dra27 in #10055.

The bug is in the interaction of four things:

1. the compilation of pattern-matching
2. the bytecode compiler's management of scope
3. the fact that Gc.quick_stat needs to allocate
4. the way weaklifetime.ml is written

Looking at weaklifetime.ml, the compilation of pattern-matching inserts a let-binding of data.(i).objs.(j) for the pattern-matching in check_and_change. This let-binding's scope is the entire pattern-matching, including the actions. The bytecode compiler will thus keep it in a root until the end of the pattern-matching (and the function).

Now look at the Present _, true case. It does some random-number generation, some tests, some assignments, and a call to gccount. It does a second call to gccount after erasing the pointer, in an attempt to get the number of a cycle that started after the last (strong) pointer to the value was erased. It has to do that because Gc.quick_stat allocates and might thus start a new cycle and return the number of the previous cycle. But this is all for nought because the secoind call to gccount, which happens after we erase the pointer from the data structure, is still in the scope of the let introduced by pattern-matching that keeps the data alive. Hence we set the data to Absent gc2 while the cycle gc2+1 can (in rare circumstances) still see the data alive.

Note that the native-code compiler does scope minimization and removes the root as soon as it's not needed by the program, in this case when we enter the action, and avoids the problem entirely.

To make the problem easily reproducible (even on 64-bit Unix) just apply the following patch, which simply adds lots of allocations after the call to Gc.quick_stat:

--- weaklifetime.ml.orig	2020-12-04 14:29:20.000000000 +0100
+++ weaklifetime.ml	2020-12-04 14:42:35.000000000 +0100
@@ -1,7 +1,10 @@
 (* TEST
 *)
 
-Random.init 12345;;
+let seed = ref Random.(self_init(); bits());;
+if Array.length Sys.argv > 1 then seed := int_of_string Sys.argv.(1);;
+Printf.printf "seed=%d\n" !seed;;
+Random.init !seed;;
 
 let size = 1000;;
 
@@ -27,7 +30,11 @@
   )
 ;;
 
-let gccount () = (Gc.quick_stat ()).Gc.major_collections;;
+let gccount n =
+  let count = (Gc.quick_stat ()).Gc.major_collections in
+  for i = 0 to n do ignore (Sys.opaque_identity (Array.make 20 20)) done;
+  count
+;;
 
 (* Check the correctness condition on the data at (i,j):
    1. if the block is present, the weak pointer must be full
@@ -39,7 +46,7 @@
    2. if the block and weak pointer are present, randomly erase the block
 *)
 let check_and_change i j =
-  let gc1 = gccount () in
+  let gc1 = gccount 0 in
   match data.(i).objs.(j), Weak.check data.(i).wp j with
   | Present x, false -> assert false
   | Absent n, true -> assert (gc1 <= n+1)
@@ -50,14 +57,14 @@
   | Present _, true ->
     if Random.int 10 = 0 then begin
       data.(i).objs.(j) <- Absent gc1;
-      let gc2 = gccount () in
+      let gc2 = gccount 200 in
       if gc1 <> gc2 then data.(i).objs.(j) <- Absent gc2;
     end
 ;;
 
 let dummy = ref [||];;
 
-while gccount () < 20 do
+while gccount 0 < 20 do
   dummy := Array.make (Random.int 300) 0;
   let i = Random.int size in
   let j = Random.int (Array.length data.(i).objs) in

I think the simplest fix is to get out of the scope of match before we erase the pointer, by doing a tail-call to an auxiliary function.

Note: the Changes entry is my best attempt at predicting the future.

[dra27]

Very nice: I'd got some of the way down the road, and had determined that the timing required the major GC to cycle, but I couldn't figure out why the gc2 part wasn't catching it (let alone why it was bytecode only)!

[dra27]

@stedolan and I had also spotted that it was happening on 64-bit Linux system, just requiring more patience. The problem, as it happens, became more apparent with 6027c9e before 4.10 was branched!

[gasche]

I was curious about the "predict the future", which I guess might have turned it into a self-unfulfilling prediction.

[gasche]

If the aim is to ensure that the previous value of data.(i).objs.(j) is not retained on the bytecode stack, would the following suffice?

type change = No_change | Set_present | Maybe_set_absent

let check_and_change i j =
  let gc1 = gccount () in
  let change =
    (* we only read data.(i).objs.(j) in this local binding to ensure
        that it does not remain reachable on the bytecode stack
        in the rest of the function below, when we overwrite the value
        and try to observe its collection.  *)
    match data.(i).objs.(j), Weak.check data.(i).wp j with
    | Present x, false -> assert false
    | Absent n, true -> assert (gc1 <= n+1); No_change
    | Absent _, false -> Make_present
    | Present _, true ->
      if Random.int 10 = 0 then Make_absent else No_change
  in
  match change with
  | No_change -> ()
  | Make_present ->
      let x = Array.make (1 + Random.int 10) 42 in
      data.(i).objs.(j) <- Present x;
      Weak.set data.(i).wp j (Some x);
  | Make_absent ->
      data.(i).objs.(j) <- Absent gc1;
      let gc2 = gccount () in
      if gc1 <> gc2 then data.(i).objs.(j) <- Absent gc2;

[gasche]

(The point, I guess, is that I find it more natural to use lexical scoping to scope lifetimes, rather than to use tail-recursion to break out of the lexical-scoping-related lifetime.)

[xavierleroy]

I agree with @gasche's point about scoping, but I'm also eager to have this test fixed, as it is ruining our CI right now. Either @damiendoligez rewrites as suggested very soon, or the fix goes in unchanged.

[damiendoligez]

I like @gasche's version. I'll copy it and re-test with my scaffolding to make sure it works.

[xavierleroy]

Looks reasonable to me.

[Octachron]

Cherry-picked to 4.12 in 1e990bb