File 0266-Fix-side-effect-optimization-when-compiling-from-Cor.patch of Package erlang

From a2b94643d345505bcee103b114147e3cb962b8ac Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?John=20H=C3=B6gberg?= <john@erlang.org>
Date: Mon, 16 Jul 2018 15:21:04 +0200
Subject: [PATCH] Fix side-effect optimization when compiling from Core Erlang
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

When an expression is only used for its side effects, we try to
remove everything that doesn't tie into a side-effect, but we
went a bit too far when we applied the optimization to funs
defined in such a context. Consider the following:

 do letrec 'f'/0 = fun () -> ... whatever ...
     in call 'side':'effect'(apply 'f'/0())
   'ok'

When f/0 is optimized under the assumption that its return value
is unused, side:effect/1 will be fed the result of the last
side-effecting expression in f/0 instead of its actual result.

https://bugs.erlang.org/browse/ERL-658

Co-authored-by: Björn Gustavsson <bjorn@erlang.org>
---
 lib/compiler/src/sys_core_fold.erl                 | 87 +++++++++++++++++++++-
 lib/compiler/test/core_SUITE.erl                   |  5 +-
 .../test/core_SUITE_data/fun_letrec_effect.core    | 25 +++++++
 lib/compiler/test/core_fold_SUITE.erl              | 24 +++++-
 4 files changed, 136 insertions(+), 5 deletions(-)
 create mode 100644 lib/compiler/test/core_SUITE_data/fun_letrec_effect.core

diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index ceb7d56221..0e4f2d5cb8 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -352,7 +352,12 @@ expr(#c_letrec{body=#c_var{}}=Letrec, effect, _Sub) ->
     void();
 expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) ->
     Fs1 = map(fun ({Name,Fb}) ->
-		      {Name,expr(Fb, {letrec,Ctxt}, Sub)}
+                      case Ctxt =:= effect andalso is_fun_effect_safe(Name, B0) of
+                          true ->
+                              {Name,expr(Fb, {letrec, effect}, Sub)};
+                          false ->
+                              {Name,expr(Fb, {letrec, value}, Sub)}
+                      end
 	      end, Fs0),
     B1 = body(B0, Ctxt, Sub),
     Letrec#c_letrec{defs=Fs1,body=B1};
