Global flow analysis: bug fix

We were not correctly propagating the information that a block is possibly mutated.
SylvainBoilard · Dec 11, 2024 · 71702fa · 71702fa
1 parent 18b1cbc
commit 71702fa
Show file tree

Hide file tree

Showing 3 changed files with 11 additions and 8 deletions.
diff --git a/CHANGES.md b/CHANGES.md
@@ -5,6 +5,9 @@
 * Test: use dune test stanzas (#1631)
 * Merged Wasm_of_ocaml (#1724)
 
+## Bug fixes
+* Fix small bug in global data flow analysis (#1768)
+
 # 5.9.1 (02-12-2024) - Lille
 
 ## Features/Changes

diff --git a/compiler/lib/global_flow.ml b/compiler/lib/global_flow.ml
@@ -436,11 +436,11 @@ let propagate st ~update approx x =
                          | Some tags -> List.memq t ~set:tags
                          | None -> true ->
                       let t = a.(n) in
+                      let m = Var.ISet.mem st.possibly_mutable z in
+                      if not m then add_dep st x z;
                       add_dep st x t;
                       let a = Var.Tbl.get approx t in
-                      if Var.ISet.mem st.possibly_mutable z
-                      then Domain.join ~update ~st ~approx Domain.others a
-                      else a
+                      if m then Domain.join ~update ~st ~approx Domain.others a else a
                   | Expr (Block _ | Closure _) -> Domain.bot
                   | Phi _ | Expr _ -> assert false)
                 known
@@ -464,6 +464,8 @@ let propagate st ~update approx x =
                   (fun z ->
                     match st.defs.(Var.idx z) with
                     | Expr (Block (_, lst, _, _)) ->
+                        let m = Var.ISet.mem st.possibly_mutable z in
+                        if not m then add_dep st x z;
                         Array.iter ~f:(fun t -> add_dep st x t) lst;
                         let a =
                           Array.fold_left
@@ -472,9 +474,7 @@ let propagate st ~update approx x =
                             ~init:Domain.bot
                             lst
                         in
-                        if Var.ISet.mem st.possibly_mutable z
-                        then Domain.join ~update ~st ~approx Domain.others a
-                        else a
+                        if m then Domain.join ~update ~st ~approx Domain.others a else a
                     | Expr (Closure _) -> Domain.bot
                     | Phi _ | Expr _ -> assert false)
                   known

diff --git a/compiler/tests-compiler/gh1768.ml b/compiler/tests-compiler/gh1768.ml
@@ -64,9 +64,9 @@ let () =
                 }];
        }
        var x = f();
-       function g(param){return x[1].call(null);}
+       function g(param){return caml_call1(x[1], 7);}
        h(x);
-       if(10 !== caml_call1(g(), dummy))
+       if(10 !== caml_call1(g(), 3))
         throw caml_maybe_attach_backtrace([0, Assert_failure, _b_], 1);
        var Test = [0];
        runtime.caml_register_global(3, Test, "Test");