diff --git a/CHANGES.md b/CHANGES.md index 8826a18745..d640ae8ee9 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,6 +1,7 @@ # Dev (2023-??-??) - ?? * Runtime: fix Dom_html.onIE (#1493) +* Compiler: fix global flow analysis (#1494) # 5.4.0 (2023-07-06) - Lille diff --git a/compiler/lib/global_flow.ml b/compiler/lib/global_flow.ml index 849b3456c6..17e84d54b4 100644 --- a/compiler/lib/global_flow.ml +++ b/compiler/lib/global_flow.ml @@ -215,7 +215,9 @@ let expr_deps blocks st x e = match st.defs.(Var.idx f) with | Expr (Closure (params, _)) when List.length args = List.length params -> Hashtbl.add st.applied_functions (x, f) (); - if not st.fast then List.iter2 ~f:(fun p a -> add_assign_def st p a) params args; + if st.fast + then List.iter ~f:(fun a -> do_escape st Escape a) args + else List.iter2 ~f:(fun p a -> add_assign_def st p a) params args; Var.Set.iter (fun y -> add_dep st x y) (Var.Map.find f st.return_values) | _ -> ()) | Closure (l, cont) -> @@ -470,8 +472,13 @@ let propagate st ~update approx x = if not (Hashtbl.mem st.applied_functions (x, g)) then ( Hashtbl.add st.applied_functions (x, g) (); - if not st.fast + if st.fast then + List.iter + ~f:(fun y -> + Domain.variable_escape ~update ~st ~approx Escape y) + args + else List.iter2 ~f:(fun p a -> add_assign_def st p a; @@ -593,7 +600,7 @@ let f ~fast p = | Values { known; others } -> Format.fprintf f - "{%a/%b} mut:%b vmut:%b esc:%s" + "{%a/%b} mut:%b vmut:%b vesc:%s esc:%s" (Format.pp_print_list ~pp_sep:(fun f () -> Format.fprintf f ", ") (fun f x -> @@ -615,6 +622,10 @@ let f ~fast p = others st.possibly_mutable.(Var.idx x) st.variable_possibly_mutable.(Var.idx x) + (match st.variable_may_escape.(Var.idx x) with + | Escape -> "Y" + | Escape_constant -> "y" + | No -> "n") (match st.may_escape.(Var.idx x) with | Escape -> "Y" | Escape_constant -> "y" diff --git a/compiler/tests-compiler/dune.inc b/compiler/tests-compiler/dune.inc index 04275749f1..0a870892f6 100644 --- a/compiler/tests-compiler/dune.inc +++ b/compiler/tests-compiler/dune.inc @@ -359,6 +359,21 @@ (preprocess (pps ppx_expect))) +(library + ;; compiler/tests-compiler/gh1494.ml + (name gh1494_15) + (enabled_if true) + (modules gh1494) + (libraries js_of_ocaml_compiler unix str jsoo_compiler_expect_tests_helper) + (inline_tests + (enabled_if true) + (deps + (file %{project_root}/compiler/bin-js_of_ocaml/js_of_ocaml.exe) + (file %{project_root}/compiler/bin-jsoo_minify/jsoo_minify.exe))) + (flags (:standard -open Jsoo_compiler_expect_tests_helper)) + (preprocess + (pps ppx_expect))) + (library ;; compiler/tests-compiler/gh747.ml (name gh747_15) diff --git a/compiler/tests-compiler/gh1494.ml b/compiler/tests-compiler/gh1494.ml new file mode 100644 index 0000000000..fd646b38f2 --- /dev/null +++ b/compiler/tests-compiler/gh1494.ml @@ -0,0 +1,45 @@ +(* Js_of_ocaml tests + * http://www.ocsigen.org/js_of_ocaml/ + * Copyright (C) 2020 Hugo Heuzard + * + * This program is free software; you can redistribute it and/or modify + * it under the terms of the GNU Lesser General Public License as published by + * the Free Software Foundation, with linking exception; + * either version 2.1 of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + *) + +(* https://github.com/ocsigen/js_of_ocaml/issues/1007 *) + +(* Small bug in the global flow analysis in fast mode *) +let%expect_test _ = + let prog = + {| +let () = + let bug () = let g = ref (fun x -> Fun.id) in (fun () -> !g 1), g in + let h f = + let (h, g) = f() in g := (fun x y -> y); Printf.printf "%d\n" (h () 7) in + h bug; h bug +|} + in + Util.compile_and_run prog; + [%expect {| + 7 + 7 |}]; + let program = Util.compile_and_parse prog in + Util.print_fun_decl program (Some "bug"); + [%expect + {| + function bug(param){ + var g = [0, function(x){return function(_c_){return _c_;};}]; + return [0, function(param){return caml_call1(g[1], 1);}, g]; + } + //end |}]