Merge branch 'bjorn/compiler/optimizations/OTP-11584'

* bjorn/compiler/optimizations/OTP-11584:
  Teach sys_core_fold:eval_case/2 to cope with handwritten Core Erlang
  sys_core_fold: Remove a redundant word in a comment

3 files changed, 54 insertions, 9 deletions

diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index e302e2324d..500d431afe 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -1940,7 +1940,9 @@ opt_bool_case_guard(Arg, [#c_clause{pats=[#c_literal{val=false}]}=Fc,Tc]) ->
 %%  last clause is guaranteed to match so if there is only one clause
 %%  with a pattern containing only variables then rewrite to a let.
 
-eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,body=B}]}, Sub) ->
+eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,
+					   guard=#c_literal{val=true},
+					   body=B}]}=Case, Sub) ->
     Es = case cerl:is_c_values(E) of
 	     true -> cerl:values_es(E);
 	     false -> [E]
@@ -1955,7 +1957,7 @@ eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,body=B}]}, Sub) ->
     %%
     %%   let <X,Y> = <SomeSideEffect(),SomeSideEffect()> in ...
     %%
-    %% because SomeSideEffect() would be called evaluated twice.
+    %% because SomeSideEffect() would be evaluated twice.
     %%
     %% Instead we must evaluate the case expression in an outer let
     %% like this:
@@ -1964,11 +1966,19 @@ eval_case(#c_case{arg=E,clauses=[#c_clause{pats=Ps0,body=B}]}, Sub) ->
     %%       let <X,Y> = <NewVar,NewVar> in ...
     %%
     Vs = make_vars([], length(Es)),
-    {true,Bs} = cerl_clauses:match_list(Ps0, Vs),
-    {Ps,As} = unzip(Bs),
-    InnerLet = cerl:c_let(Ps, core_lib:make_values(As), B),
-    Let = cerl:c_let(Vs, E, InnerLet),
-    expr(Let, sub_new(Sub));
+    case cerl_clauses:match_list(Ps0, Vs) of
+	{false,_} ->
+	    %% This can only happen if the Core Erlang code is
+	    %% handwritten or generated by another code generator
+	    %% than v3_core. Assuming that the Core Erlang program
+	    %% is correct, the clause will always match at run-time.
+	    Case;
+	{true,Bs} ->
+	    {Ps,As} = unzip(Bs),
+	    InnerLet = cerl:c_let(Ps, core_lib:make_values(As), B),
+	    Let = cerl:c_let(Vs, E, InnerLet),
+	    expr(Let, sub_new(Sub))
+    end;
 eval_case(Case, _) -> Case.
 
 %% case_opt(CaseArg, [Clause]) -> {CaseArg,[Clause]}.
diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl
index 1a521c3591..aa222c48de 100644
--- a/lib/compiler/test/core_SUITE.erl
+++ b/lib/compiler/test/core_SUITE.erl
@@ -24,7 +24,7 @@
 	 dehydrated_itracer/1,nested_tries/1,
 	 seq_in_guard/1,make_effect_seq/1,eval_is_boolean/1,
 	 unsafe_case/1,nomatch_shadow/1,reversed_annos/1,
-	 map_core_test/1]).
+	 map_core_test/1,eval_case/1]).
 
 -include_lib("test_server/include/test_server.hrl").
 
@@ -50,7 +50,7 @@ groups() ->
     [{p,test_lib:parallel(),
       [dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq,
        eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos,
-       map_core_test
+       map_core_test,eval_case
    ]}].
 
 
@@ -76,6 +76,7 @@ end_per_group(_GroupName, Config) ->
 ?comp(nomatch_shadow).
 ?comp(reversed_annos).
 ?comp(map_core_test).
+?comp(eval_case).
 
 try_it(Mod, Conf) ->
     Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)),
diff --git a/lib/compiler/test/core_SUITE_data/eval_case.core b/lib/compiler/test/core_SUITE_data/eval_case.core
new file mode 100644
index 0000000000..f2776e2b1f
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/eval_case.core
@@ -0,0 +1,34 @@
+module 'eval_case' ['eval_case'/0]
+    attributes []
+'eval_case'/0 =
+    fun () ->
+	case <> of
+	  <> when 'true' ->
+	      case apply 'do_case'/0() of
+		<'ok'> when 'true' ->
+		    'ok'
+		( <_cor0> when 'true' ->
+		      primop 'match_fail'
+			  ({'badmatch',_cor0})
+		  -| ['compiler_generated'] )
+	      end
+	  ( <> when 'true' ->
+		( primop 'match_fail'
+		      ({'function_clause'})
+		  -| [{'function_name',{'eval_case',0}}] )
+	    -| ['compiler_generated'] )
+	end
+'do_case'/0 =
+    fun () ->
+        case let <_cor0> =
+	     apply 'id'/1(42)
+                  in  let <_cor1> =
+		      call 'erlang':'+'
+			  (_cor0, 7)
+		  in {'x',_cor1} of
+	     <{'x',49}> when 'true' ->
+	          'ok'
+        end
+'id'/1 =
+    fun (_cor0) -> _cor0
+end