Teach sys_core_fold:eval_case/2 to cope with handwritten Core Erlang

Starting in e12b7d5331c58b41db06cadfa4af75b78b62a2b1,
sys_core_fold:eval_case/2 will crash on handwritten but legal
Core Erlang programs such as:

   case let <Var> = Arg in {'x',Var} of
      {x,X} -> X
   end

The problem is that the only clause *is* guaranteed to match, but
cerl_clauses:match_list/2 does not understand that; all it can say is
that the clause *may* match. In those circumstances, we will need to
keep the case.

Also make sure that we keep the case if the guard is something else
than 'true'. That is not strictly necessary, because in a legal Core
Erlang program the guard in the last clause in a case must always
evaluate to 'true', so removing the guard test would still leave the
program correct. Keeping the guard, however, will make it somewhat
easier to debug an incorrect Core Erlang program. (The unsafe_case
test case has guard test in the only clause in a case, so we don't
need to write a new test case to test that.)

Reported-by: Anthony Ramine

3 files changed, 53 insertions, 8 deletions

diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 99721f767d..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]
@@ -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