@@ -483,6 +488,86 @@ expr(#c_try{anno=A,arg=E0,vars=Vs0,body=B0,evars=Evs0,handler=H0}=Try, _, Sub0)
 	    Try#c_try{arg=E1,vars=Vs1,body=B1,evars=Evs1,handler=H1}
     end.
 
+
+%% If a fun or its application is used as an argument, then it's unsafe to
+%% handle it in effect context as the side-effects may rely on its return
+%% value. The following is a minimal example of where it can go wrong:
+%%
+%% do letrec 'f'/0 = fun () -> ... whatever ...
+%%      in call 'side':'effect'(apply 'f'/0())
+%%   'ok'
+%%
+%% This function returns 'true' if Body definitely does not rely on a
+%% value produced by FVar, or 'false' if Body depends on or might depend on
+%% a value produced by FVar.
+
+is_fun_effect_safe(#c_var{}=FVar, Body) ->
+    ifes_1(FVar, Body, true).
+
+ifes_1(FVar, #c_alias{pat=Pat}, _Safe) ->
+    ifes_1(FVar, Pat, false);
+ifes_1(FVar, #c_apply{op=Op,args=Args}, Safe) ->
+    %% FVar(...) is safe as long its return value is ignored, but it's never
+    %% okay to pass FVar as an argument.
+    ifes_list(FVar, Args, false) andalso ifes_1(FVar, Op, Safe);
+ifes_1(FVar, #c_binary{segments=Segments}, _Safe) ->
+    ifes_list(FVar, Segments, false);
+ifes_1(FVar, #c_bitstr{val=Val,size=Size,unit=Unit}, _Safe) ->
+    ifes_list(FVar, [Val, Size, Unit], false);
+ifes_1(FVar, #c_call{args=Args}, _Safe) ->
+    ifes_list(FVar, Args, false);
+ifes_1(FVar, #c_case{arg=Arg,clauses=Clauses}, Safe) ->
+    ifes_1(FVar, Arg, false) andalso ifes_list(FVar, Clauses, Safe);
+ifes_1(FVar, #c_catch{body=Body}, _Safe) ->
+    ifes_1(FVar, Body, false);
+ifes_1(FVar, #c_clause{pats=Pats,guard=Guard,body=Body}, Safe) ->
+    ifes_list(FVar, Pats, false) andalso
+        ifes_1(FVar, Guard, false) andalso
+        ifes_1(FVar, Body, Safe);
+ifes_1(FVar, #c_cons{hd=Hd,tl=Tl}, _Safe) ->
+    ifes_1(FVar, Hd, false) andalso ifes_1(FVar, Tl, false);
+ifes_1(FVar, #c_fun{body=Body}, _Safe) ->
+    ifes_1(FVar, Body, false);
+ifes_1(FVar, #c_let{arg=Arg,body=Body}, Safe) ->
+    ifes_1(FVar, Arg, false) andalso ifes_1(FVar, Body, Safe);
+ifes_1(FVar, #c_letrec{defs=Defs,body=Body}, Safe) ->
+    Funs = [Fun || {_,Fun} <- Defs],
+    ifes_list(FVar, Funs, false) andalso ifes_1(FVar, Body, Safe);
+ifes_1(_FVar, #c_literal{}, _Safe) ->
+    true;
+ifes_1(FVar, #c_map{arg=Arg,es=Elements}, _Safe) ->
+    ifes_1(FVar, Arg, false) andalso ifes_list(FVar, Elements, false);
+ifes_1(FVar, #c_map_pair{key=Key,val=Val}, _Safe) ->
+    ifes_1(FVar, Key, false) andalso ifes_1(FVar, Val, false);
+ifes_1(FVar, #c_primop{args=Args}, _Safe) ->
+    ifes_list(FVar, Args, false);
+ifes_1(FVar, #c_receive{timeout=Timeout,action=Action,clauses=Clauses}, Safe) ->
+    ifes_1(FVar, Timeout, false) andalso
+        ifes_1(FVar, Action, Safe) andalso
+        ifes_list(FVar, Clauses, Safe);
+ifes_1(FVar, #c_seq{arg=Arg,body=Body}, Safe) ->
+    %% Arg of a #c_seq{} has no effect so it's okay to use FVar there even if
+    %% Safe=false.
+    ifes_1(FVar, Arg, true) andalso ifes_1(FVar, Body, Safe);
+ifes_1(FVar, #c_try{arg=Arg,handler=Handler,body=Body}, Safe) ->
+    ifes_1(FVar, Arg, false) andalso
+        ifes_1(FVar, Handler, Safe) andalso
+        ifes_1(FVar, Body, Safe);
+ifes_1(FVar, #c_tuple{es=Elements}, _Safe) ->
+    ifes_list(FVar, Elements, false);
+ifes_1(FVar, #c_values{es=Elements}, _Safe) ->
+    ifes_list(FVar, Elements, false);
+ifes_1(#c_var{name=Name}, #c_var{name=Name}, Safe) ->
+    %% It's safe to return FVar if it's unused.
+    Safe;
+ifes_1(_FVar, #c_var{}, _Safe) ->
+    true.
+
+ifes_list(FVar, [E|Es], Safe) ->
+    ifes_1(FVar, E, Safe) andalso ifes_list(FVar, Es, Safe);
+ifes_list(_FVar, [], _Safe) ->
+    true.
+
 expr_list(Es, Ctxt, Sub) ->
     [expr(E, Ctxt, Sub) || E <- Es].
 
diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl
index 23f420f5f2..e5611e99d1 100644
--- a/lib/compiler/test/core_SUITE.erl
+++ b/lib/compiler/test/core_SUITE.erl
@@ -27,7 +27,7 @@
 	 unsafe_case/1,nomatch_shadow/1,reversed_annos/1,
 	 map_core_test/1,eval_case/1,bad_boolean_guard/1,
 	 bs_shadowed_size_var/1,
-	 name_capture/1
+	 name_capture/1, fun_letrec_effect/1
 	]).
 
 -include_lib("test_server/include/test_server.hrl").
@@ -56,7 +56,7 @@ groups() ->
        eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos,
        map_core_test,eval_case,bad_boolean_guard,
        bs_shadowed_size_var,
-       name_capture
+       name_capture, fun_letrec_effect
    ]}].
 
 
@@ -86,6 +86,7 @@ end_per_group(_GroupName, Config) ->
 ?comp(bad_boolean_guard).
 ?comp(bs_shadowed_size_var).
 ?comp(name_capture).
+?comp(fun_letrec_effect).
 
 try_it(Mod, Conf) ->
     Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)),
diff --git a/lib/compiler/test/core_SUITE_data/fun_letrec_effect.core b/lib/compiler/test/core_SUITE_data/fun_letrec_effect.core
new file mode 100644
index 0000000000..ab6f5b7940
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/fun_letrec_effect.core
@@ -0,0 +1,25 @@
+module 'fun_letrec_effect' ['fun_letrec_effect'/0, 'ok'/0, 'wat'/0]
+attributes []
+
+'fun_letrec_effect'/0 =
+  fun () ->
+    do apply 'wat'/0()
+       receive
+         <'bar'> when 'true' -> 'ok'
+         <_0> when 'true' -> 'failed'
+       after 'infinity' ->
+         'true'
+
+%% The return value (bar) of the fun was optimized away because the result of
+%% the `letrec ... in` was unused, despite the fun's return value being
+%% relevant for the side-effect of the expression.
+'wat'/0 =
+  fun () ->
+    let <Self> = call 'erlang':'self'() in
+      do letrec 'f'/0 = fun () ->
+                                do  call 'maps':'put'('foo', 'bar', ~{}~)
+                                    'bar'
+          in call 'erlang':'send'(Self, apply 'f'/0())
+          'undefined'
+
+end
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index 2a2369fff9..47606014c3 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -25,7 +25,8 @@
 	 eq/1,nested_call_in_case/1,guard_try_catch/1,coverage/1,
 	 unused_multiple_values_error/1,unused_multiple_values/1,
 	 multiple_aliases/1,redundant_boolean_clauses/1,
-	 mixed_matching_clauses/1,unnecessary_building/1]).
+	 mixed_matching_clauses/1,unnecessary_building/1,
+	 cover_letrec_effect/1]).
 
 -export([foo/0,foo/1,foo/2,foo/3]).
 
@@ -43,7 +44,8 @@ groups() ->
        eq,nested_call_in_case,guard_try_catch,coverage,
        unused_multiple_values_error,unused_multiple_values,
        multiple_aliases,redundant_boolean_clauses,
-       mixed_matching_clauses,unnecessary_building]}].
+       mixed_matching_clauses,unnecessary_building,
+       cover_letrec_effect]}].
 
 
 init_per_suite(Config) ->
@@ -454,4 +456,25 @@ empty_values(_Config) ->
      [_,_] = [T,none],
      x}.
 
+cover_letrec_effect(_Config) ->
+    self() ! {tag,42},
+    _ = try
+            try
+                ignore
+            after
+                receive
+                    {tag,Int}=Term ->
+                        Res = #{k => {Term,<<Int:16>>}},
+                        self() ! Res
+                end
+            end
+        after
+            ok
+        end,
+    receive
+        Any ->
+            #{k := {{tag,42},<<42:16>>}} = Any
+    end,
+    ok.
+
 id(I) -> I.
-- 
2.16.4

openSUSE Build Service is sponsored by