From 1ef53ead19d5bd07caad4daa71b8fecf2fbcd2a6 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Fri, 16 Jan 2015 15:06:53 +0100
Subject: sys_core_fold: Strengthen optimization of letrecs in effect context

We used to evaluate the body of a 'letrec' in value context, even
if the 'letrec' was being evaluated in effect context. In most
cases, the context does not matter because the body is usually
just an 'apply' which will never be optimized away.

However, in the case of incorrect code described in the previous
commit, it does matter. We can find such bad code by evaluating
the body in effect context. For example, if we have the following
incorrect code:

  letrec
    f/1 = fun(A) -> ... <use of Var> ...
    in let Var = <<2:301>>
       in apply(Arg)

If the letrec is evaluated in effect context, the code will be
reduced to:

  letrec
    f/1 = fun(A) -> ... <use of Var> ...
    in seq Var = <<2:301>> do apply(Arg)

Now Var will be unbound and a later compiler pass will crash to
ensure that the bad Core Erlang code is noticed.

Also add a test case to ensure that the compiler crashes if the
bug fixed in the previous commit re-surfaces.
---
 lib/compiler/src/sys_core_fold.erl |  2 +-
 lib/compiler/test/lc_SUITE.erl     | 21 +++++++++++++++++++--
 2 files changed, 20 insertions(+), 3 deletions(-)

(limited to 'lib/compiler')

diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 09716d0866..e079fc072a 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -313,7 +313,7 @@ expr(#c_letrec{defs=Fs0,body=B0}=Letrec, Ctxt, Sub) ->
     Fs1 = map(fun ({Name,Fb}) ->
 		      {Name,expr(Fb, {letrec,Ctxt}, Sub)}
 	      end, Fs0),
-    B1 = body(B0, value, Sub),
+    B1 = body(B0, Ctxt, Sub),
     Letrec#c_letrec{defs=Fs1,body=B1};
 expr(#c_case{}=Case0, Ctxt, Sub) ->
     %% Ideally, the compiler should only emit warnings when there is
diff --git a/lib/compiler/test/lc_SUITE.erl b/lib/compiler/test/lc_SUITE.erl
index 6b3472b37b..6c5b34498b 100644
--- a/lib/compiler/test/lc_SUITE.erl
+++ b/lib/compiler/test/lc_SUITE.erl
@@ -22,7 +22,8 @@
 	 init_per_group/2,end_per_group/2,
 	 init_per_testcase/2,end_per_testcase/2,
 	 basic/1,deeply_nested/1,no_generator/1,
-	 empty_generator/1,no_export/1,shadow/1]).
+	 empty_generator/1,no_export/1,shadow/1,
+	 effect/1]).
 
 -include_lib("test_server/include/test_server.hrl").
 
@@ -39,7 +40,8 @@ groups() ->
        no_generator,
        empty_generator,
        no_export,
-       shadow
+       shadow,
+       effect
       ]}].
 
 init_per_suite(Config) ->
@@ -199,6 +201,21 @@ shadow(Config) when is_list(Config) ->
 			    Shadowed < 10]),
     ok.
 
+effect(Config) when is_list(Config) ->
+    [{42,{a,b,c}}] =
+	do_effect(fun(F, L) ->
+			  [F({V1,V2}) ||
+			      #{<<1:500>>:=V1,<<2:301>>:=V2} <- L],
+			  ok
+		  end, id([#{},x,#{<<1:500>>=>42,<<2:301>>=>{a,b,c}}])),
+    ok.
+
+do_effect(Lc, L) ->
+    put(?MODULE, []),
+    F = fun(V) -> put(?MODULE, [V|get(?MODULE)]) end,
+    ok = Lc(F, L),
+    lists:reverse(erase(?MODULE)).
+
 id(I) -> I.
     
 fc(Args, {'EXIT',{function_clause,[{?MODULE,_,Args,_}|_]}}) -> ok;
-- 
cgit v1.2.3