aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/src/Makefile2
-rw-r--r--lib/compiler/src/compile.erl7
-rw-r--r--lib/compiler/src/compiler.app.src1
-rw-r--r--lib/compiler/src/sys_core_alias.erl308
-rw-r--r--lib/compiler/src/v3_core.erl45
-rw-r--r--lib/compiler/test/Makefile1
-rw-r--r--lib/compiler/test/compile_SUITE.erl35
-rw-r--r--lib/compiler/test/core_alias_SUITE.erl195
-rw-r--r--lib/compiler/test/misc_SUITE.erl3
9 files changed, 590 insertions, 7 deletions
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index ef6db66ff6..9b22e5197b 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -83,6 +83,7 @@ MODULES = \
core_scan \
erl_bifs \
rec_env \
+ sys_core_alias \
sys_core_bsm \
sys_core_dsetel \
sys_core_fold \
@@ -194,6 +195,7 @@ $(EBIN)/core_lib.beam: core_parse.hrl
$(EBIN)/core_lint.beam: core_parse.hrl
$(EBIN)/core_parse.beam: core_parse.hrl $(EGEN)/core_parse.erl
$(EBIN)/core_pp.beam: core_parse.hrl
+$(EBIN)/sys_core_alias.beam: core_parse.hrl
$(EBIN)/sys_core_dsetel.beam: core_parse.hrl
$(EBIN)/sys_core_fold.beam: core_parse.hrl
$(EBIN)/sys_core_fold_lists.beam: core_parse.hrl
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index aa2d224bb4..ec7e7aed14 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -706,14 +706,16 @@ core_passes() ->
[{unless,no_copt,
[{core_old_inliner,fun test_old_inliner/1,fun core_old_inliner/2},
{iff,doldinline,{listing,"oldinline"}},
- {pass,sys_core_fold},
+ {unless,no_fold,{pass,sys_core_fold}},
{iff,dcorefold,{listing,"corefold"}},
{core_inline_module,fun test_core_inliner/1,fun core_inline_module/2},
{iff,dinline,{listing,"inline"}},
{core_fold_after_inlining,fun test_any_inliner/1,
fun core_fold_module_after_inlining/2},
+ {iff,dcopt,{listing,"copt"}},
+ {unless,no_alias,{pass,sys_core_alias}},
+ {iff,dalias,{listing,"core_alias"}},
?pass(core_transforms)]},
- {iff,dcopt,{listing,"copt"}},
{iff,'to_core',{done,"core"}}]}
| kernel_passes()].
@@ -1921,6 +1923,7 @@ pre_load() ->
erl_lint,
erl_parse,
erl_scan,
+ sys_core_alias,
sys_core_bsm,
sys_core_dsetel,
sys_core_fold,
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index 3139d68902..703cf1d1b8 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -58,6 +58,7 @@
core_lib,
erl_bifs,
rec_env,
+ sys_core_alias,
sys_core_bsm,
sys_core_dsetel,
sys_core_fold,
diff --git a/lib/compiler/src/sys_core_alias.erl b/lib/compiler/src/sys_core_alias.erl
new file mode 100644
index 0000000000..63e2f7488e
--- /dev/null
+++ b/lib/compiler/src/sys_core_alias.erl
@@ -0,0 +1,308 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 1999-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+%% Purpose : Replace values by aliases from patterns optimisation for Core
+
+%% Replace expressions by aliases from patterns. For example:
+%%
+%% example({ok, Val}) ->
+%% {ok, Val}.
+%%
+%% will become:
+%%
+%% example({ok, Val} = Tuple) ->
+%% Tuple.
+%%
+%% Currently this pass aliases tuple and cons nodes made of literals,
+%% variables and other cons. The tuple/cons may appear anywhere in the
+%% pattern and it will be aliased if used later on.
+%%
+%% Notice a tuple/cons made only of literals is not aliased as it may
+%% be part of the literal pool.
+
+-module(sys_core_alias).
+
+-export([module/2]).
+
+-include("core_parse.hrl").
+
+-define(NOTSET, 0).
+
+-record(sub, {p=#{} :: #{term() => ?NOTSET | atom()}, %% Found pattern substitutions
+ v=cerl_sets:new() :: cerl_sets:set(cerl:var_name()), %% Variables used by patterns
+ t=undefined :: term()}). %% Temporary information from pre to post
+
+-type sub() :: #sub{}.
+
+-spec module(cerl:c_module(), [compile:option()]) ->
+ {'ok',cerl:c_module(),[]}.
+
+module(#c_module{defs=Ds0}=Mod, _Opts) ->
+ Ds1 = [def(D) || D <- Ds0],
+ {ok,Mod#c_module{defs=Ds1},[]}.
+
+def({#c_var{name={F,Arity}}=Name,B0}) ->
+ try
+ put(new_var_num, 0),
+ {B1,_} = cerl_trees:mapfold(fun pre/2, fun post/2, sub_new(undefined), B0),
+ erase(new_var_num),
+ {Name,B1}
+ catch
+ Class:Error ->
+ Stack = erlang:get_stacktrace(),
+ io:fwrite("Function: ~w/~w\n", [F,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end.
+
+pre(#c_let{vars=Vars}=Node, Sub) ->
+ {Node,sub_fold(get_variables(Vars), Sub)};
+
+pre(#c_fun{vars=Vars}=Node, Sub) ->
+ {Node,sub_fold(get_variables(Vars), Sub)};
+
+pre(#c_clause{pats=Pats}=Node, Sub0) ->
+ VarNames = get_variables(Pats),
+ Sub1 = sub_fold(VarNames, Sub0),
+ Keys = get_pattern_keys(Pats),
+ Sub2 = sub_add_keys(Keys, Sub1),
+
+ #sub{v=SubNames,t=Temp} = Sub2,
+ Sub3 = Sub2#sub{v=merge_variables(VarNames, SubNames),
+ t={clause,Pats,Keys,SubNames,Temp}},
+
+ {Node#c_clause{pats=[]},Sub3};
+
+pre(Node, Sub0) ->
+ %% We cache only tuples and cons.
+ case cerl:is_data(Node) andalso not cerl:is_literal(Node) of
+ false ->
+ {Node,Sub0};
+ true ->
+ Kind = cerl:data_type(Node),
+ Es = cerl:data_es(Node),
+ case sub_cache_nodes(Kind, Es, Sub0) of
+ {Name,Sub1} ->
+ {cerl:ann_c_var(cerl:get_ann(Node), Name),Sub1};
+ error ->
+ {Node,Sub0}
+ end
+ end.
+
+post(#c_let{}=Node, Sub) ->
+ {Node,sub_unfold(Sub)};
+
+post(#c_fun{}=Node, Sub) ->
+ {Node,sub_unfold(Sub)};
+
+post(#c_clause{}=Node, #sub{t={clause,Pats0,Keys,V,T}}=Sub0) ->
+ {Sub1,PostKeys} = sub_take_keys(Keys, Sub0),
+ Pats1 = put_pattern_keys(Pats0, PostKeys),
+ Sub2 = sub_unfold(Sub1#sub{v=V,t=T}),
+ {Node#c_clause{pats=Pats1},Sub2};
+
+post(Node, Sub) ->
+ {Node,Sub}.
+
+%% sub_new/1
+%% sub_add_keys/2
+%% sub_take_keys/3
+%% sub_cache_nodes/3
+%%
+%% Manages the substitutions record.
+
+%% Builds a new sub.
+-spec sub_new(term()) -> sub().
+sub_new(Temp) ->
+ #sub{t=Temp}.
+
+%% Folds the sub into a new one if the variables in nodes are not disjoint
+sub_fold(VarNames, #sub{v=SubNames}=Sub) ->
+ case is_disjoint_variables(VarNames, SubNames) of
+ true -> Sub#sub{t={temp,Sub#sub.t}};
+ false -> sub_new({sub,Sub})
+ end.
+
+%% Unfolds the sub in case one was folded in the previous step
+sub_unfold(#sub{t={temp,Temp}}=Sub) ->
+ Sub#sub{t=Temp};
+sub_unfold(#sub{t={sub,Sub}}) ->
+ Sub.
+
+%% Adds the keys extracted from patterns to the state.
+-spec sub_add_keys([term()], sub()) -> sub().
+sub_add_keys(Keys, #sub{p=Pat0}=Sub) ->
+ Pat1 =
+ lists:foldl(fun(Key, Acc) ->
+ false = maps:is_key(Key, Acc), %Assertion.
+ maps:put(Key, ?NOTSET, Acc)
+ end, Pat0, Keys),
+ Sub#sub{p=Pat1}.
+
+%% Take the keys from the map taking into account the keys
+%% that have changed as those must become aliases in the pattern.
+-spec sub_take_keys([term()], sub()) -> {sub(), [{term(), atom()}]}.
+sub_take_keys(Keys, #sub{p=Pat0}=Sub) ->
+ {Pat1,Acc} = sub_take_keys(Keys, Pat0, []),
+ {Sub#sub{p=Pat1},Acc}.
+
+sub_take_keys([K|T], Sub0, Acc) ->
+ case maps:take(K, Sub0) of
+ {?NOTSET,Sub1} ->
+ sub_take_keys(T, Sub1, Acc);
+ {Name,Sub1} ->
+ sub_take_keys(T, Sub1, [{K,Name}|Acc])
+ end;
+sub_take_keys([], Sub, Acc) ->
+ {Sub,Acc}.
+
+%% Check if the node can be cached based on the state information.
+%% If it can be cached and it does not have an alias for it, we
+%% build one.
+-spec sub_cache_nodes(atom(), [cerl:cerl()], sub()) -> {atom(), sub()} | error.
+sub_cache_nodes(Kind, Nodes, #sub{p=Pat}=Sub) ->
+ case nodes_to_key(Kind, Nodes) of
+ {ok, Key} ->
+ case Pat of
+ #{Key := ?NOTSET} ->
+ new_var_name(Key, Sub);
+ #{Key := Name} ->
+ {Name,Sub};
+ #{} ->
+ error
+ end;
+ error ->
+ error
+ end.
+
+new_var_name(Key, #sub{p=Pat}=Sub) ->
+ Counter = get(new_var_num),
+ Name = list_to_atom("@r" ++ integer_to_list(Counter)),
+ put(new_var_num, Counter + 1),
+ {Name,Sub#sub{p=maps:put(Key, Name, Pat)}}.
+
+%% get_variables/1
+%% is_disjoint_variables/2
+%% merge_variables/2
+
+get_variables(NodesList) ->
+ cerl_sets:from_list([Var || Node <- NodesList, Var <- cerl_trees:variables(Node)]).
+
+is_disjoint_variables(Vars1, Vars2) ->
+ cerl_sets:is_disjoint(Vars1, Vars2).
+
+merge_variables(Vars1, Vars2) ->
+ cerl_sets:union(Vars1, Vars2).
+
+%% get_pattern_keys/2
+%% put_pattern_keys/2
+%%
+%% Gets keys from patterns or add them as aliases.
+
+get_pattern_keys(Patterns) ->
+ lists:foldl(fun get_pattern_keys/2, [], Patterns).
+
+get_pattern_keys(#c_tuple{es=Es}, Acc0) ->
+ Acc1 = accumulate_pattern_keys(tuple, Es, Acc0),
+ lists:foldl(fun get_pattern_keys/2, Acc1, Es);
+get_pattern_keys(#c_cons{hd=Hd,tl=Tl}, Acc0) ->
+ Acc1 = accumulate_pattern_keys(cons, [Hd, Tl], Acc0),
+ get_pattern_keys(Tl, get_pattern_keys(Hd, Acc1));
+get_pattern_keys(#c_alias{pat=Pat}, Acc0) ->
+ get_pattern_keys(Pat, Acc0);
+get_pattern_keys(#c_map{es=Es}, Acc0) ->
+ lists:foldl(fun get_pattern_keys/2, Acc0, Es);
+get_pattern_keys(#c_map_pair{val=Val}, Acc0) ->
+ get_pattern_keys(Val, Acc0);
+get_pattern_keys(_, Acc) ->
+ Acc.
+
+accumulate_pattern_keys(Kind, Nodes, Acc) ->
+ case nodes_to_key(Kind, Nodes) of
+ {ok,Key} -> [Key|Acc];
+ error -> Acc
+ end.
+
+put_pattern_keys(Patterns, []) ->
+ Patterns;
+put_pattern_keys(Patterns, Keys) ->
+ {NewPatterns,Map} =
+ lists:mapfoldl(fun alias_pattern_keys/2, maps:from_list(Keys), Patterns),
+ %% Check all aliases have been consumed from the map.
+ 0 = map_size(Map),
+ NewPatterns.
+
+alias_pattern_keys(#c_tuple{anno=Anno,es=Es0}=Node, Acc0) ->
+ {Es1,Acc1} = lists:mapfoldl(fun alias_pattern_keys/2, Acc0, Es0),
+ nodes_to_alias(tuple, Es0, Anno, Node#c_tuple{es=Es1}, Acc1);
+alias_pattern_keys(#c_cons{anno=Anno,hd=Hd0,tl=Tl0}=Node, Acc0) ->
+ {Hd1,Acc1} = alias_pattern_keys(Hd0, Acc0),
+ {Tl1,Acc2} = alias_pattern_keys(Tl0, Acc1),
+ nodes_to_alias(cons, [Hd0, Tl0], Anno, Node#c_cons{hd=Hd1,tl=Tl1}, Acc2);
+alias_pattern_keys(#c_alias{pat=Pat0}=Node, Acc0) ->
+ {Pat1,Acc1} = alias_pattern_keys(Pat0, Acc0),
+ {Node#c_alias{pat=Pat1}, Acc1};
+alias_pattern_keys(#c_map{es=Es0}=Node, Acc0) ->
+ {Es1,Acc1} = lists:mapfoldl(fun alias_pattern_keys/2, Acc0, Es0),
+ {Node#c_map{es=Es1}, Acc1};
+alias_pattern_keys(#c_map_pair{val=Val0}=Node, Acc0) ->
+ {Val1,Acc1} = alias_pattern_keys(Val0, Acc0),
+ {Node#c_map_pair{val=Val1}, Acc1};
+alias_pattern_keys(Pattern, Acc) ->
+ {Pattern,Acc}.
+
+%% Check if a node must become an alias because
+%% its pattern was used later on as an expression.
+nodes_to_alias(Kind, Inner, Anno, Node, Keys0) ->
+ case nodes_to_key(Kind, Inner) of
+ {ok,Key} ->
+ case maps:take(Key, Keys0) of
+ {Name,Keys1} ->
+ Var = cerl:ann_c_var(Anno, Name),
+ {cerl:ann_c_alias(Anno, Var, Node), Keys1};
+ error ->
+ {Node,Keys0}
+ end;
+ error ->
+ {Node,Keys0}
+ end.
+
+%% Builds the key used to check if a value can be
+%% replaced by an alias. It considers literals,
+%% aliases, variables, tuples and cons recursively.
+nodes_to_key(Kind, Nodes) ->
+ nodes_to_key(Nodes, [], Kind).
+
+nodes_to_key([#c_alias{var=Var}|T], Acc, Kind) ->
+ nodes_to_key([Var|T], Acc, Kind);
+nodes_to_key([#c_var{name=Name}|T], Acc, Kind) ->
+ nodes_to_key(T, [[var,Name]|Acc], Kind);
+nodes_to_key([Node|T], Acc0, Kind) ->
+ case cerl:is_data(Node) of
+ false ->
+ error;
+ true ->
+ case nodes_to_key(cerl:data_es(Node), [], cerl:data_type(Node)) of
+ {ok,Key} ->
+ nodes_to_key(T, [Key|Acc0], Kind);
+ error ->
+ error
+ end
+ end;
+nodes_to_key([], Acc, Kind) ->
+ {ok,[Kind|Acc]}.
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index ae650546e5..20cb3343fb 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -2505,8 +2505,46 @@ cexpr(#ifun{anno=#a{us=Us0}=A0,name={named,Name},fc=#iclause{pats=Ps}}=Fun0,
end;
cexpr(#iapply{anno=A,op=Op,args=Args}, _As, St) ->
{#c_apply{anno=A#a.anno,op=Op,args=Args},[],A#a.us,St};
-cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St) ->
- {#c_call{anno=A#a.anno,module=Mod,name=Name,args=Args},[],A#a.us,St};
+cexpr(#icall{anno=A,module=Mod,name=Name,args=Args}, _As, St0) ->
+ Anno = A#a.anno,
+ case (not cerl:is_c_atom(Mod)) andalso member(tuple_calls, St0#core.opts) of
+ true ->
+ GenAnno = [compiler_generated|Anno],
+
+ %% Generate the clause that matches on the tuple
+ {TupleVar,St1} = new_var(GenAnno, St0),
+ {TupleSizeVar, St2} = new_var(GenAnno, St1),
+ {TupleModVar, St3} = new_var(GenAnno, St2),
+ {TupleArgsVar, St4} = new_var(GenAnno, St3),
+ TryVar = cerl:c_var('Try'),
+
+ TupleGuardExpr =
+ cerl:c_let([TupleSizeVar],
+ c_call_erl(tuple_size, [TupleVar]),
+ c_call_erl('>', [TupleSizeVar, cerl:c_int(0)])),
+
+ TupleGuard =
+ cerl:c_try(TupleGuardExpr, [TryVar], TryVar,
+ [cerl:c_var('T'),cerl:c_var('R')], cerl:c_atom(false)),
+
+ TupleApply =
+ cerl:c_let([TupleModVar],
+ c_call_erl(element, [cerl:c_int(1),TupleVar]),
+ cerl:c_let([TupleArgsVar],
+ cerl:make_list(Args ++ [TupleVar]),
+ c_call_erl(apply, [TupleModVar,Name,TupleArgsVar]))),
+
+ TupleClause = cerl:ann_c_clause(GenAnno, [TupleVar], TupleGuard, TupleApply),
+
+ %% Generate the fallback clause
+ {OtherVar,St5} = new_var(GenAnno, St4),
+ OtherApply = cerl:ann_c_call(GenAnno, OtherVar, Name, Args),
+ OtherClause = cerl:ann_c_clause(GenAnno, [OtherVar], OtherApply),
+
+ {cerl:ann_c_case(GenAnno, Mod, [TupleClause,OtherClause]),[],A#a.us,St5};
+ false ->
+ {#c_call{anno=Anno,module=Mod,name=Name,args=Args},[],A#a.us,St0}
+ end;
cexpr(#iprimop{anno=A,name=Name,args=Args}, _As, St) ->
{#c_primop{anno=A#a.anno,name=Name,args=Args},[],A#a.us,St};
cexpr(#iprotect{anno=A,body=Es}, _As, St0) ->
@@ -2536,6 +2574,9 @@ cfun(#ifun{anno=A,id=Id,vars=Args,clauses=Lcs,fc=Lfc}, _As, St0) ->
clauses=Ccs ++ [Cfc]}},
[],A#a.us,St2}.
+c_call_erl(Fun, Args) ->
+ cerl:c_call(cerl:c_atom(erlang), cerl:c_atom(Fun), Args).
+
%% lit_vars(Literal) -> [Var].
lit_vars(Lit) -> lit_vars(Lit, []).
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index 63763f31b2..da5d207db9 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -22,6 +22,7 @@ MODULES= \
bs_construct_SUITE \
bs_match_SUITE \
bs_utf_SUITE \
+ core_alias_SUITE \
core_fold_SUITE \
compile_SUITE \
compilation_SUITE \
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index f647a4030d..aaa2005e73 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -32,7 +32,7 @@
binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1,
other_output/1, kernel_listing/1, encrypted_abstr/1,
strict_record/1, utf8_atoms/1, utf8_functions/1, extra_chunks/1,
- cover/1, env/1, core_pp/1,
+ cover/1, env/1, core_pp/1, tuple_calls/1,
core_roundtrip/1, asm/1, optimized_guards/1,
sys_pre_attributes/1, dialyzer/1,
warnings/1, pre_load_check/1, env_compiler_options/1,
@@ -49,7 +49,7 @@ all() ->
test_lib:recompile(?MODULE),
[app_test, appup_test, file_1, forms_2, module_mismatch, big_file, outdir,
binary, makedep, cond_and_ifdef, listings, listings_big,
- other_output, kernel_listing, encrypted_abstr,
+ other_output, kernel_listing, encrypted_abstr, tuple_calls,
strict_record, utf8_atoms, utf8_functions, extra_chunks,
cover, env, core_pp, core_roundtrip, asm, optimized_guards,
sys_pre_attributes, dialyzer, warnings, pre_load_check,
@@ -781,6 +781,37 @@ extra_chunks(Config) when is_list(Config) ->
{ok,{extra_chunks,[{"ExCh",<<"Contents">>}]}} =
beam_lib:chunks(ExtraChunksBinary, ["ExCh"]).
+tuple_calls(Config) when is_list(Config) ->
+ Anno = erl_anno:new(1),
+ Forms = [{attribute,Anno,export,[{size,1},{store,1}]},
+ {function,Anno,size,1,
+ [{clause,Anno,[{var,[],mod}],[],
+ [{call,[],{remote,[],{var,[],mod},{atom,[],size}},[]}]}]},
+ {function,Anno,store,1,
+ [{clause,Anno,[{var,[],mod}],[],
+ [{call,[],{remote,[],{var,[],mod},{atom,[],store}},[{atom,[],key},{atom,[],value}]}]}]}],
+
+ TupleCallsFalse = [{attribute,Anno,module,tuple_calls_false}|Forms],
+ {ok,_,TupleCallsFalseBinary} = compile:forms(TupleCallsFalse, [binary]),
+ code:load_binary(tuple_calls_false, "compile_SUITE.erl", TupleCallsFalseBinary),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_false:store(dict())),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_false:size(dict())),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_false:size(empty_tuple())),
+
+ TupleCallsTrue = [{attribute,Anno,module,tuple_calls_true}|Forms],
+ {ok,_,TupleCallsTrueBinary} = compile:forms(TupleCallsTrue, [binary,tuple_calls]),
+ code:load_binary(tuple_calls_true, "compile_SUITE.erl", TupleCallsTrueBinary),
+ Dict = tuple_calls_true:store(dict()),
+ 1 = tuple_calls_true:size(Dict),
+ {'EXIT',{badarg,_}} = (catch tuple_calls_true:size(empty_tuple())),
+
+ ok.
+
+dict() ->
+ dict:new().
+empty_tuple() ->
+ {}.
+
env(Config) when is_list(Config) ->
{Simple,Target} = get_files(Config, simple, env),
{ok,Cwd} = file:get_cwd(),
diff --git a/lib/compiler/test/core_alias_SUITE.erl b/lib/compiler/test/core_alias_SUITE.erl
new file mode 100644
index 0000000000..f3f15ef0f8
--- /dev/null
+++ b/lib/compiler/test/core_alias_SUITE.erl
@@ -0,0 +1,195 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2007-2016. All Rights Reserved.
+%%
+%% Licensed under the Apache License, Version 2.0 (the "License");
+%% you may not use this file except in compliance with the License.
+%% You may obtain a copy of the License at
+%%
+%% http://www.apache.org/licenses/LICENSE-2.0
+%%
+%% Unless required by applicable law or agreed to in writing, software
+%% distributed under the License is distributed on an "AS IS" BASIS,
+%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+%% See the License for the specific language governing permissions and
+%% limitations under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(core_alias_SUITE).
+
+-export([all/0, suite/0, groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2, end_per_group/2,
+ tuples/1, cons/1]).
+
+-include_lib("common_test/include/ct.hrl").
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ test_lib:recompile(?MODULE),
+ [{group,p}].
+
+groups() ->
+ [{p,[parallel],
+ [tuples, cons]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+
+id(X) -> X.
+
+tuples(Config) when is_list(Config) ->
+ Tuple = {ok,id(value)},
+
+ true = erts_debug:same(Tuple, simple_tuple(Tuple)),
+ true = erts_debug:same(Tuple, simple_tuple_in_map(#{hello => Tuple})),
+ true = erts_debug:same(Tuple, simple_tuple_case_repeated(Tuple, Tuple)),
+ true = erts_debug:same(Tuple, simple_tuple_fun_repeated(Tuple, Tuple)),
+ true = erts_debug:same(Tuple, simple_tuple_twice_head(Tuple, Tuple)),
+
+ {Tuple1, Tuple2} = simple_tuple_twice_body(Tuple),
+ true = erts_debug:same(Tuple, Tuple1),
+ true = erts_debug:same(Tuple, Tuple2),
+
+ Nested = {nested,Tuple},
+ true = erts_debug:same(Tuple, nested_tuple_part(Nested)),
+ true = erts_debug:same(Nested, nested_tuple_whole(Nested)),
+ true = erts_debug:same(Nested, nested_tuple_with_alias(Nested)),
+
+ true = erts_debug:same(Tuple, tuple_rebinding_after(Tuple)),
+
+ Tuple = unaliased_tuple_rebinding_before(Tuple),
+ false = erts_debug:same(Tuple, unaliased_tuple_rebinding_before(Tuple)),
+ Nested = unaliased_literal_tuple_head(Nested),
+ false = erts_debug:same(Nested, unaliased_literal_tuple_head(Nested)),
+ Nested = unaliased_literal_tuple_body(Nested),
+ false = erts_debug:same(Nested, unaliased_literal_tuple_body(Nested)),
+ Nested = unaliased_different_var_tuple(Nested, Tuple),
+ false = erts_debug:same(Nested, unaliased_different_var_tuple(Nested, Tuple)).
+
+simple_tuple({ok,X}) ->
+ {ok,X}.
+simple_tuple_twice_head({ok,X}, {ok,X}) ->
+ {ok,X}.
+simple_tuple_twice_body({ok,X}) ->
+ {{ok,X},{ok,X}}.
+simple_tuple_in_map(#{hello := {ok,X}}) ->
+ {ok,X}.
+simple_tuple_fun_repeated({ok,X}, Y) ->
+ io:format("~p~n", [X]),
+ (fun({ok,X}) -> {ok,X} end)(Y).
+simple_tuple_case_repeated({ok,X}, Y) ->
+ io:format("~p~n", [X]),
+ case Y of {ok,X} -> {ok,X} end.
+
+nested_tuple_part({nested,{ok,X}}) ->
+ {ok,X}.
+nested_tuple_whole({nested,{ok,X}}) ->
+ {nested,{ok,X}}.
+nested_tuple_with_alias({nested,{ok,_}=Y}) ->
+ {nested,Y}.
+
+tuple_rebinding_after(Y) ->
+ (fun(X) -> {ok,X} end)(Y),
+ case Y of {ok,X} -> {ok,X} end.
+unaliased_tuple_rebinding_before({ok,X}) ->
+ io:format("~p~n", [X]),
+ (fun(X) -> {ok,X} end)(value).
+unaliased_literal_tuple_head({nested,{ok,value}=X}) ->
+ io:format("~p~n", [X]),
+ {nested,{ok,value}}.
+unaliased_literal_tuple_body({nested,{ok,value}=X}) ->
+ Res = {nested,Y={ok,value}},
+ io:format("~p~n", [[X,Y]]),
+ Res.
+unaliased_different_var_tuple({nested,{ok,value}=X}, Y) ->
+ io:format("~p~n", [X]),
+ {nested,Y}.
+
+cons(Config) when is_list(Config) ->
+ Cons = [ok|id(value)],
+
+ true = erts_debug:same(Cons, simple_cons(Cons)),
+ true = erts_debug:same(Cons, simple_cons_in_map(#{hello => Cons})),
+ true = erts_debug:same(Cons, simple_cons_case_repeated(Cons, Cons)),
+ true = erts_debug:same(Cons, simple_cons_fun_repeated(Cons, Cons)),
+ true = erts_debug:same(Cons, simple_cons_twice_head(Cons, Cons)),
+
+ {Cons1,Cons2} = simple_cons_twice_body(Cons),
+ true = erts_debug:same(Cons, Cons1),
+ true = erts_debug:same(Cons, Cons2),
+
+ Nested = [nested,Cons],
+ true = erts_debug:same(Cons, nested_cons_part(Nested)),
+ true = erts_debug:same(Nested, nested_cons_whole(Nested)),
+ true = erts_debug:same(Nested, nested_cons_with_alias(Nested)),
+ true = erts_debug:same(Cons, cons_rebinding_after(Cons)),
+
+ Unstripped = id([a,b]),
+ Stripped = cons_with_binary([<<>>|Unstripped]),
+ true = erts_debug:same(Unstripped, Stripped),
+
+ Cons = unaliased_cons_rebinding_before(Cons),
+ false = erts_debug:same(Cons, unaliased_cons_rebinding_before(Cons)),
+ Nested = unaliased_literal_cons_head(Nested),
+ false = erts_debug:same(Nested, unaliased_literal_cons_head(Nested)),
+ Nested = unaliased_literal_cons_body(Nested),
+ false = erts_debug:same(Nested, unaliased_literal_cons_body(Nested)),
+ Nested = unaliased_different_var_cons(Nested, Cons),
+ false = erts_debug:same(Nested, unaliased_different_var_cons(Nested, Cons)).
+
+simple_cons([ok|X]) ->
+ [ok|X].
+simple_cons_twice_head([ok|X], [ok|X]) ->
+ [ok|X].
+simple_cons_twice_body([ok|X]) ->
+ {[ok|X],[ok|X]}.
+simple_cons_in_map(#{hello := [ok|X]}) ->
+ [ok|X].
+simple_cons_fun_repeated([ok|X], Y) ->
+ io:format("~p~n", [X]),
+ (fun([ok|X]) -> [ok|X] end)(Y).
+simple_cons_case_repeated([ok|X], Y) ->
+ io:format("~p~n", [X]),
+ case Y of [ok|X] -> [ok|X] end.
+
+nested_cons_part([nested,[ok|X]]) ->
+ [ok|X].
+nested_cons_whole([nested,[ok|X]]) ->
+ [nested,[ok|X]].
+nested_cons_with_alias([nested,[ok|_]=Y]) ->
+ [nested,Y].
+
+cons_with_binary([<<>>,X|Y]) ->
+ cons_with_binary([X|Y]);
+cons_with_binary(A) ->
+ A.
+
+cons_rebinding_after(Y) ->
+ (fun(X) -> [ok|X] end)(Y),
+ case Y of [ok|X] -> [ok|X] end.
+unaliased_cons_rebinding_before([ok|X]) ->
+ io:format("~p~n", [X]),
+ (fun(X) -> [ok|X] end)(value).
+unaliased_literal_cons_head([nested,[ok|value]=X]) ->
+ io:format("~p~n", [X]),
+ [nested,[ok|value]].
+unaliased_literal_cons_body([nested,[ok|value]=X]) ->
+ Res = [nested,Y=[ok|value]],
+ io:format("~p~n", [[X, Y]]),
+ Res.
+unaliased_different_var_cons([nested,[ok|value]=X], Y) ->
+ io:format("~p~n", [X]),
+ [nested,Y].
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index 4bd884d86b..ea4aaf40a9 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -161,11 +161,12 @@ md5_1(Beam) ->
%% Cover some code that handles internal errors.
silly_coverage(Config) when is_list(Config) ->
- %% sys_core_fold, sys_core_bsm, sys_core_setel, v3_kernel
+ %% sys_core_fold, sys_core_alias, sys_core_bsm, sys_core_setel, v3_kernel
BadCoreErlang = {c_module,[],
name,[],[],
[{{c_var,[],{foo,2}},seriously_bad_body}]},
expect_error(fun() -> sys_core_fold:module(BadCoreErlang, []) end),
+ expect_error(fun() -> sys_core_alias:module(BadCoreErlang, []) end),
expect_error(fun() -> sys_core_bsm:module(BadCoreErlang, []) end),
expect_error(fun() -> sys_core_dsetel:module(BadCoreErlang, []) end),
expect_error(fun() -> v3_kernel:module(BadCoreErlang, []) end),
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-20 14:31:27 +0000