aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/doc/src/compile.xml2
-rw-r--r--lib/compiler/src/Makefile1
-rw-r--r--lib/compiler/src/beam_disasm.erl12
-rw-r--r--lib/compiler/src/beam_except.erl149
-rw-r--r--lib/compiler/src/beam_utils.erl11
-rw-r--r--lib/compiler/src/cerl_inline.erl24
-rw-r--r--lib/compiler/src/compile.erl2
-rw-r--r--lib/compiler/src/compiler.app.src1
-rw-r--r--lib/compiler/src/sys_core_fold.erl130
-rw-r--r--lib/compiler/src/v3_codegen.erl54
-rw-r--r--lib/compiler/src/v3_core.erl7
-rw-r--r--lib/compiler/src/v3_kernel.erl276
-rw-r--r--lib/compiler/src/v3_kernel.hrl1
-rw-r--r--lib/compiler/src/v3_life.erl131
-rw-r--r--lib/compiler/test/Makefile3
-rw-r--r--lib/compiler/test/beam_disasm_SUITE.erl4
-rw-r--r--lib/compiler/test/beam_expect_SUITE.erl67
-rw-r--r--lib/compiler/test/beam_validator_SUITE.erl27
-rw-r--r--lib/compiler/test/bs_match_SUITE.erl7
-rw-r--r--lib/compiler/test/compilation_SUITE.erl49
-rw-r--r--lib/compiler/test/compilation_SUITE_data/on_load_inline.erl23
-rw-r--r--lib/compiler/test/compile_SUITE.erl37
-rw-r--r--lib/compiler/test/compile_SUITE_data/attributes.erl23
-rw-r--r--lib/compiler/test/compiler.cover2
-rw-r--r--lib/compiler/test/core_SUITE.erl35
-rw-r--r--lib/compiler/test/core_SUITE_data/eval_is_boolean.core22
-rw-r--r--lib/compiler/test/core_SUITE_data/make_effect_seq.core51
-rw-r--r--lib/compiler/test/core_SUITE_data/nomatch_shadow.core28
-rw-r--r--lib/compiler/test/core_SUITE_data/reversed_annos.core49
-rw-r--r--lib/compiler/test/core_SUITE_data/seq_in_guard.core66
-rw-r--r--lib/compiler/test/core_SUITE_data/unsafe_case.core25
-rw-r--r--lib/compiler/test/core_fold_SUITE.erl35
-rw-r--r--lib/compiler/test/misc_SUITE.erl20
-rw-r--r--lib/compiler/test/parteval_SUITE.erl66
-rw-r--r--lib/compiler/test/parteval_SUITE_data/t1.erl140
-rw-r--r--lib/compiler/test/test_lib.erl9
-rw-r--r--lib/compiler/test/trycatch_SUITE.erl18
37 files changed, 931 insertions, 676 deletions
diff --git a/lib/compiler/doc/src/compile.xml b/lib/compiler/doc/src/compile.xml
index 522c1dc411..0f8abf1ccf 100644
--- a/lib/compiler/doc/src/compile.xml
+++ b/lib/compiler/doc/src/compile.xml
@@ -333,7 +333,7 @@ module.beam: module.erl \
<tag><c>{d,Macro,Value}</c></tag>
<item>
<p>Defines a macro <c>Macro</c> to have the value
- <c>Value</c>. The default is <c>true</c>).</p>
+ <c>Value</c>. The default is <c>true</c>.</p>
</item>
<tag><c>{parse_transform,Module}</c></tag>
diff --git a/lib/compiler/src/Makefile b/lib/compiler/src/Makefile
index 7a237608ad..3415517fff 100644
--- a/lib/compiler/src/Makefile
+++ b/lib/compiler/src/Makefile
@@ -53,6 +53,7 @@ MODULES = \
beam_dead \
beam_dict \
beam_disasm \
+ beam_except \
beam_flatten \
beam_jump \
beam_listing \
diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl
index 7103d2390f..62bdc74cc8 100644
--- a/lib/compiler/src/beam_disasm.erl
+++ b/lib/compiler/src/beam_disasm.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2000-2011. All Rights Reserved.
+%% Copyright Ericsson AB 2000-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -182,10 +182,14 @@ process_chunks(F) ->
Literals = beam_disasm_literals(LiteralBin),
Code = beam_disasm_code(CodeBin, Atoms, mk_imports(ImportsList),
StrBin, Lambdas, Literals, Module),
- Attributes = optional_chunk(F, attributes),
+ Attributes =
+ case optional_chunk(F, attributes) of
+ none -> [];
+ Atts when is_list(Atts) -> Atts
+ end,
CompInfo =
case optional_chunk(F, "CInf") of
- none -> none;
+ none -> [];
CompInfoBin when is_binary(CompInfoBin) ->
binary_to_term(CompInfoBin)
end,
@@ -198,7 +202,7 @@ process_chunks(F) ->
end.
%%-----------------------------------------------------------------------
-%% Retrieve an optional chunk or none if the chunk doesn't exist.
+%% Retrieve an optional chunk or return 'none' if the chunk doesn't exist.
%%-----------------------------------------------------------------------
optional_chunk(F, ChunkTag) ->
diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl
new file mode 100644
index 0000000000..fb1a43cd9e
--- /dev/null
+++ b/lib/compiler/src/beam_except.erl
@@ -0,0 +1,149 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(beam_except).
+-export([module/2]).
+
+%%% Rewrite certain calls to erlang:error/{1,2} to specialized
+%%% instructions:
+%%%
+%%% erlang:error({badmatch,Value}) => badmatch Value
+%%% erlang:error({case_clause,Value}) => case_end Value
+%%% erlang:error({try_clause,Value}) => try_case_end Value
+%%% erlang:error(if_clause) => if_end
+%%% erlang:error(function_clause, Args) => jump FuncInfoLabel
+%%%
+
+-import(lists, [reverse/1]).
+
+module({Mod,Exp,Attr,Fs0,Lc}, _Opt) ->
+ Fs = [function(F) || F <- Fs0],
+ {ok,{Mod,Exp,Attr,Fs,Lc}}.
+
+function({function,Name,Arity,CLabel,Is0}) ->
+ try
+ Is = function_1(Is0),
+ {function,Name,Arity,CLabel,Is}
+ catch
+ Class:Error ->
+ Stack = erlang:get_stacktrace(),
+ io:fwrite("Function: ~w/~w\n", [Name,Arity]),
+ erlang:raise(Class, Error, Stack)
+ end.
+
+-record(st,
+ {lbl, %func_info label
+ loc %location for func_info
+ }).
+
+function_1(Is0) ->
+ case Is0 of
+ [{label,Lbl},{line,Loc}|_] ->
+ St = #st{lbl=Lbl,loc=Loc},
+ translate(Is0, St, []);
+ [{label,_}|_] ->
+ %% No line numbers. The source must be a .S file.
+ %% There is no need to do anything.
+ Is0
+ end.
+
+translate([{call_ext,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) ->
+ translate_1(Ar, I, Is, St, Acc);
+translate([{call_ext_only,Ar,{extfunc,erlang,error,Ar}}=I|Is], St, Acc) ->
+ translate_1(Ar, I, Is, St, Acc);
+translate([{call_ext_last,Ar,{extfunc,erlang,error,Ar},_}=I|Is], St, Acc) ->
+ translate_1(Ar, I, Is, St, Acc);
+translate([I|Is], St, Acc) ->
+ translate(Is, St, [I|Acc]);
+translate([], _, Acc) ->
+ reverse(Acc).
+
+translate_1(Ar, I, Is, St, [{line,_}=Line|Acc1]=Acc0) ->
+ case dig_out(Ar, Acc1) of
+ no ->
+ translate(Is, St, [I|Acc0]);
+ {yes,function_clause,Acc2} ->
+ case {Line,St} of
+ {{line,Loc},#st{lbl=Fi,loc=Loc}} ->
+ Instr = {jump,{f,Fi}},
+ translate(Is, St, [Instr|Acc2]);
+ {_,_} ->
+ %% This must be "error(function_clause, Args)" in
+ %% the Erlang source code. Don't translate.
+ translate(Is, St, [I|Acc0])
+ end;
+ {yes,Instr,Acc2} ->
+ translate(Is, St, [Instr,Line|Acc2])
+ end.
+
+dig_out(Ar, [{kill,_}|Is]) ->
+ dig_out(Ar, Is);
+dig_out(1, [{block,Bl0}|Is]) ->
+ case dig_out_block(reverse(Bl0)) of
+ no -> no;
+ {yes,What,[]} ->
+ {yes,What,Is};
+ {yes,What,Bl} ->
+ {yes,What,[{block,Bl}|Is]}
+ end;
+dig_out(2, [{block,Bl}|Is]) ->
+ case dig_out_block_fc(Bl) of
+ no -> no;
+ {yes,What} -> {yes,What,Is}
+ end;
+dig_out(_, _) -> no.
+
+dig_out_block([{set,[{x,0}],[{atom,if_clause}],move}]) ->
+ {yes,if_end,[]};
+dig_out_block([{set,[{x,0}],[{literal,{Exc,Value}}],move}|Is]) ->
+ translate_exception(Exc, {literal,Value}, Is, 0);
+dig_out_block([{set,[{x,0}],[Tuple],move},
+ {set,[],[Value],put},
+ {set,[],[{atom,Exc}],put},
+ {set,[Tuple],[],{put_tuple,2}}|Is]) ->
+ translate_exception(Exc, Value, Is, 3);
+dig_out_block([{set,[],[Value],put},
+ {set,[],[{atom,Exc}],put},
+ {set,[{x,0}],[],{put_tuple,2}}|Is]) ->
+ translate_exception(Exc, Value, Is, 3);
+dig_out_block(_) -> no.
+
+translate_exception(badmatch, Val, Is, Words) ->
+ {yes,{badmatch,Val},fix_block(Is, Words)};
+translate_exception(case_clause, Val, Is, Words) ->
+ {yes,{case_end,Val},fix_block(Is, Words)};
+translate_exception(try_clause, Val, Is, Words) ->
+ {yes,{try_case_end,Val},fix_block(Is, Words)};
+translate_exception(_, _, _, _) -> no.
+
+fix_block(Is, 0) ->
+ reverse(Is);
+fix_block(Is0, Words) ->
+ [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is] = reverse(Is0),
+ [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is].
+
+dig_out_block_fc([{set,[],[],{alloc,Live,_}}|Bl]) ->
+ dig_out_fc(Bl, Live-1, nil);
+dig_out_block_fc(_) -> no.
+
+dig_out_fc([{set,[Dst],[{x,Reg},Dst0],put_list}|Is], Reg, Dst0) ->
+ dig_out_fc(Is, Reg-1, Dst);
+dig_out_fc([{set,[{x,0}],[{atom,function_clause}],move}], -1, {x,1}) ->
+ {yes,function_clause};
+dig_out_fc(_, _, _) -> no.
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index a631b8cd69..116ede0bc9 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -474,8 +474,15 @@ check_liveness(R, [{make_fun2,_,_,_,NumFree}|Is], St) ->
end;
check_liveness(R, [{try_end,Y}|Is], St) ->
case R of
- Y -> {killed,St};
- _ -> check_liveness(R, Is, St)
+ Y ->
+ {killed,St};
+ {y,_} ->
+ %% y registers will be used if an exception occurs and
+ %% control transfers to the label given in the previous
+ %% try/2 instruction.
+ {used,St};
+ _ ->
+ check_liveness(R, Is, St)
end;
check_liveness(R, [{catch_end,Y}|Is], St) ->
case R of
diff --git a/lib/compiler/src/cerl_inline.erl b/lib/compiler/src/cerl_inline.erl
index c15103999f..589685d72d 100644
--- a/lib/compiler/src/cerl_inline.erl
+++ b/lib/compiler/src/cerl_inline.erl
@@ -1262,8 +1262,9 @@ i_receive_1(E, Cs, T, B, S) ->
i_module(E, Ctxt, Ren, Env, S) ->
%% Cf. `i_letrec'. Note that we pass a dummy constant value for the
%% "body" parameter.
+ Exps = i_module_exports(E),
{Es, _, Xs1, S1} = i_letrec(module_defs(E), void(),
- module_exports(E), Ctxt, Ren, Env, S),
+ Exps, Ctxt, Ren, Env, S),
%% Sanity check:
case Es of
[] ->
@@ -1276,6 +1277,27 @@ i_module(E, Ctxt, Ren, Env, S) ->
E1 = update_c_module(E, module_name(E), Xs1, module_attrs(E), Es),
{E1, count_size(weight(module), S1)}.
+i_module_exports(E) ->
+ %% If a function is named in an `on_load' attribute, we will
+ %% pretend that it is exported to ensure that it will not be removed.
+ Exps = module_exports(E),
+ Attrs = module_attrs(E),
+ case i_module_on_load(Attrs) of
+ none ->
+ Exps;
+ [{_,_}=FA] ->
+ ordsets:add_element(c_var(FA), Exps)
+ end.
+
+i_module_on_load([{Key,Val}|T]) ->
+ case concrete(Key) of
+ on_load ->
+ concrete(Val);
+ _ ->
+ i_module_on_load(T)
+ end;
+i_module_on_load([]) -> none.
+
%% Binary-syntax expressions are too complicated to do anything
%% interesting with here - that is beyond the scope of this program;
%% also, their construction could have side effects, so even in effect
diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index a17a10046e..9b505ad15c 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -629,6 +629,8 @@ asm_passes() ->
[{unless,no_postopt,
[{pass,beam_block},
{iff,dblk,{listing,"block"}},
+ {unless,no_except,{pass,beam_except}},
+ {iff,dexcept,{listing,"except"}},
{unless,no_bopt,{pass,beam_bool}},
{iff,dbool,{listing,"bool"}},
{unless,no_topt,{pass,beam_type}},
diff --git a/lib/compiler/src/compiler.app.src b/lib/compiler/src/compiler.app.src
index fb06f2521c..1133882728 100644
--- a/lib/compiler/src/compiler.app.src
+++ b/lib/compiler/src/compiler.app.src
@@ -28,6 +28,7 @@
beam_dead,
beam_dict,
beam_disasm,
+ beam_except,
beam_flatten,
beam_jump,
beam_listing,
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 6ea67741fa..4e67639805 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -150,14 +150,26 @@ guard(Expr, Sub) ->
opt_guard_try(#c_seq{arg=Arg,body=Body0}=Seq) ->
Body = opt_guard_try(Body0),
case {Arg,Body} of
- {#c_call{},#c_literal{val=false}} ->
- %% We have sequence consisting of a call (evaluted
- %% for a possible exception only), followed by 'false'.
- %% Since the sequence is inside a try block that will
+ {#c_call{module=#c_literal{val=Mod},
+ name=#c_literal{val=Name},
+ args=Args},#c_literal{val=false}} ->
+ %% We have sequence consisting of a call (evaluated
+ %% for a possible exception and/or side effect only),
+ %% followed by 'false'.
+ %% Since the sequence is inside a try block that will
%% default to 'false' if any exception occurs, not
%% evalutating the call will not change the behaviour
- %% of the guard.
- Body;
+ %% provided that the call has no side effects.
+ case erl_bifs:is_pure(Mod, Name, length(Args)) of
+ false ->
+ %% Not a pure BIF (meaning that this is not
+ %% a guard and that we must keep the call).
+ Seq#c_seq{body=Body};
+ true ->
+ %% The BIF has no side effects, so it can
+ %% be safely removed.
+ Body
+ end;
{_,_} ->
Seq#c_seq{body=Body}
end;
@@ -1747,36 +1759,26 @@ opt_bool_clauses([_|_], _, _) ->
%% end. NewVar ->
%% erlang:error(badarg)
%% end.
-%%
-%% We add the extra match-all clause at the end only if Expr is
-%% not guaranteed to evaluate to a boolean.
opt_bool_not(#c_case{arg=Arg,clauses=Cs0}=Case0) ->
case Arg of
#c_call{anno=Anno,module=#c_literal{val=erlang},
name=#c_literal{val='not'},
args=[Expr]} ->
- Cs = opt_bool_not(Anno, Expr, Cs0),
+ Cs = [opt_bool_not_invert(C) || C <- Cs0] ++
+ [#c_clause{anno=[compiler_generated],
+ pats=[#c_var{name=cor_variable}],
+ guard=#c_literal{val=true},
+ body=#c_call{anno=Anno,
+ module=#c_literal{val=erlang},
+ name=#c_literal{val=error},
+ args=[#c_literal{val=badarg}]}}],
Case = Case0#c_case{arg=Expr,clauses=Cs},
opt_bool_not(Case);
_ ->
opt_bool_case_redundant(Case0)
end.
-opt_bool_not(Anno, Expr, Cs) ->
- Tail = case is_bool_expr(Expr) of
- false ->
- [#c_clause{anno=[compiler_generated],
- pats=[#c_var{name=cor_variable}],
- guard=#c_literal{val=true},
- body=#c_call{anno=Anno,
- module=#c_literal{val=erlang},
- name=#c_literal{val=error},
- args=[#c_literal{val=badarg}]}}];
- true -> []
- end,
- [opt_bool_not_invert(C) || C <- Cs] ++ Tail.
-
opt_bool_not_invert(#c_clause{pats=[#c_literal{val=Bool}]}=C) ->
C#c_clause{pats=[#c_literal{val=not Bool}]}.
@@ -2065,32 +2067,7 @@ opt_case_in_let_2(V, Arg0,
(_) -> false end, Es), %Only variables in tuple
false = core_lib:is_var_used(V, B), %Built tuple must not be used.
Arg1 = tuple_to_values(Arg0, length(Es)), %Might fail.
- #c_let{vars=Es,arg=Arg1,body=B};
-opt_case_in_let_2(_, Arg, Cs) ->
- %% simplify_bool_case(Case0) -> Case
- %% Remove unecessary cases like
- %%
- %% case BoolExpr of
- %% true -> true;
- %% false -> false;
- %% ....
- %% end
- %%
- %% where BoolExpr is an expression that can only return true
- %% or false (or throw an exception).
-
- true = is_bool_case(Cs) andalso is_bool_expr(Arg),
- Arg.
-
-is_bool_case([A,B|_]) ->
- (is_bool_clause(true, A) andalso is_bool_clause(false, B))
- orelse (is_bool_clause(false, A) andalso is_bool_clause(true, B)).
-
-is_bool_clause(Bool, #c_clause{pats=[#c_literal{val=Bool}],
- guard=#c_literal{val=true},
- body=#c_literal{val=Bool}}) ->
- true;
-is_bool_clause(_, _) -> false.
+ #c_let{vars=Es,arg=Arg1,body=B}.
%% is_simple_case_arg(Expr) -> true|false
%% Determine whether the Expr is simple enough to be worth
@@ -2612,14 +2589,14 @@ bsm_maybe_ctx_to_binary(V, B) ->
body=B}
end.
-previous_ctx_to_binary(V, #c_seq{arg=#c_primop{name=Name,args=As}}) ->
- case {Name,As} of
- {#c_literal{val=bs_context_to_binary},[#c_var{name=V}]} ->
+previous_ctx_to_binary(V, Core) ->
+ case Core of
+ #c_seq{arg=#c_primop{name=#c_literal{val=bs_context_to_binary},
+ args=[#c_var{name=V}]}} ->
true;
- {_,_} ->
+ _ ->
false
- end;
-previous_ctx_to_binary(_, _) -> false.
+ end.
%% bsm_leftmost(Cs) -> none | ArgumentNumber
%% Find the leftmost argument that does binary matching. Return
@@ -2641,9 +2618,9 @@ bsm_leftmost_2([_|Ps], Cs, N, Pos) ->
bsm_leftmost_2([], Cs, _, Pos) ->
bsm_leftmost_1(Cs, Pos).
-%% bsm_notempty(Cs, Pos) -> true|false
+%% bsm_nonempty(Cs, Pos) -> true|false
%% Check if at least one of the clauses matches a non-empty
-%% binary in the given argumet position.
+%% binary in the given argument position.
%%
bsm_nonempty([#c_clause{pats=Ps}|Cs], Pos) ->
case nth(Pos, Ps) of
@@ -2704,7 +2681,7 @@ bsm_ensure_no_partition_2([P|_], 1, _, Vstate, State) ->
%%
%% But if the clauses can't be freely rearranged, as in
%%
- %% b(Var, <<>>) -> ...
+ %% b(Var, <<X>>) -> ...
%% b(1, 2) -> ...
%%
%% we do have a problem.
@@ -2764,22 +2741,20 @@ add_bin_opt_info(Core, Term) ->
end.
add_warning(Core, Term) ->
- Anno = core_lib:get_anno(Core),
- case lists:member(compiler_generated, Anno) of
- true -> ok;
+ case is_compiler_generated(Core) of
+ true ->
+ ok;
false ->
- case get_line(Anno) of
- Line when Line >= 0 -> %Must be positive.
- File = get_file(Anno),
- Key = {?MODULE,warnings},
- case get(Key) of
- [{File,[{Line,?MODULE,Term}]}|_] ->
- ok; %We already have
+ Anno = core_lib:get_anno(Core),
+ Line = get_line(Anno),
+ File = get_file(Anno),
+ Key = {?MODULE,warnings},
+ case get(Key) of
+ [{File,[{Line,?MODULE,Term}]}|_] ->
+ ok; %We already have
%an identical warning.
- Ws ->
- put(Key, [{File,[{Line,?MODULE,Term}]}|Ws])
- end;
- _ -> ok %Compiler-generated code.
+ Ws ->
+ put(Key, [{File,[{Line,?MODULE,Term}]}|Ws])
end
end.
@@ -2793,14 +2768,7 @@ get_file([]) -> "no_file". % should not happen
is_compiler_generated(Core) ->
Anno = core_lib:get_anno(Core),
- case lists:member(compiler_generated, Anno) of
- true -> true;
- false ->
- case get_line(Anno) of
- Line when Line >= 0 -> false;
- _ -> true
- end
- end.
+ member(compiler_generated, Anno).
get_warnings() ->
ordsets:from_list((erase({?MODULE,warnings}))).
diff --git a/lib/compiler/src/v3_codegen.erl b/lib/compiler/src/v3_codegen.erl
index e7dae67085..36d35a8122 100644
--- a/lib/compiler/src/v3_codegen.erl
+++ b/lib/compiler/src/v3_codegen.erl
@@ -53,7 +53,6 @@
%% Main codegen structure.
-record(cg, {lcount=1, %Label counter
- finfo, %Function info label
bfail, %Fail label for BIFs
break, %Break label
recv, %Receive label
@@ -126,7 +125,6 @@ cg_fun(Les, Hvs, Vdb, AtomMod, NameArity, Anno, St0) ->
stk=[]}, 0, Vdb),
{B,_Aft,St} = cg_list(Les, 0, Vdb, Bef,
St3#cg{bfail=0,
- finfo=Fi,
ultimate_failure=UltimateMatchFail,
is_top_block=true}),
{Name,Arity} = NameArity,
@@ -147,8 +145,6 @@ cg({match,M,Rs}, Le, Vdb, Bef, St) ->
match_cg(M, Rs, Le, Vdb, Bef, St);
cg({guard_match,M,Rs}, Le, Vdb, Bef, St) ->
guard_match_cg(M, Rs, Le, Vdb, Bef, St);
-cg({match_fail,F}, Le, Vdb, Bef, St) ->
- match_fail_cg(F, Le, Vdb, Bef, St);
cg({call,Func,As,Rs}, Le, Vdb, Bef, St) ->
call_cg(Func, As, Rs, Le, Vdb, Bef, St);
cg({enter,Func,As}, Le, Vdb, Bef, St) ->
@@ -294,39 +290,6 @@ match_cg({block,Es}, Le, _Fail, Bef, St) ->
Int = clear_dead(Bef, Le#l.i, Le#l.vdb),
block_cg(Es, Le, Int, St).
-%% match_fail_cg(FailReason, Le, Vdb, StackReg, State) ->
-%% {[Ainstr],StackReg,State}.
-%% Generate code for the match_fail "call". N.B. there is no generic
-%% case for when the fail value has been created elsewhere.
-
-match_fail_cg({function_clause,As}, Le, Vdb, Bef, St) ->
- %% Must have the args in {x,0}, {x,1},...
- {Sis,Int} = cg_setup_call(As, Bef, Le#l.i, Vdb),
- {Sis ++ [{jump,{f,St#cg.finfo}}],
- Int#sr{reg=clear_regs(Int#sr.reg)},St};
-match_fail_cg({badmatch,Term}, Le, Vdb, Bef, St) ->
- R = cg_reg_arg(Term, Bef),
- Int0 = clear_dead(Bef, Le#l.i, Vdb),
- {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb),
- {Sis ++ [line(Le),{badmatch,R}],
- Int#sr{reg=clear_regs(Int0#sr.reg)},St};
-match_fail_cg({case_clause,Reason}, Le, Vdb, Bef, St) ->
- R = cg_reg_arg(Reason, Bef),
- Int0 = clear_dead(Bef, Le#l.i, Vdb),
- {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb),
- {Sis++[line(Le),{case_end,R}],
- Int#sr{reg=clear_regs(Bef#sr.reg)},St};
-match_fail_cg(if_clause, Le, Vdb, Bef, St) ->
- Int0 = clear_dead(Bef, Le#l.i, Vdb),
- {Sis,Int1} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb),
- {Sis++[line(Le),if_end],Int1#sr{reg=clear_regs(Int1#sr.reg)},St};
-match_fail_cg({try_clause,Reason}, Le, Vdb, Bef, St) ->
- R = cg_reg_arg(Reason, Bef),
- Int0 = clear_dead(Bef, Le#l.i, Vdb),
- {Sis,Int} = adjust_stack(Int0, Le#l.i, Le#l.i+1, Vdb),
- {Sis ++ [line(Le),{try_case_end,R}],
- Int#sr{reg=clear_regs(Int0#sr.reg)},St}.
-
%% bsm_rename_ctx([Clause], Var) -> [Clause]
%% We know from an annotation that the register for a binary can
%% be reused for the match context because the two are not truly
@@ -1460,20 +1423,7 @@ set_cg([{var,R}], Con, Le, Vdb, Bef, St) ->
Other ->
[{move,Other,Ret}]
end,
- {Ais,clear_dead(Int, Le#l.i, Vdb),St};
-set_cg([], {binary,Segs}, Le, Vdb, Bef, St) ->
- Fail = {f,St#cg.bfail},
- Target = find_scratch_reg(Bef#sr.reg),
- Temp = find_scratch_reg(put_reg(Target, Bef#sr.reg)),
- PutCode = cg_bin_put(Segs, Fail, Bef),
- MaxRegs = max_reg(Bef#sr.reg),
- Code = cg_binary(PutCode, Target, Temp, Fail, MaxRegs, Le#l.a),
- Aft = clear_dead(Bef, Le#l.i, Vdb),
- {Code,Aft,St};
-set_cg([], _, Le, Vdb, Bef, St) ->
- %% This should have been stripped by compiler, just cleanup.
- {[],clear_dead(Bef, Le#l.i, Vdb), St}.
-
+ {Ais,clear_dead(Int, Le#l.i, Vdb),St}.
%%%
%%% Code generation for constructing binaries.
@@ -2104,7 +2054,7 @@ line_1(_, 0) ->
%% Missing line number or line number 0.
{line,[]};
line_1(Name, Line) ->
- {line,[{location,Name,abs(Line)}]}.
+ {line,[{location,Name,Line}]}.
find_loc([Line|T], File, _) when is_integer(Line) ->
find_loc(T, File, Line);
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 6885405ae0..ad0a8a7654 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -2085,7 +2085,12 @@ bitstr_vars(Segs, Vs) ->
lineno_anno(L, St) ->
{line, Line} = erl_parse:get_attribute(L, line),
- [Line] ++ St#core.file.
+ if
+ Line < 0 ->
+ [-Line] ++ St#core.file ++ [compiler_generated];
+ true ->
+ [Line] ++ St#core.file
+ end.
get_ianno(Ce) ->
case get_anno(Ce) of
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index d76291f57f..abe94ad991 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -83,12 +83,11 @@
-import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,splitwith/2,member/2,
keymember/3,keyfind/3]).
-import(ordsets, [add_element/2,del_element/2,union/2,union/1,subtract/2]).
+-import(cerl, [c_tuple/1]).
-include("core_parse.hrl").
-include("v3_kernel.hrl").
--define(EXPENSIVE_BINARY_LIMIT, 256).
-
%% These are not defined in v3_kernel.hrl.
get_kanno(Kthing) -> element(2, Kthing).
set_kanno(Kthing, Anno) -> setelement(2, Kthing, Anno).
@@ -119,7 +118,6 @@ copy_anno(Kdst, Ksrc) ->
funs=[], %Fun functions
free=[], %Free variables
ws=[] :: [warning()], %Warnings.
- lit, %Constant pool for literals.
guard_refc=0}). %> 0 means in guard
-spec module(cerl:c_module(), [compile:option()]) ->
@@ -128,7 +126,7 @@ copy_anno(Kdst, Ksrc) ->
module(#c_module{anno=A,name=M,exports=Es,attrs=As,defs=Fs}, _Options) ->
Kas = attributes(As),
Kes = map(fun (#c_var{name={_,_}=Fname}) -> Fname end, Es),
- St0 = #kern{lit=dict:new()},
+ St0 = #kern{},
{Kfs,St} = mapfoldl(fun function/2, St0, Fs),
{ok,#k_mdef{anno=A,name=M#c_literal.val,exports=Kes,attributes=Kas,
body=Kfs ++ St#kern.funs},lists:sort(St#kern.ws)}.
@@ -249,26 +247,20 @@ expr(#c_var{anno=A,name={_Name,Arity}}=Fname, Sub, St) ->
expr(Fun, Sub, St);
expr(#c_var{anno=A,name=V}, Sub, St) ->
{#k_var{anno=A,name=get_vsub(V, Sub)},[],St};
-expr(#c_literal{}=Lit, Sub, St) ->
- Core = handle_literal(Lit),
- expr(Core, Sub, St);
-expr(#k_literal{val=Val0}=Klit, _Sub, #kern{lit=Literals0}=St) ->
- %% Share identical literals to save some space and time during compilation.
- case dict:find(Val0, Literals0) of
- {ok,Val} ->
- {Klit#k_literal{val=Val},[],St};
- error ->
- Literals = dict:store(Val0, Val0, Literals0),
- {Klit,[],St#kern{lit=Literals}}
- end;
-expr(#k_nil{}=V, _Sub, St) ->
- {V,[],St};
-expr(#k_int{}=V, _Sub, St) ->
- {V,[],St};
-expr(#k_float{}=V, _Sub, St) ->
- {V,[],St};
-expr(#k_atom{}=V, _Sub, St) ->
- {V,[],St};
+expr(#c_literal{anno=A,val=V}, _Sub, St) ->
+ Klit = case V of
+ [] ->
+ #k_nil{anno=A};
+ V when is_integer(V) ->
+ #k_int{anno=A,val=V};
+ V when is_float(V) ->
+ #k_float{anno=A,val=V};
+ V when is_atom(V) ->
+ #k_atom{anno=A,val=V};
+ _ ->
+ #k_literal{anno=A,val=V}
+ end,
+ {Klit,[],St};
expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) ->
%% Do cons in two steps, first the expressions left to right, then
%% any remaining literals right to left.
@@ -422,10 +414,11 @@ expr(#c_call{anno=A,module=M0,name=F0,args=Cargs}, Sub, St0) ->
end;
expr(#c_primop{anno=A,name=#c_literal{val=match_fail},args=Cargs0}, Sub, St0) ->
Cargs = translate_match_fail(Cargs0, Sub, A, St0),
- %% This special case will disappear.
{Kargs,Ap,St} = atomic_list(Cargs, Sub, St0),
Ar = length(Cargs),
- Call = #k_call{anno=A,op=#k_internal{name=match_fail,arity=Ar},args=Kargs},
+ Call = #k_call{anno=A,op=#k_remote{mod=#k_atom{val=erlang},
+ name=#k_atom{val=error},
+ arity=Ar},args=Kargs},
{Call,Ap,St};
expr(#c_primop{anno=A,name=#c_literal{val=N},args=Cargs}, Sub, St0) ->
{Kargs,Ap,St1} = atomic_list(Cargs, Sub, St0),
@@ -455,14 +448,14 @@ expr(#ireceive_accept{anno=A}, _Sub, St) -> {#k_receive_accept{anno=A},[],St}.
translate_match_fail(Args, Sub, Anno, St) ->
case Args of
[#c_tuple{es=[#c_literal{val=function_clause}|As]}] ->
- translate_match_fail_1(Anno, Args, As, Sub, St);
+ translate_match_fail_1(Anno, As, Sub, St);
[#c_literal{val=Tuple}] when is_tuple(Tuple) ->
%% The inliner may have created a literal out of
%% the original #c_tuple{}.
case tuple_to_list(Tuple) of
[function_clause|As0] ->
As = [#c_literal{val=E} || E <- As0],
- translate_match_fail_1(Anno, Args, As, Sub, St);
+ translate_match_fail_1(Anno, As, Sub, St);
_ ->
Args
end;
@@ -471,7 +464,7 @@ translate_match_fail(Args, Sub, Anno, St) ->
Args
end.
-translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) ->
+translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) ->
AnnoFunc = case keyfind(function_name, 1, Anno) of
false ->
none; %Force rewrite.
@@ -481,10 +474,10 @@ translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) ->
case {AnnoFunc,FF} of
{Same,Same} ->
%% Still in the correct function.
- Args;
+ translate_fc(As);
{{F,_},F} ->
%% Still in the correct function.
- Args;
+ translate_fc(As);
_ ->
%% Wrong function or no function_name annotation.
%%
@@ -493,9 +486,12 @@ translate_match_fail_1(Anno, Args, As, Sub, #kern{ff=FF}) ->
%% the current function). match_fail(function_clause) will
%% only work at the top level of the function it was originally
%% defined in, so we will need to rewrite it to a case_clause.
- [#c_tuple{es=[#c_literal{val=case_clause},#c_tuple{es=As}]}]
+ [c_tuple([#c_literal{val=case_clause},c_tuple(As)])]
end.
+translate_fc(Args) ->
+ [#c_literal{val=function_clause},make_list(Args)].
+
%% call_type(Module, Function, Arity) -> call | bif | apply | error.
%% Classify the call.
call_type(#c_literal{val=M}, #c_literal{val=F}, Ar) when is_atom(M), is_atom(F) ->
@@ -605,7 +601,6 @@ is_atomic(#k_int{}) -> true;
is_atomic(#k_float{}) -> true;
is_atomic(#k_atom{}) -> true;
%%is_atomic(#k_char{}) -> true; %No characters
-%%is_atomic(#k_string{}) -> true;
is_atomic(#k_nil{}) -> true;
is_atomic(#k_var{}) -> true;
is_atomic(_) -> false.
@@ -914,9 +909,8 @@ match_guard_1([#iclause{anno=A,osub=Osub,guard=G,body=B}|Cs0], Def0, St0) ->
true ->
%% The true clause body becomes the default.
{Kb,Pb,St1} = body(B, Osub, St0),
- Line = get_line(A),
- St2 = maybe_add_warning(Cs0, Line, St1),
- St = maybe_add_warning(Def0, Line, St2),
+ St2 = maybe_add_warning(Cs0, A, St1),
+ St = maybe_add_warning(Def0, A, St2),
{[],pre_seq(Pb, Kb),St};
false ->
{Kg,St1} = guard(G, Osub, St0),
@@ -927,15 +921,18 @@ match_guard_1([#iclause{anno=A,osub=Osub,guard=G,body=B}|Cs0], Def0, St0) ->
end;
match_guard_1([], Def, St) -> {[],Def,St}.
-maybe_add_warning([C|_], Line, St) ->
- maybe_add_warning(C, Line, St);
-maybe_add_warning([], _Line, St) -> St;
-maybe_add_warning(fail, _Line, St) -> St;
-maybe_add_warning(Ke, MatchLine, St) ->
- case get_kanno(Ke) of
- [compiler_generated|_] -> St;
- Anno ->
+maybe_add_warning([C|_], MatchAnno, St) ->
+ maybe_add_warning(C, MatchAnno, St);
+maybe_add_warning([], _MatchAnno, St) -> St;
+maybe_add_warning(fail, _MatchAnno, St) -> St;
+maybe_add_warning(Ke, MatchAnno, St) ->
+ case is_compiler_generated(Ke) of
+ true ->
+ St;
+ false ->
+ Anno = get_kanno(Ke),
Line = get_line(Anno),
+ MatchLine = get_line(MatchAnno),
Warn = case MatchLine of
none -> nomatch_shadow;
_ -> {nomatch_shadow,MatchLine}
@@ -1117,7 +1114,6 @@ select_bin_int([#iclause{pats=[#k_bin_seg{anno=A,type=integer,
end,
select_assert_match_possible(Bits, Val, Fl),
P = #k_bin_int{anno=A,size=Sz,unit=U,flags=Fl,val=Val,next=N},
- select_assert_match_possible(Bits, Val, Fl),
case member(native, Fl) of
true -> throw(not_possible);
false -> ok
@@ -1259,8 +1255,6 @@ match_clause([U|Us], [C|_]=Cs0, Def, St0) ->
sub_size_var(#k_bin_seg{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{isub=Sub}|_]) ->
BinSeg#k_bin_seg{size=Kvar#k_var{name=get_vsub(Name, Sub)}};
-sub_size_var(#k_bin_int{size=#k_var{name=Name}=Kvar}=BinSeg, [#iclause{isub=Sub}|_]) ->
- BinSeg#k_bin_int{size=Kvar#k_var{name=get_vsub(Name, Sub)}};
sub_size_var(K, _) -> K.
get_con([C|_]) -> arg_arg(clause_arg(C)). %Get the constructor
@@ -1378,7 +1372,6 @@ arg_con(Arg) ->
#k_tuple{} -> k_tuple;
#k_binary{} -> k_binary;
#k_bin_end{} -> k_bin_end;
- #k_bin_int{} -> k_bin_int;
#k_bin_seg{} -> k_bin_seg;
#k_var{} -> k_var
end.
@@ -1389,15 +1382,9 @@ arg_val(Arg) ->
#k_int{val=I} -> I;
#k_float{val=F} -> F;
#k_atom{val=A} -> A;
- #k_nil{} -> 0;
- #k_cons{} -> 2;
#k_tuple{es=Es} -> length(Es);
#k_bin_seg{size=S,unit=U,type=T,flags=Fs} ->
- {set_kanno(S, []),U,T,Fs};
- #k_bin_int{} ->
- 0;
- #k_bin_end{} -> 0;
- #k_binary{} -> 0
+ {set_kanno(S, []),U,T,Fs}
end.
%% ubody_used_vars(Expr, State) -> [UsedVar]
@@ -1427,14 +1414,12 @@ ubody(#ivalues{anno=A,args=As}, return, St) ->
{#k_return{anno=#k{us=Au,ns=[],a=A},args=As},Au,St};
ubody(#ivalues{anno=A,args=As}, {break,_Vbs}, St) ->
Au = lit_list_vars(As),
- if St#kern.guard_refc > 0 ->
+ case is_in_guard(St) of
+ true ->
{#k_guard_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St};
- true ->
+ false ->
{#k_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St}
end;
-ubody(#ivalues{anno=A,args=As}, {guard_break,_Vbs}, St) ->
- Au = lit_list_vars(As),
- {#k_guard_break{anno=#k{us=Au,ns=[],a=A},args=As},Au,St};
ubody(E, return, St0) ->
%% Enterable expressions need no trailing return.
case is_enter_expr(E) of
@@ -1451,12 +1436,7 @@ ubody(E, {break,_Rs} = Break, St0) ->
false ->
{Ea,Pa,St1} = force_atomic(E, St0),
ubody(pre_seq(Pa, #ivalues{args=[Ea]}), Break, St1)
- end;
-ubody(E, {guard_break,_Rs} = GuardBreak, St0) ->
- %%ok = io:fwrite("ubody ~w:~p~n", [?LINE,{E,Br}]),
- %% Exiting expressions need no trailing break.
- {Ea,Pa,St1} = force_atomic(E, St0),
- ubody(pre_seq(Pa, #ivalues{args=[Ea]}), GuardBreak, St1).
+ end.
iletrec_funs(#iletrec{defs=Fs}, St0) ->
%% Use union of all free variables.
@@ -1494,7 +1474,6 @@ iletrec_funs_gen(Fs, FreeVs, St) ->
%% is_exit_expr(Kexpr) -> boolean().
%% Test whether Kexpr always exits and never returns.
-is_exit_expr(#k_call{op=#k_internal{name=match_fail,arity=1}}) -> true;
is_exit_expr(#k_receive_next{}) -> true;
is_exit_expr(_) -> false.
@@ -1509,64 +1488,21 @@ is_enter_expr(#k_receive{}) -> true;
is_enter_expr(#k_receive_next{}) -> true;
is_enter_expr(_) -> false.
-%% uguard(Expr, State) -> {Expr,[UsedVar],State}.
-%% Tag the guard sequence with its used variables.
-
-uguard(#k_try{anno=A,arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X},
- handler=#k_atom{val=false}}=Try, St0) ->
- {B1,Bu,St1} = uguard(B0, St0),
- {Try#k_try{anno=#k{us=Bu,ns=[],a=A},arg=B1},Bu,St1};
-uguard(T, St) ->
- %%ok = io:fwrite("~w: ~p~n", [?LINE,T]),
- uguard_test(T, St).
-
-%% uguard_test(Expr, State) -> {Test,[UsedVar],State}.
-%% At this stage tests are just expressions which don't return any
-%% values.
-
-uguard_test(T, St) -> uguard_expr(T, [], St).
+%% uexpr(Expr, Break, State) -> {Expr,[UsedVar],State}.
+%% Tag an expression with its used variables.
+%% Break = return | {break,[RetVar]}.
-uguard_expr(#iset{anno=A,vars=Vs,arg=E0,body=B0}, Rs, St0) ->
- Ns = lit_list_vars(Vs),
- {E1,Eu,St1} = uguard_expr(E0, Vs, St0),
- {B1,Bu,St2} = uguard_expr(B0, Rs, St1),
- Used = union(Eu, subtract(Bu, Ns)),
- {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2};
-uguard_expr(#k_try{anno=A,arg=B0,vars=[#k_var{name=X}],body=#k_var{name=X},
- handler=#k_atom{val=false}}=Try, Rs, St0) ->
- {B1,Bu,St1} = uguard_expr(B0, Rs, St0),
- {Try#k_try{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A},arg=B1,ret=Rs},
- Bu,St1};
-uguard_expr(#k_test{anno=A,op=Op,args=As}=Test, Rs, St) ->
+uexpr(#k_test{anno=A,op=Op,args=As}=Test, {break,Rs}, St) ->
[] = Rs, %Sanity check
Used = union(op_vars(Op), lit_list_vars(As)),
{Test#k_test{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A}},
Used,St};
-uguard_expr(#k_bif{anno=A,op=Op,args=As}=Bif, Rs, St) ->
- Used = union(op_vars(Op), lit_list_vars(As)),
- {Bif#k_bif{anno=#k{us=Used,ns=lit_list_vars(Rs),a=A},ret=Rs},
- Used,St};
-uguard_expr(#ivalues{anno=A,args=As}, Rs, St) ->
- Sets = foldr2(fun (V, Arg, Rhs) ->
- #iset{anno=A,vars=[V],arg=Arg,body=Rhs}
- end, #k_atom{val=true}, Rs, As),
- uguard_expr(Sets, [], St);
-uguard_expr(#k_match{anno=A,vars=Vs,body=B0}, Rs, St0) ->
- %% Experimental support for andalso/orelse in guards.
- Br = {guard_break,Rs},
- {B1,Bu,St1} = umatch(B0, Br, St0),
- {#k_guard_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A},
- vars=Vs,body=B1,ret=Rs},Bu,St1};
-uguard_expr(Lit, Rs, St) ->
- %% Transform literals to puts here.
- Used = lit_vars(Lit),
- {#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)},
- arg=Lit,ret=Rs},Used,St}.
-
-%% uexpr(Expr, Break, State) -> {Expr,[UsedVar],State}.
-%% Tag an expression with its used variables.
-%% Break = return | {break,[RetVar]}.
-
+uexpr(#iset{anno=A,vars=Vs,arg=E0,body=B0}, {break,_}=Br, St0) ->
+ Ns = lit_list_vars(Vs),
+ {E1,Eu,St1} = uexpr(E0, {break,Vs}, St0),
+ {B1,Bu,St2} = uexpr(B0, Br, St1),
+ Used = union(Eu, subtract(Bu, Ns)),
+ {#k_seq{anno=#k{us=Used,ns=Ns,a=A},arg=E1,body=B1},Used,St2};
uexpr(#k_call{anno=A,op=#k_local{name=F,arity=Ar}=Op,args=As0}=Call, Br, St) ->
Free = get_free(F, Ar, St),
As1 = As0 ++ Free, %Add free variables LAST!
@@ -1598,10 +1534,11 @@ uexpr(#k_match{anno=A,vars=Vs0,body=B0}, Br, St0) ->
Vs = handle_reuse_annos(Vs0, St0),
Rs = break_rets(Br),
{B1,Bu,St1} = umatch(B0, Br, St0),
- if St0#kern.guard_refc > 0 ->
+ case is_in_guard(St1) of
+ true ->
{#k_guard_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A},
vars=Vs,body=B1,ret=Rs},Bu,St1};
- true ->
+ false ->
{#k_match{anno=#k{us=Bu,ns=lit_list_vars(Rs),a=A},
vars=Vs,body=B1,ret=Rs},Bu,St1}
end;
@@ -1618,24 +1555,27 @@ uexpr(#k_receive_accept{anno=A}, _, St) ->
{#k_receive_accept{anno=#k{us=[],ns=[],a=A}},[],St};
uexpr(#k_receive_next{anno=A}, _, St) ->
{#k_receive_next{anno=#k{us=[],ns=[],a=A}},[],St};
-uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0},
- {break,Rs0}, St0) ->
- {Avs,St1} = new_vars(length(Vs), St0), %Need dummy names here
- {A1,Au,St2} = ubody(A0, {break,Avs}, St1), %Must break to clean up here!
- {B1,Bu,St3} = ubody(B0, {break,Rs0}, St2),
- {H1,Hu,St4} = ubody(H0, {break,Rs0}, St3),
- %% Guarantee ONE return variable.
- NumNew = if
- Rs0 =:= [] -> 1;
- true -> 0
- end,
- {Ns,St5} = new_vars(NumNew, St4),
- Rs1 = Rs0 ++ Ns,
- Used = union([Au,subtract(Bu, lit_list_vars(Vs)),
- subtract(Hu, lit_list_vars(Evs))]),
- {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs1),a=A},
- arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs1},
- Used,St5};
+uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0}=Try,
+ {break,Rs0}=Br, St0) ->
+ case is_in_guard(St0) of
+ true ->
+ {[#k_var{name=X}],#k_var{name=X}} = {Vs,B0}, %Assertion.
+ #k_atom{val=false} = H0, %Assertion.
+ {A1,Bu,St1} = uexpr(A0, Br, St0),
+ {Try#k_try{anno=#k{us=Bu,ns=lit_list_vars(Rs0),a=A},
+ arg=A1,ret=Rs0},Bu,St1};
+ false ->
+ {Avs,St1} = new_vars(length(Vs), St0),
+ {A1,Au,St2} = ubody(A0, {break,Avs}, St1),
+ {B1,Bu,St3} = ubody(B0, Br, St2),
+ {H1,Hu,St4} = ubody(H0, Br, St3),
+ {Rs1,St5} = ensure_return_vars(Rs0, St4),
+ Used = union([Au,subtract(Bu, lit_list_vars(Vs)),
+ subtract(Hu, lit_list_vars(Evs))]),
+ {#k_try{anno=#k{us=Used,ns=lit_list_vars(Rs1),a=A},
+ arg=A1,vars=Vs,body=B1,evars=Evs,handler=H1,ret=Rs1},
+ Used,St5}
+ end;
uexpr(#k_try{anno=A,arg=A0,vars=Vs,body=B0,evars=Evs,handler=H0},
return, St0) ->
{Avs,St1} = new_vars(length(Vs), St0), %Need dummy names here
@@ -1681,12 +1621,13 @@ uexpr(#ifun{anno=A,vars=Vs,body=B0}, {break,Rs}, St0) ->
#k_int{val=Index},#k_int{val=Uniq}|Fvs],
ret=Rs},
Free,add_local_function(Fun, St)};
-uexpr(Lit, {break,Rs}, St) ->
+uexpr(Lit, {break,Rs0}, St0) ->
%% Transform literals to puts here.
%%ok = io:fwrite("uexpr ~w:~p~n", [?LINE,Lit]),
Used = lit_vars(Lit),
+ {Rs,St1} = ensure_return_vars(Rs0, St0),
{#k_put{anno=#k{us=Used,ns=lit_list_vars(Rs),a=get_kanno(Lit)},
- arg=Lit,ret=Rs},Used,St}.
+ arg=Lit,ret=Rs},Used,St1}.
add_local_function(_, #kern{funs=ignore}=St) -> St;
add_local_function(F, #kern{funs=Funs}=St) -> St#kern{funs=[F|Funs]}.
@@ -1743,6 +1684,11 @@ bif_returns(#k_internal{name=N,arity=Ar}, Rs, St0) ->
{Ns,St1} = new_vars(bif_vals(N, Ar) - length(Rs), St0),
{Rs ++ Ns,St1}.
+%% ensure_return_vars([Ret], State) -> {[Ret],State}.
+
+ensure_return_vars([], St) -> new_vars(1, St);
+ensure_return_vars([_]=Rs, St) -> {Rs,St}.
+
%% umatch(Match, Break, State) -> {Match,[UsedVar],State}.
%% Tag a match expression with its used variables.
@@ -1775,7 +1721,8 @@ umatch(#k_guard{anno=A,clauses=Gs0}, Br, St0) ->
{#k_guard{anno=#k{us=Gus,ns=[],a=A},clauses=Gs1},Gus,St1};
umatch(#k_guard_clause{anno=A,guard=G0,body=B0}, Br, St0) ->
%%ok = io:fwrite("~w: ~p~n", [?LINE,G0]),
- {G1,Gu,St1} = uguard(G0, St0#kern{guard_refc=St0#kern.guard_refc+1}),
+ {G1,Gu,St1} = uexpr(G0, {break,[]},
+ St0#kern{guard_refc=St0#kern.guard_refc+1}),
%%ok = io:fwrite("~w: ~p~n", [?LINE,G1]),
{B1,Bu,St2} = umatch(B0, Br, St1#kern{guard_refc=St1#kern.guard_refc-1}),
Used = union(Gu, Bu),
@@ -1823,7 +1770,6 @@ lit_list_vars(Ps) ->
pat_vars(#k_var{name=N}) -> {[],[N]};
%%pat_vars(#k_char{}) -> {[],[]};
-%%pat_vars(#k_string{}) -> {[],[]};
pat_vars(#k_literal{}) -> {[],[]};
pat_vars(#k_int{}) -> {[],[]};
pat_vars(#k_float{}) -> {[],[]};
@@ -1850,34 +1796,6 @@ pat_list_vars(Ps) ->
{union(Used0, Used),union(New0, New)} end,
{[],[]}, Ps).
-%% handle_literal(Literal, Anno) -> Kernel
-%% Examine the literal. Complex (heap-based) literals such as lists,
-%% tuples, and binaries should be kept as literals and put into the constant pool.
-%%
-%% (If necessary, this function could be extended to go through the literal
-%% and convert huge binary literals to bit syntax expressions. We don't do that
-%% because v3_core does not produce huge binary literals, and the optimizations in
-%% sys_core_fold don't do much optimizations of binaries. IF THAT CHANGE IS MADE,
-%% ALSO CHANGE sys_core_dsetel.)
-
-handle_literal(#c_literal{anno=A,val=V}) ->
- case V of
- [_|_] ->
- #k_literal{anno=A,val=V};
- [] ->
- #k_nil{anno=A};
- V when is_tuple(V) ->
- #k_literal{anno=A,val=V};
- V when is_bitstring(V) ->
- #k_literal{anno=A,val=V};
- V when is_integer(V) ->
- #k_int{anno=A,val=V};
- V when is_float(V) ->
- #k_float{anno=A,val=V};
- V when is_atom(V) ->
- #k_atom{anno=A,val=V}
- end.
-
make_list(Es) ->
foldr(fun(E, Acc) ->
#c_cons{hd=E,tl=Acc}
@@ -1889,6 +1807,11 @@ integers(N, M) when N =< M ->
[N|integers(N + 1, M)];
integers(_, _) -> [].
+%% is_in_guard(State) -> true|false.
+
+is_in_guard(#kern{guard_refc=Refc}) ->
+ Refc > 0.
+
%%%
%%% Handling of errors and warnings.
%%%
@@ -1909,7 +1832,10 @@ format_error(bad_call) ->
add_warning(none, Term, Anno, #kern{ws=Ws}=St) ->
File = get_file(Anno),
St#kern{ws=[{File,[{?MODULE,Term}]}|Ws]};
-add_warning(Line, Term, Anno, #kern{ws=Ws}=St) when Line >= 0 ->
+add_warning(Line, Term, Anno, #kern{ws=Ws}=St) ->
File = get_file(Anno),
- St#kern{ws=[{File,[{Line,?MODULE,Term}]}|Ws]};
-add_warning(_, _, _, St) -> St.
+ St#kern{ws=[{File,[{Line,?MODULE,Term}]}|Ws]}.
+
+is_compiler_generated(Ke) ->
+ Anno = get_kanno(Ke),
+ member(compiler_generated, Anno).
diff --git a/lib/compiler/src/v3_kernel.hrl b/lib/compiler/src/v3_kernel.hrl
index 37f2fdcf7e..17904c37da 100644
--- a/lib/compiler/src/v3_kernel.hrl
+++ b/lib/compiler/src/v3_kernel.hrl
@@ -35,7 +35,6 @@
-record(k_int, {anno=[],val}).
-record(k_float, {anno=[],val}).
-record(k_atom, {anno=[],val}).
--record(k_string, {anno=[],val}).
-record(k_nil, {anno=[]}).
-record(k_tuple, {anno=[],es}).
diff --git a/lib/compiler/src/v3_life.erl b/lib/compiler/src/v3_life.erl
index fac9a9843d..22f3e3c2d2 100644
--- a/lib/compiler/src/v3_life.erl
+++ b/lib/compiler/src/v3_life.erl
@@ -89,19 +89,8 @@ function(#k_fdef{anno=#k{a=Anno},func=F,arity=Ar,vars=Vs,body=Kb}) ->
end.
%% body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}.
-%% Handle a body, need special cases for transforming match_fails.
-%% We KNOW that they only occur last in a body.
-
-body(#k_seq{arg=#k_put{anno=Pa,arg=Arg,ret=[R]},
- body=#k_enter{anno=Ea,op=#k_internal{name=match_fail,arity=1},
- args=[R]}},
- I, Vdb0) ->
- Vdb1 = use_vars(Pa#k.us, I, Vdb0), %All used here
- {[match_fail(Arg, I, Pa#k.a ++ Ea#k.a)],I,Vdb1};
-body(#k_enter{anno=Ea,op=#k_internal{name=match_fail,arity=1},args=[Arg]},
- I, Vdb0) ->
- Vdb1 = use_vars(Ea#k.us, I, Vdb0),
- {[match_fail(Arg, I, Ea#k.a)],I,Vdb1};
+%% Handle a body.
+
body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) ->
%%ok = io:fwrite("life ~w:~p~n", [?LINE,{Ke,I,Vdb0}]),
A = get_kanno(Ke),
@@ -123,53 +112,14 @@ guard(#k_try{anno=A,arg=Ts,vars=[#k_var{name=X}],body=#k_var{name=X},
%% Lock variables that are alive before try and used afterwards.
%% Don't lock variables that are only used inside the try expression.
Pdb0 = vdb_sub(I, I+1, Vdb),
- {T,MaxI,Pdb1} = guard_body(Ts, I+1, Pdb0),
+ {T,MaxI,Pdb1} = body(Ts, I+1, Pdb0),
Pdb2 = use_vars(A#k.ns, MaxI+1, Pdb1), %Save "return" values
- #l{ke={protected,T,var_list(Rs)},i=I,a=A#k.a,vdb=Pdb2};
-guard(#k_seq{}=G, I, Vdb0) ->
- {Es,_,Vdb1} = guard_body(G, I, Vdb0),
- #l{ke={block,Es},i=I,vdb=Vdb1,a=[]};
-guard(G, I, Vdb) -> guard_expr(G, I, Vdb).
-
-%% guard_body(Kbody, I, Vdb) -> {[Expr],MaxI,Vdb}.
-
-guard_body(#k_seq{arg=Ke,body=Kb}, I, Vdb0) ->
- A = get_kanno(Ke),
- Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)),
- {Es,MaxI,Vdb2} = guard_body(Kb, I+1, Vdb1),
- E = guard_expr(Ke, I, Vdb2),
- {[E|Es],MaxI,Vdb2};
-guard_body(Ke, I, Vdb0) ->
- A = get_kanno(Ke),
- Vdb1 = use_vars(A#k.us, I, new_vars(A#k.ns, I, Vdb0)),
- E = guard_expr(Ke, I, Vdb1),
- {[E],I,Vdb1}.
-
-%% guard_expr(Call, I, Vdb) -> Expr
-
-guard_expr(#k_test{anno=A,op=Op,args=As}, I, _Vdb) ->
- #l{ke={test,test_op(Op),atomic_list(As)},i=I,a=A#k.a};
-guard_expr(#k_bif{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) ->
- Name = bif_op(Op),
- Ar = length(As),
- case is_gc_bif(Name, Ar) of
- false ->
- #l{ke={bif,Name,atomic_list(As),var_list(Rs)},i=I,a=A#k.a};
- true ->
- #l{ke={gc_bif,Name,atomic_list(As),var_list(Rs)},i=I,a=A#k.a}
- end;
-guard_expr(#k_put{anno=A,arg=Arg,ret=Rs}, I, _Vdb) ->
- #l{ke={set,var_list(Rs),literal(Arg, [])},i=I,a=A#k.a};
-guard_expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) ->
- %% Support for andalso/orelse in guards.
- %% Work out imported variables which need to be locked.
- Mdb = vdb_sub(I, I+1, Vdb),
- M = match(Kb, A#k.us, I+1, [], Mdb),
- #l{ke={guard_match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a};
-guard_expr(G, I, Vdb) -> guard(G, I, Vdb).
+ #l{ke={protected,T,var_list(Rs)},i=I,a=A#k.a,vdb=Pdb2}.
%% expr(Kexpr, I, Vdb) -> Expr.
+expr(#k_test{anno=A,op=Op,args=As}, I, _Vdb) ->
+ #l{ke={test,test_op(Op),atomic_list(As)},i=I,a=A#k.a};
expr(#k_call{anno=A,op=Op,args=As,ret=Rs}, I, _Vdb) ->
#l{ke={call,call_op(Op),atomic_list(As),var_list(Rs)},i=I,a=A#k.a};
expr(#k_enter{anno=A,op=Op,args=As}, I, _Vdb) ->
@@ -187,25 +137,11 @@ expr(#k_guard_match{anno=A,body=Kb,ret=Rs}, I, Vdb) ->
Mdb = vdb_sub(I, I+1, Vdb),
M = match(Kb, A#k.us, I+1, [], Mdb),
#l{ke={guard_match,M,var_list(Rs)},i=I,vdb=use_vars(A#k.us, I+1, Mdb),a=A#k.a};
-expr(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs}, I, Vdb) ->
- %% Lock variables that are alive before the catch and used afterwards.
- %% Don't lock variables that are only used inside the try.
- Tdb0 = vdb_sub(I, I+1, Vdb),
- %% This is the tricky bit. Lock variables in Arg that are used in
- %% the body and handler. Add try tag 'variable'.
- Ab = get_kanno(Kb),
- Ah = get_kanno(Kh),
- Tdb1 = use_vars(Ab#k.us, I+3, use_vars(Ah#k.us, I+3, Tdb0)),
- Tdb2 = vdb_sub(I, I+2, Tdb1),
- Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names
- {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)),
- {Bes,_,Bdb} = body(Kb, I+4, new_vars(map(Vnames, Vs), I+3, Tdb2)),
- {Hes,_,Hdb} = body(Kh, I+4, new_vars(map(Vnames, Evs), I+3, Tdb2)),
- #l{ke={'try',#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]},
- var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]},
- var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]},
- var_list(Rs)},
- i=I,vdb=Tdb1,a=A#k.a};
+expr(#k_try{}=Try, I, Vdb) ->
+ case is_in_guard() of
+ false -> body_try(Try, I, Vdb);
+ true -> guard(Try, I, Vdb)
+ end;
expr(#k_try_enter{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh}, I, Vdb) ->
%% Lock variables that are alive before the catch and used afterwards.
%% Don't lock variables that are only used inside the try.
@@ -254,6 +190,27 @@ expr(#k_guard_break{anno=A,args=As}, I, Vdb) ->
expr(#k_return{anno=A,args=As}, I, _Vdb) ->
#l{ke={return,atomic_list(As)},i=I,a=A#k.a}.
+body_try(#k_try{anno=A,arg=Ka,vars=Vs,body=Kb,evars=Evs,handler=Kh,ret=Rs},
+ I, Vdb) ->
+ %% Lock variables that are alive before the catch and used afterwards.
+ %% Don't lock variables that are only used inside the try.
+ Tdb0 = vdb_sub(I, I+1, Vdb),
+ %% This is the tricky bit. Lock variables in Arg that are used in
+ %% the body and handler. Add try tag 'variable'.
+ Ab = get_kanno(Kb),
+ Ah = get_kanno(Kh),
+ Tdb1 = use_vars(Ab#k.us, I+3, use_vars(Ah#k.us, I+3, Tdb0)),
+ Tdb2 = vdb_sub(I, I+2, Tdb1),
+ Vnames = fun (Kvar) -> Kvar#k_var.name end, %Get the variable names
+ {Aes,_,Adb} = body(Ka, I+2, add_var({catch_tag,I+1}, I+1, locked, Tdb2)),
+ {Bes,_,Bdb} = body(Kb, I+4, new_vars(map(Vnames, Vs), I+3, Tdb2)),
+ {Hes,_,Hdb} = body(Kh, I+4, new_vars(map(Vnames, Evs), I+3, Tdb2)),
+ #l{ke={'try',#l{ke={block,Aes},i=I+1,vdb=Adb,a=[]},
+ var_list(Vs),#l{ke={block,Bes},i=I+3,vdb=Bdb,a=[]},
+ var_list(Evs),#l{ke={block,Hes},i=I+3,vdb=Hdb,a=[]},
+ var_list(Rs)},
+ i=I,vdb=Tdb1,a=A#k.a}.
+
%% call_op(Op) -> Op.
%% bif_op(Op) -> Op.
%% test_op(Op) -> Op.
@@ -353,25 +310,6 @@ guard_clause(#k_guard_clause{anno=A,guard=Kg,body=Kb}, Ls, I, Ctxt, Vdb0) ->
i=I,vdb=use_vars((get_kanno(Kg))#k.us, I+2, Vdb1),
a=A#k.a}.
-%% match_fail(FailValue, I, Anno) -> Expr.
-%% Generate the correct match_fail instruction. N.B. there is no
-%% generic case for when the fail value has been created elsewhere.
-
-match_fail(#k_literal{anno=Anno,val={Atom,Val}}, I, A) when is_atom(Atom) ->
- match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom},#k_literal{val=Val}]}, I, A);
-match_fail(#k_literal{anno=Anno,val={Atom}}, I, A) when is_atom(Atom) ->
- match_fail(#k_tuple{anno=Anno,es=[#k_atom{val=Atom}]}, I, A);
-match_fail(#k_tuple{es=[#k_atom{val=function_clause}|As]}, I, A) ->
- #l{ke={match_fail,{function_clause,literal_list(As, [])}},i=I,a=A};
-match_fail(#k_tuple{es=[#k_atom{val=badmatch},Val]}, I, A) ->
- #l{ke={match_fail,{badmatch,literal(Val, [])}},i=I,a=A};
-match_fail(#k_tuple{es=[#k_atom{val=case_clause},Val]}, I, A) ->
- #l{ke={match_fail,{case_clause,literal(Val, [])}},i=I,a=A};
-match_fail(#k_atom{val=if_clause}, I, A) ->
- #l{ke={match_fail,if_clause},i=I,a=A};
-match_fail(#k_tuple{es=[#k_atom{val=try_clause},Val]}, I, A) ->
- #l{ke={match_fail,{try_clause,literal(Val, [])}},i=I,a=A}.
-
%% type(Ktype) -> Type.
type(k_literal) -> literal;
@@ -403,7 +341,6 @@ atomic(#k_int{val=I}) -> {integer,I};
atomic(#k_float{val=F}) -> {float,F};
atomic(#k_atom{val=N}) -> {atom,N};
%%atomic(#k_char{val=C}) -> {char,C};
-%%atomic(#k_string{val=S}) -> {string,S};
atomic(#k_nil{}) -> nil.
atomic_list(Ks) -> [atomic(K) || K <- Ks].
@@ -565,3 +502,7 @@ vdb_sub(Min, Max, Vdb) ->
true -> Vd
end || {V,F,L}=Vd <- Vdb, F < Min, L >= Min ].
+%% is_in_guard() -> true|false.
+
+is_in_guard() ->
+ get(guard_refc) > 0.
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index b90adaf917..e13ad4ae90 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -10,6 +10,7 @@ MODULES= \
apply_SUITE \
beam_validator_SUITE \
beam_disasm_SUITE \
+ beam_expect_SUITE \
bs_bincomp_SUITE \
bs_bit_binaries_SUITE \
bs_construct_SUITE \
@@ -29,7 +30,6 @@ MODULES= \
misc_SUITE \
num_bif_SUITE \
pmod_SUITE \
- parteval_SUITE \
receive_SUITE \
record_SUITE \
trycatch_SUITE \
@@ -39,6 +39,7 @@ MODULES= \
NO_OPT= \
andor \
apply \
+ beam_expect \
bs_construct \
bs_match \
bs_utf \
diff --git a/lib/compiler/test/beam_disasm_SUITE.erl b/lib/compiler/test/beam_disasm_SUITE.erl
index 44574ae64a..62afc80ca6 100644
--- a/lib/compiler/test/beam_disasm_SUITE.erl
+++ b/lib/compiler/test/beam_disasm_SUITE.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 2011. All Rights Reserved.
+%% Copyright Ericsson AB 2011-2012. All Rights Reserved.
%%
%% The contents of this file are subject to the Erlang Public License,
%% Version 1.1, (the "License"); you may not use this file except in
@@ -60,6 +60,6 @@ stripped(Config) when is_list(Config) ->
?line true = is_list(Attr),
?line true = is_list(CompileInfo),
?line {ok, {tmp, _}} = beam_lib:strip(BeamName),
- ?line {beam_file, tmp, _, none, none, [_|_]} =
+ ?line {beam_file, tmp, _, [], [], [_|_]} =
beam_disasm:file(BeamName),
ok.
diff --git a/lib/compiler/test/beam_expect_SUITE.erl b/lib/compiler/test/beam_expect_SUITE.erl
new file mode 100644
index 0000000000..6f216eac4f
--- /dev/null
+++ b/lib/compiler/test/beam_expect_SUITE.erl
@@ -0,0 +1,67 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2011. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+-module(beam_expect_SUITE).
+
+-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ coverage/1]).
+
+suite() -> [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ [coverage].
+
+groups() ->
+ [].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+coverage(_) ->
+ File = {file,"fake.erl"},
+ ok = fc(a),
+ {'EXIT',{function_clause,
+ [{?MODULE,fc,[[x]],[File,{line,2}]}|_]}} =
+ (catch fc([x])),
+ {'EXIT',{function_clause,
+ [{?MODULE,fc,[y],[File,{line,2}]}|_]}} =
+ (catch fc(y)),
+ {'EXIT',{function_clause,
+ [{?MODULE,fc,[[a,b,c]],[File,{line,6}]}|_]}} =
+ (catch fc([a,b,c])),
+
+ {'EXIT',{undef,[{erlang,error,[a,b,c],_}|_]}} =
+ (catch erlang:error(a, b, c)),
+ ok.
+
+-file("fake.erl", 1).
+fc(a) -> %Line 2
+ ok; %Line 3
+fc(L) when length(L) > 2 -> %Line 4
+ %% Not the same as a "real" function_clause error.
+ error(function_clause, [L]). %Line 6
diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl
index 556dc54a8f..902867bc19 100644
--- a/lib/compiler/test/beam_validator_SUITE.erl
+++ b/lib/compiler/test/beam_validator_SUITE.erl
@@ -79,21 +79,18 @@ beam_files(Config) when is_list(Config) ->
%% a grammatical error in the output of the io:format/2 call below. ;-)
?line [_,_|_] = Fs = filelib:wildcard(Wc),
?line io:format("~p files\n", [length(Fs)]),
- beam_files_1(Fs, 0).
-
-beam_files_1([F|Fs], Errors) ->
- ?line case beam_validator:file(F) of
- ok ->
- beam_files_1(Fs, Errors);
- {error,Es} ->
- io:format("File: ~s", [F]),
- io:format("Error: ~p\n", [Es]),
- beam_files_1(Fs, Errors+1)
- end;
-beam_files_1([], 0) -> ok;
-beam_files_1([], Errors) ->
- ?line io:format("~p error(s)", [Errors]),
- ?line ?t:fail().
+ test_lib:p_run(fun do_beam_file/1, Fs).
+
+
+do_beam_file(F) ->
+ case beam_validator:file(F) of
+ ok ->
+ ok;
+ {error,Es} ->
+ io:format("File: ~s", [F]),
+ io:format("Error: ~p\n", [Es]),
+ error
+ end.
compiler_bug(Config) when is_list(Config) ->
%% Check that the compiler returns an error if we try to
diff --git a/lib/compiler/test/bs_match_SUITE.erl b/lib/compiler/test/bs_match_SUITE.erl
index f8c71a0257..01b7568122 100644
--- a/lib/compiler/test/bs_match_SUITE.erl
+++ b/lib/compiler/test/bs_match_SUITE.erl
@@ -342,6 +342,10 @@ partitioned_bs_match(Config) when is_list(Config) ->
?line fc(partitioned_bs_match_2, [4,<<0:17>>],
catch partitioned_bs_match_2(4, <<0:17>>)),
+
+ anything = partitioned_bs_match_3(anything, <<42>>),
+ ok = partitioned_bs_match_3(1, 2),
+
ok.
partitioned_bs_match(_, <<42:8,T/binary>>) ->
@@ -356,6 +360,9 @@ partitioned_bs_match_2(1, <<B:8,T/binary>>) ->
partitioned_bs_match_2(Len, <<_:8,T/binary>>) ->
{Len,T}.
+partitioned_bs_match_3(Var, <<_>>) -> Var;
+partitioned_bs_match_3(1, 2) -> ok.
+
function_clause(Config) when is_list(Config) ->
?line ok = function_clause_1(<<0,7,0,7,42>>),
?line fc(function_clause_1, [<<0,1,2,3>>],
diff --git a/lib/compiler/test/compilation_SUITE.erl b/lib/compiler/test/compilation_SUITE.erl
index 1343fbd1c9..408fd5ed53 100644
--- a/lib/compiler/test/compilation_SUITE.erl
+++ b/lib/compiler/test/compilation_SUITE.erl
@@ -44,7 +44,7 @@ all() ->
trycatch_4, opt_crash, otp_5404, otp_5436, otp_5481,
otp_5553, otp_5632, otp_5714, otp_5872, otp_6121,
otp_6121a, otp_6121b, otp_7202, otp_7345, on_load,
- string_table,otp_8949_a,otp_8949_a].
+ string_table,otp_8949_a,otp_8949_a,split_cases].
groups() ->
[{vsn, [], [vsn_1, vsn_2, vsn_3]}].
@@ -159,6 +159,7 @@ split({int, N}, <<N:16,B:N/binary,T/binary>>) ->
?comp(convopts).
?comp(otp_7202).
?comp(on_load).
+?comp(on_load_inline).
beam_compiler_7(doc) ->
"Code snippet submitted from Ulf Wiger which fails in R3 Beam.";
@@ -427,9 +428,9 @@ self_compile_1(Config, Prefix, Opts) ->
%% Compile the compiler again using the newly compiled compiler.
%% (In another node because reloading the compiler would disturb cover.)
CompilerB = Prefix++"compiler_b",
- ?line CompB = make_compiler_dir(Priv, Prefix++"compiler_b"),
+ CompB = make_compiler_dir(Priv, CompilerB),
?line VsnB = VsnA ++ ".0",
- ?line self_compile_node(CompilerB, CompA, CompB, VsnB, Opts),
+ self_compile_node(CompA, CompB, VsnB, Opts),
%% Compare compiler directories.
?line compare_compilers(CompA, CompB),
@@ -438,21 +439,26 @@ self_compile_1(Config, Prefix, Opts) ->
?line CompilerC = Prefix++"compiler_c",
?line CompC = make_compiler_dir(Priv, CompilerC),
?line VsnC = VsnB ++ ".0",
- ?line self_compile_node(CompilerC, CompB, CompC, VsnC, Opts),
+ self_compile_node(CompB, CompC, VsnC, Opts),
?line compare_compilers(CompB, CompC),
?line test_server:timetrap_cancel(Dog),
ok.
-self_compile_node(NodeName0, CompilerDir, OutDir, Version, Opts) ->
- ?line NodeName = list_to_atom(NodeName0),
- ?line Dog = test_server:timetrap(test_server:minutes(10)),
+self_compile_node(CompilerDir, OutDir, Version, Opts) ->
+ ?line Dog = test_server:timetrap(test_server:minutes(15)),
?line Pa = "-pa " ++ filename:dirname(code:which(?MODULE)) ++
" -pa " ++ CompilerDir,
- ?line {ok,Node} = start_node(NodeName, Pa),
?line Files = compiler_src(),
- ?line ok = rpc:call(Node, ?MODULE, compile_compiler, [Files,OutDir,Version,Opts]),
- ?line test_server:stop_node(Node),
+
+ %% We don't want the cover server started on the other node,
+ %% because it will load the same cover-compiled code as on this
+ %% node. Use a shielded node to prevent the cover server from
+ %% being started.
+ ?t:run_on_shielded_node(
+ fun() ->
+ compile_compiler(Files, OutDir, Version, Opts)
+ end, Pa),
?line test_server:timetrap_cancel(Dog),
ok.
@@ -465,9 +471,12 @@ compile_compiler(Files, OutDir, Version, InlineOpts) ->
{d,'COMPILER_VSN',"\""++Version++"\""},
nowarn_shadow_vars,
{i,filename:join(code:lib_dir(stdlib), "include")}|InlineOpts],
- lists:foreach(fun(File) ->
- {ok,_} = compile:file(File, Opts)
- end, Files).
+ test_lib:p_run(fun(File) ->
+ case compile:file(File, Opts) of
+ {ok,_} -> ok;
+ _ -> error
+ end
+ end, Files).
compiler_src() ->
filelib:wildcard(filename:join([code:lib_dir(compiler), "src", "*.erl"])).
@@ -657,5 +666,19 @@ otp_8949_b(A, B) ->
id(Var)
end.
+split_cases(_) ->
+ dummy1 = do_split_cases(x),
+ {'EXIT',{{badmatch,b},_}} = (catch do_split_cases(y)),
+ ok.
+
+do_split_cases(A) ->
+ case A of
+ x ->
+ Z = dummy1;
+ _ ->
+ Z = dummy2,
+ a=b
+ end,
+ Z.
id(I) -> I.
diff --git a/lib/compiler/test/compilation_SUITE_data/on_load_inline.erl b/lib/compiler/test/compilation_SUITE_data/on_load_inline.erl
new file mode 100644
index 0000000000..322843b61e
--- /dev/null
+++ b/lib/compiler/test/compilation_SUITE_data/on_load_inline.erl
@@ -0,0 +1,23 @@
+-module(on_load_inline).
+-export([?MODULE/0]).
+-on_load(on_load/0).
+-compile(inline).
+
+?MODULE() ->
+ [{pid,Pid}] = ets:lookup(on_load_executed, pid),
+ exit(Pid, kill),
+ ok.
+
+on_load() ->
+ Parent = self(),
+ spawn(fun() ->
+ T = ets:new(on_load_executed, [named_table]),
+ ets:insert(T, {pid,self()}),
+ Parent ! done,
+ receive
+ wait_forever -> ok
+ end
+ end),
+ receive
+ done -> ok
+ end.
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index fedbd98f71..640849f2ec 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -29,7 +29,8 @@
binary/1, makedep/1, cond_and_ifdef/1, listings/1, listings_big/1,
other_output/1, package_forms/1, encrypted_abstr/1,
bad_record_use1/1, bad_record_use2/1, strict_record/1,
- missing_testheap/1, cover/1, env/1, core/1, asm/1]).
+ missing_testheap/1, cover/1, env/1, core/1, asm/1,
+ sys_pre_attributes/1]).
-export([init/3]).
@@ -45,7 +46,8 @@ all() ->
binary, makedep, cond_and_ifdef, listings, listings_big,
other_output, package_forms, encrypted_abstr,
{group, bad_record_use}, strict_record,
- missing_testheap, cover, env, core, asm].
+ missing_testheap, cover, env, core, asm,
+ sys_pre_attributes].
groups() ->
[{bad_record_use, [],
@@ -785,6 +787,37 @@ do_asm(Beam, Outdir) ->
error
end.
+sys_pre_attributes(Config) ->
+ DataDir = ?config(data_dir, Config),
+ File = filename:join(DataDir, "attributes.erl"),
+ Mod = attributes,
+ CommonOpts = [binary,report,verbose,
+ {parse_transform,sys_pre_attributes}],
+ PreOpts = [{attribute,delete,deleted}],
+ PostOpts = [{attribute,insert,inserted,"value"}],
+ PrePostOpts = [{attribute,replace,replaced,42},
+ {attribute,replace,replace_nonexisting,new}],
+ {ok,Mod,Code} = compile:file(File, PrePostOpts ++ PreOpts ++
+ PostOpts ++ CommonOpts),
+ code:load_binary(Mod, File, Code),
+ Attr = Mod:module_info(attributes),
+ io:format("~p", [Attr]),
+ {inserted,"value"} = lists:keyfind(inserted, 1, Attr),
+ {replaced,[42]} = lists:keyfind(replaced, 1, Attr),
+ {replace_nonexisting,[new]} = lists:keyfind(replace_nonexisting, 1, Attr),
+ false = lists:keymember(deleted, 1, Attr),
+
+ %% Cover more code.
+ {ok,Mod,_} = compile:file(File, PostOpts ++ CommonOpts),
+ {ok,Mod,_} = compile:file(File, CommonOpts -- [verbose]),
+ {ok,Mod,_} = compile:file(File, PreOpts ++ CommonOpts),
+ {ok,Mod,_} = compile:file(File,
+ [{attribute,replace,replaced,42}|CommonOpts]),
+ {ok,Mod,_} = compile:file(File, PrePostOpts ++ PreOpts ++
+ PostOpts ++ CommonOpts --
+ [report,verbose]),
+ ok.
+
%%%
%%% Utilities.
%%%
diff --git a/lib/compiler/test/compile_SUITE_data/attributes.erl b/lib/compiler/test/compile_SUITE_data/attributes.erl
new file mode 100644
index 0000000000..9c3451d272
--- /dev/null
+++ b/lib/compiler/test/compile_SUITE_data/attributes.erl
@@ -0,0 +1,23 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2012. All Rights Reserved.
+%%
+%% The contents of this file are subject to the Erlang Public License,
+%% Version 1.1, (the "License"); you may not use this file except in
+%% compliance with the License. You should have received a copy of the
+%% Erlang Public License along with this software. If not, it can be
+%% retrieved online at http://www.erlang.org/.
+%%
+%% Software distributed under the License is distributed on an "AS IS"
+%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
+%% the License for the specific language governing rights and limitations
+%% under the License.
+%%
+%% %CopyrightEnd%
+%%
+
+-module(attributes).
+-deleted(dummy).
+-replaced(dummy).
+
diff --git a/lib/compiler/test/compiler.cover b/lib/compiler/test/compiler.cover
index 9fc4c7dd43..3fd7fc1937 100644
--- a/lib/compiler/test/compiler.cover
+++ b/lib/compiler/test/compiler.cover
@@ -1,5 +1,5 @@
{incl_app,compiler,details}.
%% -*- erlang -*-
-{excl_mods,[sys_pre_attributes,core_scan,core_parse]}.
+{excl_mods,compiler,[core_scan,core_parse]}.
diff --git a/lib/compiler/test/core_SUITE.erl b/lib/compiler/test/core_SUITE.erl
index 26173c62b8..fd1539e7fd 100644
--- a/lib/compiler/test/core_SUITE.erl
+++ b/lib/compiler/test/core_SUITE.erl
@@ -21,7 +21,9 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
init_per_testcase/2,end_per_testcase/2,
- dehydrated_itracer/1,nested_tries/1]).
+ 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]).
-include_lib("test_server/include/test_server.hrl").
@@ -41,7 +43,8 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
test_lib:recompile(?MODULE),
- [dehydrated_itracer, nested_tries].
+ [dehydrated_itracer,nested_tries,seq_in_guard,make_effect_seq,
+ eval_is_boolean,unsafe_case,nomatch_shadow,reversed_annos].
groups() ->
[].
@@ -61,19 +64,19 @@ end_per_group(_GroupName, Config) ->
?comp(dehydrated_itracer).
?comp(nested_tries).
+?comp(seq_in_guard).
+?comp(make_effect_seq).
+?comp(eval_is_boolean).
+?comp(unsafe_case).
+?comp(nomatch_shadow).
+?comp(reversed_annos).
try_it(Mod, Conf) ->
- ?line Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)),
- ?line Out = ?config(priv_dir,Conf),
- ?line io:format("Compiling: ~s\n", [Src]),
- ?line CompRc0 = compile:file(Src, [from_core,{outdir,Out},report,time]),
- ?line io:format("Result: ~p\n",[CompRc0]),
- ?line {ok,Mod} = CompRc0,
-
- ?line {module,Mod} = code:load_abs(filename:join(Out, Mod)),
- ?line ok = Mod:Mod(),
- ok.
-
-
-
-
+ Src = filename:join(?config(data_dir, Conf), atom_to_list(Mod)),
+ compile_and_load(Src, []),
+ compile_and_load(Src, [no_copt]).
+
+compile_and_load(Src, Opts) ->
+ {ok,Mod,Bin} = compile:file(Src, [from_core,report,time,binary|Opts]),
+ {module,Mod} = code:load_binary(Mod, Mod, Bin),
+ ok = Mod:Mod().
diff --git a/lib/compiler/test/core_SUITE_data/eval_is_boolean.core b/lib/compiler/test/core_SUITE_data/eval_is_boolean.core
new file mode 100644
index 0000000000..6a68b1414d
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/eval_is_boolean.core
@@ -0,0 +1,22 @@
+module 'eval_is_boolean' ['eval_is_boolean'/0]
+ attributes []
+'eval_is_boolean'/0 =
+ %% Line 4
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ case call 'erlang':'is_boolean'(call 'erlang':'make_ref'()) of
+ <'false'> when 'true' ->
+ 'ok'
+ ( <_cor1> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor1})
+ -| ['compiler_generated'] )
+ end
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'eval_is_boolean',0}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/make_effect_seq.core b/lib/compiler/test/core_SUITE_data/make_effect_seq.core
new file mode 100644
index 0000000000..9941e63b76
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/make_effect_seq.core
@@ -0,0 +1,51 @@
+module 'make_effect_seq' ['make_effect_seq'/0]
+ attributes []
+'make_effect_seq'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ let <_cor0> =
+ catch
+ apply 't'/1
+ ('a')
+ in
+ case _cor0 of
+ <{'EXIT',{'badarg',_cor3}}> when 'true' ->
+ let <_cor4> =
+ apply 't'/1
+ ({'a','b','c'})
+ in
+ case _cor4 of
+ <'ok'> when 'true' ->
+ ( _cor4
+ -| ['compiler_generated'] )
+ ( <_cor2> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor2})
+ -| ['compiler_generated'] )
+ end
+ ( <_cor1> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor1})
+ -| ['compiler_generated'] )
+ end
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'make_effect_seq',0}}] )
+ -| ['compiler_generated'] )
+ end
+'t'/1 =
+ fun (_cor0) ->
+ case _cor0 of
+ <T> when 'true' ->
+ do
+ {'ok',call 'erlang':'element'(2, T)}
+ 'ok'
+ ( <_cor2> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor2})
+ -| [{'function_name',{'t',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/nomatch_shadow.core b/lib/compiler/test/core_SUITE_data/nomatch_shadow.core
new file mode 100644
index 0000000000..565d9dc0f3
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/nomatch_shadow.core
@@ -0,0 +1,28 @@
+module 'nomatch_shadow' ['nomatch_shadow'/0]
+ attributes []
+'nomatch_shadow'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ apply 't'/1
+ (42)
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'nomatch_shadow',0}}] )
+ -| ['compiler_generated'] )
+ end
+'t'/1 =
+ fun (_cor0) ->
+ case _cor0 of
+ <42> when 'true' ->
+ 'ok'
+ <42> when 'true' ->
+ 'ok'
+ ( <_cor1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor1})
+ -| [{'function_name',{'t',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/reversed_annos.core b/lib/compiler/test/core_SUITE_data/reversed_annos.core
new file mode 100644
index 0000000000..95b3cd52d6
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/reversed_annos.core
@@ -0,0 +1,49 @@
+module 'reversed_annos' ['reversed_annos'/0]
+ attributes []
+'reversed_annos'/0 =
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ case apply 't'/1
+ (['a']) of
+ <'ok'> when 'true' ->
+ let <_cor2> =
+ apply 't'/1
+ (['a'|['b']])
+ in
+ case _cor2 of
+ <'ok'> when 'true' ->
+ ( _cor2
+ -| ['compiler_generated'] )
+ ( <_cor1> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor1})
+ -| ['compiler_generated'] )
+ end
+ ( <_cor0> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor0})
+ -| ['compiler_generated'] )
+ end
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'reversed_annos',0}}] )
+ -| ['compiler_generated'] )
+ end
+'t'/1 =
+ fun (_cor0) ->
+ case _cor0 of
+ <[_cor2|_cor3]> when 'true' ->
+ 'ok'
+ %% Cover v3_kernel:get_line/1.
+ ( <['a']> when 'true' ->
+ 'error'
+ -| [{'file',"reversed_annos.erl"},11] )
+ ( <_cor1> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor1})
+ -| [{'function_name',{'t',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/seq_in_guard.core b/lib/compiler/test/core_SUITE_data/seq_in_guard.core
new file mode 100644
index 0000000000..44686a7187
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/seq_in_guard.core
@@ -0,0 +1,66 @@
+module 'seq_in_guard' ['seq_in_guard'/0,
+ 't'/1]
+ attributes []
+'seq_in_guard'/0 =
+ %% Line 4
+ fun () ->
+ case <> of
+ <> when 'true' ->
+ let <_cor0> =
+ catch
+ %% Line 5
+ apply 't'/1
+ ({})
+ in %% Line 5
+ case _cor0 of
+ <{'EXIT',{'function_clause',_cor4}}> when 'true' ->
+ let <_cor2> =
+ catch
+ %% Line 6
+ apply 't'/1
+ ('atom')
+ in %% Line 6
+ case _cor2 of
+ <{'EXIT',{'function_clause',_cor5}}> when 'true' ->
+ %% Line 7
+ apply 't'/1
+ ({'a','b'})
+ ( <_cor3> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor3})
+ -| ['compiler_generated'] )
+ end
+ ( <_cor1> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor1})
+ -| ['compiler_generated'] )
+ end
+ ( <> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause'})
+ -| [{'function_name',{'seq_in_guard',0}}] )
+ -| ['compiler_generated'] )
+ end
+'t'/1 =
+ %% Line 9
+ fun (_cor0) ->
+ case _cor0 of
+ <X>
+ when try
+ do
+ call 'erlang':'element'
+ (2, X)
+ 'true'
+ of <Try> ->
+ Try
+ catch <T,R> ->
+ 'false' ->
+ %% Line 10
+ 'ok'
+ ( <_cor3> when 'true' ->
+ ( primop 'match_fail'
+ ({'function_clause',_cor3})
+ -| [{'function_name',{'t',1}}] )
+ -| ['compiler_generated'] )
+ end
+end
diff --git a/lib/compiler/test/core_SUITE_data/unsafe_case.core b/lib/compiler/test/core_SUITE_data/unsafe_case.core
new file mode 100644
index 0000000000..84cb2c310a
--- /dev/null
+++ b/lib/compiler/test/core_SUITE_data/unsafe_case.core
@@ -0,0 +1,25 @@
+module 'unsafe_case' ['unsafe_case'/0]
+ attributes []
+'unsafe_case'/0 =
+ fun () ->
+ case apply 't'/1
+ (42) of
+ <{'ok',42}> when 'true' ->
+ 'ok'
+ ( <_cor0> when 'true' ->
+ primop 'match_fail'
+ ({'badmatch',_cor0})
+ -| ['compiler_generated'] )
+ end
+'t'/1 =
+ fun (_cor0) ->
+ case _cor0 of
+ <X>
+ when call 'erlang':'>'
+ (_cor0,
+ 0) ->
+ {'ok',X}
+ %% The default case is intentionally missing
+ %% to cover v3_kernel:build_match/2.
+ end
+end
diff --git a/lib/compiler/test/core_fold_SUITE.erl b/lib/compiler/test/core_fold_SUITE.erl
index ac14d36e82..54bd52947e 100644
--- a/lib/compiler/test/core_fold_SUITE.erl
+++ b/lib/compiler/test/core_fold_SUITE.erl
@@ -21,7 +21,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
t_element/1,setelement/1,t_length/1,append/1,t_apply/1,bifs/1,
- eq/1,nested_call_in_case/1,coverage/1]).
+ eq/1,nested_call_in_case/1,guard_try_catch/1,coverage/1]).
-export([foo/0,foo/1,foo/2,foo/3]).
@@ -32,7 +32,7 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
test_lib:recompile(?MODULE),
[t_element, setelement, t_length, append, t_apply, bifs,
- eq, nested_call_in_case, coverage].
+ eq, nested_call_in_case, guard_try_catch, coverage].
groups() ->
[].
@@ -207,6 +207,23 @@ nested_call_in_case(Config) when is_list(Config) ->
?line {'EXIT',_} = (catch Mod:a(not_a_list, 42)),
ok.
+guard_try_catch(_Config) ->
+ false = do_guard_try_catch(key, value),
+ value = get(key),
+ ok.
+
+do_guard_try_catch(K, V) ->
+ %% This try...catch block looks like a guard.
+ %% Make sure that it is not optimized like a guard
+ %% (the put/2 call must not be optimized away).
+ try
+ put(K, V),
+ false
+ catch
+ _:_ ->
+ false
+ end.
+
coverage(Config) when is_list(Config) ->
?line {'EXIT',{{case_clause,{a,b,c}},_}} =
(catch cover_will_match_list_type({a,b,c})),
@@ -214,6 +231,7 @@ coverage(Config) when is_list(Config) ->
(catch cover_will_match_list_type({a,b,c,d})),
?line a = cover_remove_non_vars_alias({a,b,c}),
?line error = cover_will_match_lit_list(),
+ {ok,[a]} = cover_is_safe_bool_expr(a),
%% Make sure that we don't attempt to make literals
%% out of pids. (Putting a pid into a #c_literal{}
@@ -249,4 +267,17 @@ cover_will_match_lit_list() ->
error
end.
+cover_is_safe_bool_expr(X) ->
+ %% Use a try...catch that looks like a try...catch in a guard.
+ try
+ %% let V = [X] in {ok,V}
+ %% is_safe_simple([X]) ==> true
+ %% is_safe_bool_expr([X]) ==> false
+ V = [X],
+ {ok,V}
+ catch
+ _:_ ->
+ false
+ end.
+
id(I) -> I.
diff --git a/lib/compiler/test/misc_SUITE.erl b/lib/compiler/test/misc_SUITE.erl
index 9b414cade6..5e13a93c52 100644
--- a/lib/compiler/test/misc_SUITE.erl
+++ b/lib/compiler/test/misc_SUITE.erl
@@ -190,6 +190,15 @@ silly_coverage(Config) when is_list(Config) ->
{label,2}|non_proper_list]}],99},
?line expect_error(fun() -> beam_block:module(BlockInput, []) end),
+ %% beam_except
+ ExceptInput = {?MODULE,[{foo,0}],[],
+ [{function,foo,0,2,
+ [{label,1},
+ {line,loc},
+ {func_info,{atom,?MODULE},{atom,foo},0},
+ {label,2}|non_proper_list]}],99},
+ expect_error(fun() -> beam_except:module(ExceptInput, []) end),
+
%% beam_bool
BoolInput = {?MODULE,[{foo,0}],[],
[{function,foo,0,2,
@@ -253,8 +262,15 @@ expect_error(Fun) ->
io:format("~p", [Any]),
?t:fail(call_was_supposed_to_fail)
catch
- _:_ ->
- io:format("~p\n", [erlang:get_stacktrace()])
+ Class:Reason ->
+ Stk = erlang:get_stacktrace(),
+ io:format("~p:~p\n~p\n", [Class,Reason,Stk]),
+ case {Class,Reason} of
+ {error,undef} ->
+ ?t:fail(not_supposed_to_fail_with_undef);
+ {_,_} ->
+ ok
+ end
end.
confused_literals(Config) when is_list(Config) ->
diff --git a/lib/compiler/test/parteval_SUITE.erl b/lib/compiler/test/parteval_SUITE.erl
deleted file mode 100644
index 6b1ae38c1b..0000000000
--- a/lib/compiler/test/parteval_SUITE.erl
+++ /dev/null
@@ -1,66 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-2011. All Rights Reserved.
-%%
-%% The contents of this file are subject to the Erlang Public License,
-%% Version 1.1, (the "License"); you may not use this file except in
-%% compliance with the License. You should have received a copy of the
-%% Erlang Public License along with this software. If not, it can be
-%% retrieved online at http://www.erlang.org/.
-%%
-%% Software distributed under the License is distributed on an "AS IS"
-%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
-%% the License for the specific language governing rights and limitations
-%% under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(parteval_SUITE).
-
--include_lib("test_server/include/test_server.hrl").
-
--export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
- init_per_group/2,end_per_group/2, pe2/1]).
-
-suite() -> [{ct_hooks,[ts_install_cth]}].
-
-all() ->
- [pe2].
-
-groups() ->
- [].
-
-init_per_suite(Config) ->
- Config.
-
-end_per_suite(_Config) ->
- ok.
-
-init_per_group(_GroupName, Config) ->
- Config.
-
-end_per_group(_GroupName, Config) ->
- Config.
-
-
-%% (This is more general than needed, since we once compiled the same
-%% source code with and without a certain option.)
-compile_and_load(Srcname, Outdir, Module, Options) ->
- ?line Objname = filename:join(Outdir, "t1") ++ code:objfile_extension(),
- ?line {ok, Module} =
- compile:file(Srcname,
- [{d, 'M', Module}, {outdir, Outdir}] ++ Options),
- ?line {ok, B} = file:read_file(Objname),
- ?line {module, Module} = code:load_binary(Module, Objname, B),
- B.
-
-pe2(Config) when is_list(Config) ->
- ?line DataDir = ?config(data_dir, Config),
- ?line PrivDir = ?config(priv_dir, Config),
- ?line Srcname = filename:join(DataDir, "t1.erl"),
- ?line compile_and_load(Srcname, PrivDir, t1, []),
-
- ?line {Correct, Actual} = t1:run(),
- ?line Correct = Actual,
- ok.
diff --git a/lib/compiler/test/parteval_SUITE_data/t1.erl b/lib/compiler/test/parteval_SUITE_data/t1.erl
deleted file mode 100644
index 5e4a40f103..0000000000
--- a/lib/compiler/test/parteval_SUITE_data/t1.erl
+++ /dev/null
@@ -1,140 +0,0 @@
-%%
-%% %CopyrightBegin%
-%%
-%% Copyright Ericsson AB 1998-2009. All Rights Reserved.
-%%
-%% The contents of this file are subject to the Erlang Public License,
-%% Version 1.1, (the "License"); you may not use this file except in
-%% compliance with the License. You should have received a copy of the
-%% Erlang Public License along with this software. If not, it can be
-%% retrieved online at http://www.erlang.org/.
-%%
-%% Software distributed under the License is distributed on an "AS IS"
-%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See
-%% the License for the specific language governing rights and limitations
-%% under the License.
-%%
-%% %CopyrightEnd%
-%%
--module(?M).
-
--compile(export_all).
-
-%%% The arity-0 functions are all called from the test suite.
-
-f2() ->
- size({1,2}).
-
-i() ->
- case [] of
- [] ->
- ok;
- X ->
- hopp
- end.
-
-e() ->
- case 4+5 of
-% X when X>10 -> kvock; % not removed by BEAM opt.
- {X,X} when list(X) ->
- kvack;
- 9 ->
- ok;
- _ ->
- ko
- end.
-
-f() ->
- element(2,{a,b,c,d}),
- erlang:element(2,{a,b,c,d}),
- "hej" ++ "hopp".
-
-g(X) ->
- if
- float(3.4) ->
- hej;
- X == 5, 4==4 ->
- japp;
- 4 == 4, size({1,2}) == 1 ->
- ok
- end.
-
-g() ->
- {g(3),g(5)}.
-
-bliff() ->
- if
- 3==4 ->
- himm
- end.
-
-fi() ->
- case 4 of
- X when 4==3 ->
- {X};
- 4 ->
- 4;
- _ ->
- ok
- end.
-
-iff() when 3==2 ->
- if
- 3 == 4 ->
- baff;
- 3 == 3 ->
- nipp
- end.
-
-sleep(I) -> receive after I -> ok end.
-
-sleep() ->
- sleep(45).
-
-s() ->
- case 4 of
- 3 ->
- ok
- end.
-
-error_reason(R) when atom(R) ->
- R;
-error_reason(R) when tuple(R) ->
- error_reason(element(1, R)).
-
-plusplus() ->
- ?MODULE ++ " -> mindre snygg felhantering".
-
-call_it(F) ->
- case (catch apply(?MODULE, F, [])) of
- {'EXIT', R0} ->
- {'EXIT', error_reason(R0)};
- V ->
- V
- end.
-
-run() ->
- L = [{f2, 2},
- {i, ok},
- {e, ok},
- {f, "hejhopp"},
- {g, {hej, hej}},
- {bliff, {'EXIT', if_clause}},
- {fi, 4},
- {iff, {'EXIT', function_clause}},
- {sleep, ok},
- {s, {'EXIT', case_clause},
- {plusplus, {'EXIT', badarg}}}],
- Actual = [call_it(F) || {F, _} <- L],
- Correct = [C || {_, C} <- L],
- {Correct, Actual}.
-
-
-%%% Don't call, only compile.
-t(A) ->
- receive
- A when 1==2 ->
- ok;
- B ->
- B
- end.
diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl
index 53d8c04169..2295592a38 100644
--- a/lib/compiler/test/test_lib.erl
+++ b/lib/compiler/test/test_lib.erl
@@ -77,7 +77,14 @@ get_data_dir(Config) ->
%% Will fail the test case if there were any errors.
p_run(Test, List) ->
- N = erlang:system_info(schedulers) + 1,
+ N = case ?t:is_cover() of
+ false ->
+ erlang:system_info(schedulers);
+ true ->
+ %% Cover is running. Using more than one process
+ %% will probably only slow down compilation.
+ 1
+ end,
p_run_loop(Test, List, N, [], 0, 0).
p_run_loop(_, [], _, [], Errors, Ws) ->
diff --git a/lib/compiler/test/trycatch_SUITE.erl b/lib/compiler/test/trycatch_SUITE.erl
index 760cf17225..09a23724fe 100644
--- a/lib/compiler/test/trycatch_SUITE.erl
+++ b/lib/compiler/test/trycatch_SUITE.erl
@@ -24,7 +24,7 @@
catch_oops/1,after_oops/1,eclectic/1,rethrow/1,
nested_of/1,nested_catch/1,nested_after/1,
nested_horrid/1,last_call_optimization/1,bool/1,
- plain_catch_coverage/1,andalso_orelse/1]).
+ plain_catch_coverage/1,andalso_orelse/1,get_in_try/1]).
-include_lib("test_server/include/test_server.hrl").
@@ -35,7 +35,7 @@ all() ->
[basic, lean_throw, try_of, try_after, catch_oops,
after_oops, eclectic, rethrow, nested_of, nested_catch,
nested_after, nested_horrid, last_call_optimization,
- bool, plain_catch_coverage, andalso_orelse].
+ bool, plain_catch_coverage, andalso_orelse, get_in_try].
groups() ->
[].
@@ -928,3 +928,17 @@ andalso_orelse_2({Type,Keyval}) ->
zero() ->
0.0.
+
+get_in_try(_) ->
+ undefined = get_valid_line([a], []),
+ ok.
+
+get_valid_line([_|T]=Path, Annotations) ->
+ try
+ get(Path)
+ %% beam_dead used to optimize away an assignment to {y,1}
+ %% because it didn't appear to be used.
+ catch
+ _:not_found ->
+ get_valid_line(T, Annotations)
+ end.