diff options
-rw-r--r-- | lib/compiler/src/sys_core_fold.erl | 24 | ||||
-rw-r--r-- | lib/compiler/test/core_SUITE.erl | 5 | ||||
-rw-r--r-- | lib/compiler/test/core_SUITE_data/eval_case.core | 34 |
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 |