aboutsummaryrefslogtreecommitdiffstats
path: root/lib/compiler
diff options
context:
space:
mode:
Diffstat (limited to 'lib/compiler')
-rw-r--r--lib/compiler/src/beam_bool.erl4
-rw-r--r--lib/compiler/src/beam_utils.erl103
-rw-r--r--lib/compiler/src/core_pp.erl55
-rw-r--r--lib/compiler/src/sys_core_fold.erl17
-rw-r--r--lib/compiler/src/v3_kernel.erl3
-rw-r--r--lib/compiler/test/Makefile3
-rw-r--r--lib/compiler/test/andor_SUITE.erl63
-rw-r--r--lib/compiler/test/beam_block_SUITE.erl3
-rw-r--r--lib/compiler/test/beam_bool_SUITE.erl160
-rw-r--r--lib/compiler/test/compile_SUITE.erl32
-rw-r--r--lib/compiler/test/fun_SUITE.erl30
-rw-r--r--lib/compiler/test/guard_SUITE.erl25
-rw-r--r--lib/compiler/test/test_lib.erl16
-rw-r--r--lib/compiler/test/trycatch_SUITE.erl3
14 files changed, 311 insertions, 206 deletions
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl
index f9a08f8718..359fdb6d3c 100644
--- a/lib/compiler/src/beam_bool.erl
+++ b/lib/compiler/src/beam_bool.erl
@@ -238,9 +238,9 @@ extend_block(BlAcc0, Fail, [{block,Is0}|OldAcc]) ->
end;
extend_block(BlAcc, _, OldAcc) -> {BlAcc,OldAcc}.
-extend_block_1([{set,[_],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) ->
+extend_block_1([{set,[{x,_}],_,{bif,_,{f,Fail}}}=I|Is], Fail, Acc) ->
extend_block_1(Is, Fail, [I|Acc]);
-extend_block_1([{set,[_],As,{bif,Bif,_}}=I|Is]=Is0, Fail, Acc) ->
+extend_block_1([{set,[{x,_}],As,{bif,Bif,_}}=I|Is]=Is0, Fail, Acc) ->
case safe_bool_op(Bif, length(As)) of
false -> {Acc,reverse(Is0)};
true -> extend_block_1(Is, Fail, [I|Acc])
diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl
index 37f89dd677..47703b4aa3 100644
--- a/lib/compiler/src/beam_utils.erl
+++ b/lib/compiler/src/beam_utils.erl
@@ -25,9 +25,8 @@
is_not_used/3,is_not_used_at/3,
empty_label_index/0,index_label/3,index_labels/1,
code_at/2,bif_to_test/3,is_pure_test/1,
- live_opt/1,delete_live_annos/1,combine_heap_needs/2]).
-
--export([join_even/2,split_even/1]).
+ live_opt/1,delete_live_annos/1,combine_heap_needs/2,
+ join_even/2,split_even/1]).
-import(lists, [member/2,sort/1,reverse/1,splitwith/2]).
@@ -67,8 +66,7 @@ is_killed(R, Is, D) ->
St = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()},
case check_liveness(R, Is, St) of
{killed,_} -> true;
- {used,_} -> false;
- {unknown,_} -> false
+ {used,_} -> false
end.
%% is_killed_at(Reg, Lbl, State) -> true|false
@@ -78,8 +76,7 @@ is_killed_at(R, Lbl, D) when is_integer(Lbl) ->
St0 = #live{bl=check_killed_block_fun(),lbl=D,res=gb_trees:empty()},
case check_liveness_at(R, Lbl, St0) of
{killed,_} -> true;
- {used,_} -> false;
- {unknown,_} -> false
+ {used,_} -> false
end.
%% is_not_used(Register, [Instruction], State) -> true|false
@@ -93,8 +90,7 @@ is_not_used(R, Is, D) ->
St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()},
case check_liveness(R, Is, St) of
{killed,_} -> true;
- {used,_} -> false;
- {unknown,_} -> false
+ {used,_} -> false
end.
%% is_not_used(Register, [Instruction], State) -> true|false
@@ -108,8 +104,7 @@ is_not_used_at(R, Lbl, D) ->
St = #live{bl=fun check_used_block/3,lbl=D,res=gb_trees:empty()},
case check_liveness_at(R, Lbl, St) of
{killed,_} -> true;
- {used,_} -> false;
- {unknown,_} -> false
+ {used,_} -> false
end.
%% index_labels(FunctionIs) -> State
@@ -137,10 +132,7 @@ index_label(Lbl, Is0, Acc) ->
%% Retrieve the code at the given label.
code_at(L, Ll) ->
- case gb_trees:lookup(L, Ll) of
- {value,Code} -> Code;
- none -> none
- end.
+ gb_trees:get(L, Ll).
%% bif_to_test(Bif, [Op], Fail) -> {test,Test,Fail,[Op]}
%% Convert a BIF to a test. Fail if not possible.
@@ -164,10 +156,10 @@ bif_to_test('=<', [A,B], Fail) -> {test,is_ge,Fail,[B,A]};
bif_to_test('>', [A,B], Fail) -> {test,is_lt,Fail,[B,A]};
bif_to_test('<', [_,_]=Ops, Fail) -> {test,is_lt,Fail,Ops};
bif_to_test('>=', [_,_]=Ops, Fail) -> {test,is_ge,Fail,Ops};
-bif_to_test('==', [A,[]], Fail) -> {test,is_nil,Fail,[A]};
+bif_to_test('==', [A,nil], Fail) -> {test,is_nil,Fail,[A]};
bif_to_test('==', [_,_]=Ops, Fail) -> {test,is_eq,Fail,Ops};
bif_to_test('/=', [_,_]=Ops, Fail) -> {test,is_ne,Fail,Ops};
-bif_to_test('=:=', [A,[]], Fail) -> {test,is_nil,Fail,[A]};
+bif_to_test('=:=', [A,nil], Fail) -> {test,is_nil,Fail,[A]};
bif_to_test('=:=', [_,_]=Ops, Fail) -> {test,is_eq_exact,Fail,Ops};
bif_to_test('=/=', [_,_]=Ops, Fail) -> {test,is_ne_exact,Fail,Ops};
bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}.
@@ -235,21 +227,28 @@ combine_heap_needs(Words, {alloc,Alloc}) when is_integer(Words) ->
combine_heap_needs(H1, H2) when is_integer(H1), is_integer(H2) ->
H1+H2.
+%% split_even/1
+%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]}
+
+split_even(Rs) -> split_even(Rs, [], []).
+
+%% join_even/1
+%% {[1,3,5],[2,4,6]} -> [1,2,3,4,5,6]
+
+join_even([], []) -> [];
+join_even([S|Ss], [D|Ds]) -> [S,D|join_even(Ss, Ds)].
+
%%%
%%% Local functions.
%%%
-%% check_liveness(Reg, [Instruction], {State,BlockCheckFun}) ->
-%% {killed | used | unknown,UpdateState}
-%% Finds out how Reg is used in the instruction sequence. Returns one of:
-%% killed - Reg is assigned a new value or killed by an allocation instruction
-%% used - Reg is used (or possibly referenced by an allocation instruction)
-%% unknown - not possible to determine (perhaps because of an instruction
-%% that we don't recognize)
+%% check_liveness(Reg, [Instruction], #live{}) ->
+%% {killed | used, #live{}}
+%% Find out whether Reg is used or killed in instruction sequence.
+%% 'killed' means that Reg is assigned a new value or killed by an
+%% allocation instruction. 'used' means that Reg is used in some way.
-check_liveness(R, [{set,_,_,_}=I|_], St) ->
- erlang:error(only_allowed_in_blocks, [R,I,St]);
check_liveness(R, [{block,Blk}|Is], #live{bl=BlockCheck}=St0) ->
case BlockCheck(R, Blk, St0) of
{transparent,St} -> check_liveness(R, Is, St);
@@ -461,8 +460,9 @@ check_liveness(R, [{loop_rec,{f,_},{x,0}}|_], St) ->
{x,_} ->
{killed,St};
_ ->
- %% y register. Rarely happens. Be very conversative.
- {unknown,St}
+ %% y register. Rarely happens. Be very conversative and
+ %% assume it's used.
+ {used,St}
end;
check_liveness(R, [{loop_rec_end,{f,Fail}}|_], St) ->
check_liveness_at(R, Fail, St);
@@ -493,7 +493,8 @@ check_liveness(R, [{put_map,{f,_},_,Src,_D,Live,{list,_}}|_], St0) ->
{x,_} ->
{killed,St0};
{y,_} ->
- {unknown,St0}
+ %% Conservatively mark it as used.
+ {used,St0}
end;
check_liveness(R, [{test_heap,N,Live}|Is], St) ->
I = {block,[{set,[],[],{alloc,Live,{nozero,nostack,N,[]}}}]},
@@ -505,12 +506,8 @@ check_liveness(R, [{get_list,S,D1,D2}|Is], St) ->
I = {block,[{set,[D1,D2],[S],get_list}]},
check_liveness(R, [I|Is], St);
check_liveness(_R, Is, St) when is_list(Is) ->
-%% case Is of
-%% [I|_] ->
-%% io:format("~p ~p\n", [_R,I]);
-%% _ -> ok
-%% end,
- {unknown,St}.
+ %% Not implemented. Conservatively assume that the register is used.
+ {used,St}.
check_liveness_everywhere(R, [{f,Lbl}|T], St0) ->
case check_liveness_at(R, Lbl, St0) of
@@ -529,7 +526,7 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) ->
none ->
{Res,St} = case gb_trees:lookup(Lbl, Ll) of
{value,Is} -> check_liveness(R, Is, St0);
- none -> {unknown,St0}
+ none -> {used,St0}
end,
{Res,St#live{res=gb_trees:insert(Lbl, Res, St#live.res)}}
end.
@@ -594,8 +591,10 @@ check_killed_block(_, []) -> transparent.
%% killed - Reg is assigned a new value or killed by an allocation instruction
%% transparent - Reg is neither used nor killed
%% used - Reg is explicitly used by an instruction
-%%
-%% (Unknown instructions will cause an exception.)
+%%
+%% '%live' annotations are not allowed.
+%%
+%% (Unknown instructions will cause an exception.)
check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St) ->
if
@@ -604,11 +603,6 @@ check_used_block({x,X}=R, [{set,Ds,Ss,{alloc,Live,Op}}|Is], St) ->
end;
check_used_block(R, [{set,Ds,Ss,Op}|Is], St) ->
check_used_block_1(R, Ss, Ds, Op, Is, St);
-check_used_block(R, [{'%live',Live,_}|Is], St) ->
- case R of
- {x,X} when X >= Live -> {killed,St};
- _ -> check_used_block(R, Is, St)
- end;
check_used_block(_, [], St) -> {transparent,St}.
check_used_block_1(R, Ss, Ds, Op, Is, St0) ->
@@ -639,8 +633,7 @@ is_reg_used_at_1(_, 0, St) ->
is_reg_used_at_1(R, Lbl, St0) ->
case check_liveness_at(R, Lbl, St0) of
{killed,St} -> {false,St};
- {used,St} -> {true,St};
- {unknown,St} -> {true,St}
+ {used,St} -> {true,St}
end.
index_labels_1([{label,Lbl}|Is0], Acc) ->
@@ -756,11 +749,6 @@ live_opt([{select,_,Src,Fail,List}=I|Is], Regs0, D, Acc) ->
Regs1 = x_live([Src], Regs0),
Regs = live_join_labels([Fail|List], D, Regs1),
live_opt(Is, Regs, D, [I|Acc]);
-live_opt([{'try',_,_}=I|Is], Regs, D, Acc) ->
- %% If an exeption happens, all x registers will be killed.
- %% Therefore, we should only base liveness of the code inside
- %% the try.
- live_opt(Is, Regs, D, [I|Acc]);
live_opt([{try_case,_}=I|Is], _, D, Acc) ->
live_opt(Is, live_call(1), D, [I|Acc]);
live_opt([{loop_rec,_Fail,_Dst}=I|Is], _, D, Acc) ->
@@ -860,14 +848,7 @@ x_live([], Regs) -> Regs.
is_live(X, Regs) -> ((Regs bsr X) band 1) =:= 1.
-%% split_even/1
-%% [1,2,3,4,5,6] -> {[1,3,5],[2,4,6]}
-split_even(Rs) -> split_even(Rs,[],[]).
-split_even([],Ss,Ds) -> {reverse(Ss),reverse(Ds)};
-split_even([S,D|Rs],Ss,Ds) ->
- split_even(Rs,[S|Ss],[D|Ds]).
-
-%% join_even/1
-%% {[1,3,5],[2,4,6]} -> [1,2,3,4,5,6]
-join_even([],[]) -> [];
-join_even([S|Ss],[D|Ds]) -> [S,D|join_even(Ss,Ds)].
+split_even([], Ss, Ds) ->
+ {reverse(Ss),reverse(Ds)};
+split_even([S,D|Rs], Ss, Ds) ->
+ split_even(Rs, [S|Ss], [D|Ds]).
diff --git a/lib/compiler/src/core_pp.erl b/lib/compiler/src/core_pp.erl
index f34a5c034f..67209d06be 100644
--- a/lib/compiler/src/core_pp.erl
+++ b/lib/compiler/src/core_pp.erl
@@ -33,8 +33,7 @@
%% Prettyprint-formats (naively) an abstract Core Erlang syntax
%% tree.
--record(ctxt, {class = term :: 'clause' | 'def' | 'expr' | 'term',
- indent = 0 :: integer(),
+-record(ctxt, {indent = 0 :: integer(),
item_indent = 2 :: integer(),
body_indent = 4 :: integer(),
line = 0 :: integer(),
@@ -132,14 +131,11 @@ format_1(#c_literal{anno=A,val=Bitstring}, Ctxt) when is_bitstring(Bitstring) ->
format_1(#c_binary{anno=A,segments=Segs}, Ctxt);
format_1(#c_literal{anno=A,val=M},Ctxt) when is_map(M) ->
Pairs = maps:to_list(M),
- Op = case Ctxt of
- #ctxt{ class = clause } -> exact;
- _ -> assoc
- end,
- Cpairs = [#c_map_pair{op=#c_literal{val=Op},
+ Op = #c_literal{val=assoc},
+ Cpairs = [#c_map_pair{op=Op,
key=#c_literal{val=K},
val=#c_literal{val=V}} || {K,V} <- Pairs],
- format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt);
+ format_1(#c_map{anno=A,arg=#c_literal{val=#{}},es=Cpairs},Ctxt);
format_1(#c_var{name={I,A}}, _) ->
[core_atom(I),$/,integer_to_list(A)];
format_1(#c_var{name=V}, _) ->
@@ -340,35 +336,30 @@ format_1(#c_module{name=N,exports=Es,attrs=As,defs=Ds}, Ctxt) ->
[Mod," [",
format_vseq(Es,
"", ",",
- add_indent(set_class(Ctxt, term), width(Mod, Ctxt)+2),
+ add_indent(Ctxt, width(Mod, Ctxt)+2),
fun format/2),
"]",
nl_indent(Ctxt),
" attributes [",
format_vseq(As,
"", ",",
- add_indent(set_class(Ctxt, def), 16),
+ add_indent(Ctxt, 16),
fun format_def/2),
"]",
nl_indent(Ctxt),
format_funcs(Ds, Ctxt),
nl_indent(Ctxt)
| "end"
- ];
-format_1(Type, _) ->
- ["** Unsupported type: ",
- io_lib:write(Type)
- | " **"
].
format_funcs(Fs, Ctxt) ->
format_vseq(Fs,
"", "",
- set_class(Ctxt, def),
+ Ctxt,
fun format_def/2).
format_def({N,V}, Ctxt0) ->
- Ctxt1 = add_indent(set_class(Ctxt0, expr), Ctxt0#ctxt.body_indent),
+ Ctxt1 = add_indent(Ctxt0, Ctxt0#ctxt.body_indent),
[format(N, Ctxt0),
" =",
nl_indent(Ctxt1)
@@ -392,8 +383,7 @@ do_format_bitstr(#c_bitstr{val=V,size=S,unit=U,type=T,flags=Fs}, Ctxt0) ->
["#<", Val, ">(", format_hseq(Vs,",", Ctxt2, fun format/2), $)].
format_clauses(Cs, Ctxt) ->
- format_vseq(Cs, "", "", set_class(Ctxt, clause),
- fun format_clause/2).
+ format_vseq(Cs, "", "", Ctxt, fun format_clause/2).
format_clause(Node, Ctxt) ->
maybe_anno(Node, fun format_clause_1/2, Ctxt).
@@ -405,15 +395,13 @@ format_clause_1(#c_clause{pats=Ps,guard=G,body=B}, Ctxt) ->
case is_trivial_guard(G) of
true ->
[" when ",
- format_guard(G, add_indent(set_class(Ctxt, expr),
- width(Ptxt, Ctxt) + 6))];
+ format_guard(G, add_indent(Ctxt, width(Ptxt, Ctxt) + 6))];
false ->
[nl_indent(Ctxt2), "when ",
- format_guard(G, add_indent(set_class(Ctxt2, expr), 2))]
+ format_guard(G, add_indent(Ctxt2, 2))]
end++
" ->",
- nl_indent(Ctxt2)
- | format(B, set_class(Ctxt2, expr))
+ nl_indent(Ctxt2) | format(B, Ctxt2)
].
is_trivial_guard(#c_literal{val=Val}) when is_atom(Val) -> true;
@@ -467,7 +455,7 @@ format_list_tail(Tail, Ctxt) ->
format_map_pair(Op, K, V, Ctxt0) ->
Ctxt1 = add_indent(Ctxt0, 1),
- Txt = format(K, set_class(Ctxt1, expr)),
+ Txt = format(K, Ctxt1),
Ctxt2 = add_indent(Ctxt0, width(Txt, Ctxt1)),
[Txt,Op,format(V, Ctxt2)].
@@ -490,6 +478,7 @@ spaces(5) -> " ";
spaces(6) -> " ";
spaces(7) -> " ".
+%% Undo indentation done by nl_indent/1.
unindent(T, Ctxt) ->
unindent(T, Ctxt#ctxt.indent, []).
@@ -505,18 +494,11 @@ unindent([$\t|T], N, C) ->
unindent([spaces(Tab - N)|T], 0, C)
end;
unindent([L|T], N, C) when is_list(L) ->
- unindent(L, N, [T|C]);
-unindent([H|T], _, C) ->
- [H|[T|C]];
-unindent([], N, [H|T]) ->
- unindent(H, N, T);
-unindent([], _, []) -> [].
+ unindent(L, N, [T|C]).
width(Txt, Ctxt) ->
- try width(Txt, 0, Ctxt, [])
- catch error:_ -> exit({bad_text,Txt})
- end.
+ width(Txt, 0, Ctxt, []).
width([$\t|T], A, Ctxt, C) ->
width(T, A + ?TAB_WIDTH, Ctxt, C);
@@ -533,14 +515,9 @@ width([], A, _, []) -> A.
add_indent(Ctxt, Dx) ->
Ctxt#ctxt{indent = Ctxt#ctxt.indent + Dx}.
-set_class(Ctxt, Class) ->
- Ctxt#ctxt{class = Class}.
-
core_atom(A) -> io_lib:write_string(atom_to_list(A), $').
-is_simple_term(#c_values{es=Es}) ->
- length(Es) < 3 andalso lists:all(fun is_simple_term/1, Es);
is_simple_term(#c_tuple{es=Es}) ->
length(Es) < 4 andalso lists:all(fun is_simple_term/1, Es);
is_simple_term(#c_var{}) -> true;
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index b5b8d8a8ec..dbc27db377 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -374,10 +374,21 @@ expr(#c_receive{clauses=Cs0,timeout=T0,action=A0}=Recv, Ctxt, Sub) ->
T1 = expr(T0, value, Sub),
A1 = body(A0, Ctxt, Sub),
Recv#c_receive{clauses=Cs1,timeout=T1,action=A1};
-expr(#c_apply{op=Op0,args=As0}=App, _, Sub) ->
+expr(#c_apply{anno=Anno,op=Op0,args=As0}=App, _, Sub) ->
Op1 = expr(Op0, value, Sub),
As1 = expr_list(As0, value, Sub),
- App#c_apply{op=Op1,args=As1};
+ case Op1 of
+ #c_var{} ->
+ App#c_apply{op=Op1,args=As1};
+ _ ->
+ add_warning(App, invalid_call),
+ Err = #c_call{anno=Anno,
+ module=#c_literal{val=erlang},
+ name=#c_literal{val=error},
+ args=[#c_tuple{es=[#c_literal{val='badfun'},
+ Op1]}]},
+ make_effect_seq(As1++[Err], Sub)
+ end;
expr(#c_call{module=M0,name=N0}=Call0, Ctxt, Sub) ->
M1 = expr(M0, value, Sub),
N1 = expr(N0, value, Sub),
@@ -3395,6 +3406,8 @@ format_error({no_effect,{erlang,F,A}}) ->
format_error(result_ignored) ->
"the result of the expression is ignored "
"(suppress the warning by assigning the expression to the _ variable)";
+format_error(invalid_call) ->
+ "invalid function call";
format_error(useless_building) ->
"a term is constructed, but never used";
format_error(bin_opt_alias) ->
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index 4a6330fce4..402e3c4912 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -1,7 +1,7 @@
%%
%% %CopyrightBegin%
%%
-%% Copyright Ericsson AB 1999-2015. All Rights Reserved.
+%% 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.
@@ -147,6 +147,7 @@ include_attribute(callback) -> false;
include_attribute(opaque) -> false;
include_attribute(export_type) -> false;
include_attribute(record) -> false;
+include_attribute(optional_callbacks) -> false;
include_attribute(_) -> true.
function({#c_var{name={F,Arity}=FA},Body}, St0) ->
diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile
index 85118502e3..203a50db55 100644
--- a/lib/compiler/test/Makefile
+++ b/lib/compiler/test/Makefile
@@ -9,6 +9,7 @@ MODULES= \
andor_SUITE \
apply_SUITE \
beam_block_SUITE \
+ beam_bool_SUITE \
beam_validator_SUITE \
beam_disasm_SUITE \
beam_except_SUITE \
@@ -46,6 +47,7 @@ NO_OPT= \
andor \
apply \
beam_block \
+ beam_bool \
beam_except \
beam_reorder \
beam_type \
@@ -70,6 +72,7 @@ INLINE= \
andor \
apply \
beam_block \
+ beam_bool \
beam_utils \
bs_bincomp \
bs_bit_binaries \
diff --git a/lib/compiler/test/andor_SUITE.erl b/lib/compiler/test/andor_SUITE.erl
index f6e7b09010..05c087104d 100644
--- a/lib/compiler/test/andor_SUITE.erl
+++ b/lib/compiler/test/andor_SUITE.erl
@@ -22,8 +22,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_case/1,t_and_or/1,t_andalso/1,t_orelse/1,inside/1,overlap/1,
- combined/1,in_case/1,before_and_inside_if/1,
- slow_compilation/1]).
+ combined/1,in_case/1,slow_compilation/1]).
-include_lib("common_test/include/ct.hrl").
@@ -36,7 +35,7 @@ all() ->
groups() ->
[{p,[parallel],
[t_case,t_and_or,t_andalso,t_orelse,inside,overlap,
- combined,in_case,before_and_inside_if]}].
+ combined,in_case,slow_compilation]}].
init_per_suite(Config) ->
Config.
@@ -450,64 +449,6 @@ in_case_1_guard(LenUp, LenDw, LenN, Rotation, Count) ->
false -> loop
end.
-before_and_inside_if(Config) when is_list(Config) ->
- no = before_and_inside_if([a], [b], delete),
- no = before_and_inside_if([a], [b], x),
- no = before_and_inside_if([a], [], delete),
- no = before_and_inside_if([a], [], x),
- no = before_and_inside_if([], [], delete),
- yes = before_and_inside_if([], [], x),
- yes = before_and_inside_if([], [b], delete),
- yes = before_and_inside_if([], [b], x),
-
- {ch1,ch2} = before_and_inside_if_2([a], [b], blah),
- {ch1,ch2} = before_and_inside_if_2([a], [b], xx),
- {ch1,ch2} = before_and_inside_if_2([a], [], blah),
- {ch1,ch2} = before_and_inside_if_2([a], [], xx),
- {no,no} = before_and_inside_if_2([], [b], blah),
- {no,no} = before_and_inside_if_2([], [b], xx),
- {ch1,no} = before_and_inside_if_2([], [], blah),
- {no,ch2} = before_and_inside_if_2([], [], xx),
- ok.
-
-%% Thanks to Simon Cornish and Kostis Sagonas.
-%% Used to crash beam_bool.
-before_and_inside_if(XDo1, XDo2, Do3) ->
- Do1 = (XDo1 =/= []),
- Do2 = (XDo2 =/= []),
- if
- %% This expression occurs in a try/catch (protected)
- %% block, which cannot refer to variables outside of
- %% the block that are boolean expressions.
- Do1 =:= true;
- Do1 =:= false, Do2 =:= false, Do3 =:= delete ->
- no;
- true ->
- yes
- end.
-
-%% Thanks to Simon Cornish.
-%% Used to generate code that would not set {y,0} on
-%% all paths before its use (and therefore fail
-%% validation by the beam_validator).
-before_and_inside_if_2(XDo1, XDo2, Do3) ->
- Do1 = (XDo1 =/= []),
- Do2 = (XDo2 =/= []),
- CH1 = if Do1 == true;
- Do1 == false,Do2==false,Do3 == blah ->
- ch1;
- true ->
- no
- end,
- CH2 = if Do1 == true;
- Do1 == false,Do2==false,Do3 == xx ->
- ch2;
- true ->
- no
- end,
- {CH1,CH2}.
-
-
-record(state, {stack = []}).
slow_compilation(_) ->
diff --git a/lib/compiler/test/beam_block_SUITE.erl b/lib/compiler/test/beam_block_SUITE.erl
index 81f8d10687..d343e26737 100644
--- a/lib/compiler/test/beam_block_SUITE.erl
+++ b/lib/compiler/test/beam_block_SUITE.erl
@@ -35,7 +35,8 @@ all() ->
groups() ->
[{p,[parallel],
- [get_map_elements
+ [get_map_elements,
+ otp_7345
]}].
init_per_suite(Config) ->
diff --git a/lib/compiler/test/beam_bool_SUITE.erl b/lib/compiler/test/beam_bool_SUITE.erl
new file mode 100644
index 0000000000..84d634e5ca
--- /dev/null
+++ b/lib/compiler/test/beam_bool_SUITE.erl
@@ -0,0 +1,160 @@
+%%
+%% %CopyrightBegin%
+%%
+%% Copyright Ericsson AB 2015-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(beam_bool_SUITE).
+
+-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1,
+ init_per_group/2,end_per_group/2,
+ before_and_inside_if/1,
+ scotland/1,y_registers/1]).
+
+suite() ->
+ [{ct_hooks,[ts_install_cth]}].
+
+all() ->
+ test_lib:recompile(?MODULE),
+ [{group,p}].
+
+groups() ->
+ [{p,[parallel],
+ [before_and_inside_if,
+ scotland,
+ y_registers
+ ]}].
+
+init_per_suite(Config) ->
+ Config.
+
+end_per_suite(_Config) ->
+ ok.
+
+init_per_group(_GroupName, Config) ->
+ Config.
+
+end_per_group(_GroupName, Config) ->
+ Config.
+
+before_and_inside_if(_Config) ->
+ no = before_and_inside_if([a], [b], delete),
+ no = before_and_inside_if([a], [b], x),
+ no = before_and_inside_if([a], [], delete),
+ no = before_and_inside_if([a], [], x),
+ no = before_and_inside_if([], [], delete),
+ yes = before_and_inside_if([], [], x),
+ yes = before_and_inside_if([], [b], delete),
+ yes = before_and_inside_if([], [b], x),
+
+ {ch1,ch2} = before_and_inside_if_2([a], [b], blah),
+ {ch1,ch2} = before_and_inside_if_2([a], [b], xx),
+ {ch1,ch2} = before_and_inside_if_2([a], [], blah),
+ {ch1,ch2} = before_and_inside_if_2([a], [], xx),
+ {no,no} = before_and_inside_if_2([], [b], blah),
+ {no,no} = before_and_inside_if_2([], [b], xx),
+ {ch1,no} = before_and_inside_if_2([], [], blah),
+ {no,ch2} = before_and_inside_if_2([], [], xx),
+ ok.
+
+%% Thanks to Simon Cornish and Kostis Sagonas.
+%% Used to crash beam_bool.
+before_and_inside_if(XDo1, XDo2, Do3) ->
+ Do1 = (XDo1 =/= []),
+ Do2 = (XDo2 =/= []),
+ if
+ %% This expression occurs in a try/catch (protected)
+ %% block, which cannot refer to variables outside of
+ %% the block that are boolean expressions.
+ Do1 =:= true;
+ Do1 =:= false, Do2 =:= false, Do3 =:= delete ->
+ no;
+ true ->
+ yes
+ end.
+
+%% Thanks to Simon Cornish.
+%% Used to generate code that would not set {y,0} on
+%% all paths before its use (and therefore fail
+%% validation by the beam_validator).
+before_and_inside_if_2(XDo1, XDo2, Do3) ->
+ Do1 = (XDo1 =/= []),
+ Do2 = (XDo2 =/= []),
+ CH1 = if Do1 == true;
+ Do1 == false,Do2==false,Do3 == blah ->
+ ch1;
+ true ->
+ no
+ end,
+ CH2 = if Do1 == true;
+ Do1 == false,Do2==false,Do3 == xx ->
+ ch2;
+ true ->
+ no
+ end,
+ {CH1,CH2}.
+
+
+%% beam_bool would remove the initialization of {y,0}.
+%% (Thanks to Thomas Arts and QuickCheck.)
+
+scotland(_Config) ->
+ million = do_scotland(placed),
+ {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(false)),
+ {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(true)),
+ {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(echo)),
+ ok.
+
+do_scotland(Echo) ->
+ found(case Echo of
+ Echo when true; Echo, Echo, Echo ->
+ Echo;
+ echo ->
+ []
+ end,
+ Echo = placed).
+
+found(_, _) -> million.
+
+
+%% ERL-143: beam_bool could not handle Y registers as a destination.
+y_registers(_Config) ->
+ {'EXIT',{badarith,[_|_]}} = (catch baker(valentine)),
+ {'EXIT',{badarith,[_|_]}} = (catch baker(clementine)),
+
+ {not_ok,true} = potter([]),
+ {ok,false} = potter([{encoding,any}]),
+
+ ok.
+
+%% Thanks to Quickcheck.
+baker(Baker) ->
+ (valentine == Baker) +
+ case Baker of
+ Baker when Baker; Baker ->
+ Baker;
+ Baker ->
+ []
+ end.
+
+%% Thanks to Jose Valim.
+potter(Modes) ->
+ Raw = lists:keyfind(encoding, 1, Modes) == false,
+ Final = case Raw of
+ X when X == false; X == nil -> ok;
+ _ -> not_ok
+ end,
+ {Final,Raw}.
diff --git a/lib/compiler/test/compile_SUITE.erl b/lib/compiler/test/compile_SUITE.erl
index e634f0fcc2..a15efc2a00 100644
--- a/lib/compiler/test/compile_SUITE.erl
+++ b/lib/compiler/test/compile_SUITE.erl
@@ -693,8 +693,7 @@ core(Config) when is_list(Config) ->
Outdir = filename:join(PrivDir, "core"),
ok = file:make_dir(Outdir),
- Wc = filename:join(filename:dirname(code:which(?MODULE)), "*.beam"),
- TestBeams = filelib:wildcard(Wc),
+ TestBeams = get_unique_beam_files(),
Abstr = [begin {ok,{Mod,[{abstract_code,
{raw_abstract_v1,Abstr}}]}} =
beam_lib:chunks(Beam, [abstract_code]),
@@ -755,8 +754,7 @@ core_roundtrip(Config) ->
Outdir = filename:join(PrivDir, atom_to_list(?FUNCTION_NAME)),
ok = file:make_dir(Outdir),
- Wc = filename:join(filename:dirname(code:which(?MODULE)), "*.beam"),
- TestBeams = filelib:wildcard(Wc),
+ TestBeams = get_unique_beam_files(),
test_lib:p_run(fun(F) -> do_core_roundtrip(F, Outdir) end, TestBeams).
do_core_roundtrip(Beam, Outdir) ->
@@ -781,8 +779,13 @@ do_core_roundtrip_1(Mod, Abstr, Outdir) ->
%% Primarily, test that annotations are accepted for all
%% constructs. Secondarily, smoke test cerl_trees:label/1.
- {Core,_} = cerl_trees:label(Core0),
- do_core_roundtrip_2(Mod, Core, Outdir).
+ {Core1,_} = cerl_trees:label(Core0),
+ do_core_roundtrip_2(Mod, Core1, Outdir),
+
+ %% Run the inliner to force generation of variables
+ %% with numeric names.
+ {ok,Mod,Core2} = compile:forms(Abstr, [inline,to_core]),
+ do_core_roundtrip_2(Mod, Core2, Outdir).
do_core_roundtrip_2(M, Core0, Outdir) ->
CoreFile = filename:join(Outdir, atom_to_list(M)++".core"),
@@ -870,8 +873,7 @@ asm(Config) when is_list(Config) ->
Outdir = filename:join(PrivDir, "asm"),
ok = file:make_dir(Outdir),
- Wc = filename:join(filename:dirname(code:which(?MODULE)), "*.beam"),
- TestBeams = filelib:wildcard(Wc),
+ TestBeams = get_unique_beam_files(),
Res = test_lib:p_run(fun(F) -> do_asm(F, Outdir) end, TestBeams),
Res.
@@ -947,8 +949,7 @@ dialyzer(Config) ->
%% Test that warnings contain filenames and line numbers.
warnings(_Config) ->
- TestDir = filename:dirname(code:which(?MODULE)),
- Files = filelib:wildcard(filename:join(TestDir, "*.erl")),
+ Files = get_unique_files(".erl"),
test_lib:p_run(fun do_warnings/1, Files).
do_warnings(F) ->
@@ -1102,3 +1103,14 @@ compile_and_verify(Name, Target, Opts) ->
beam_lib:chunks(Target, [compile_info]),
{options,BeamOpts} = lists:keyfind(options, 1, CInfo),
Opts = BeamOpts.
+
+get_unique_beam_files() ->
+ get_unique_files(".beam").
+
+get_unique_files(Ext) ->
+ Wc = filename:join(filename:dirname(code:which(?MODULE)), "*"++Ext),
+ [F || F <- filelib:wildcard(Wc), not is_cloned(F, Ext)].
+
+is_cloned(File, Ext) ->
+ Mod = list_to_atom(filename:basename(File, Ext)),
+ test_lib:is_cloned_mod(Mod).
diff --git a/lib/compiler/test/fun_SUITE.erl b/lib/compiler/test/fun_SUITE.erl
index 17ff8601d9..16474adf5b 100644
--- a/lib/compiler/test/fun_SUITE.erl
+++ b/lib/compiler/test/fun_SUITE.erl
@@ -22,7 +22,7 @@
-export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1,
init_per_group/2,end_per_group/2,
test1/1,overwritten_fun/1,otp_7202/1,bif_fun/1,
- external/1,eep37/1,eep37_dup/1,badarity/1]).
+ external/1,eep37/1,eep37_dup/1,badarity/1,badfun/1]).
%% Internal exports.
-export([call_me/1,dup1/0,dup2/0]).
@@ -33,10 +33,12 @@ suite() -> [{ct_hooks,[ts_install_cth]}].
all() ->
test_lib:recompile(?MODULE),
- [test1,overwritten_fun,otp_7202,bif_fun,external,eep37,eep37_dup,badarity].
+ [{group,p}].
-groups() ->
- [].
+groups() ->
+ [{p,[parallel],
+ [test1,overwritten_fun,otp_7202,bif_fun,external,eep37,
+ eep37_dup,badarity,badfun]}].
init_per_suite(Config) ->
Config.
@@ -221,5 +223,25 @@ badarity(Config) when is_list(Config) ->
{'EXIT',{{badarity,{_,[]}},_}} = (catch (fun badarity/1)()),
ok.
+badfun(_Config) ->
+ X = not_a_fun,
+ expect_badfun(42, catch 42()),
+ expect_badfun(42.0, catch 42.0(1)),
+ expect_badfun(X, catch X()),
+ expect_badfun(X, catch X(1)),
+ Len = length(atom_to_list(X)),
+ expect_badfun(Len, catch begin length(atom_to_list(X)) end(1)),
+
+ expect_badfun(42, catch 42(put(?FUNCTION_NAME, yes))),
+ yes = erase(?FUNCTION_NAME),
+
+ expect_badfun(X, catch X(put(?FUNCTION_NAME, of_course))),
+ of_course = erase(?FUNCTION_NAME),
+
+ ok.
+
+expect_badfun(Term, Exit) ->
+ {'EXIT',{{badfun,Term},_}} = Exit.
+
id(I) ->
I.
diff --git a/lib/compiler/test/guard_SUITE.erl b/lib/compiler/test/guard_SUITE.erl
index 13d274d98a..83298e546e 100644
--- a/lib/compiler/test/guard_SUITE.erl
+++ b/lib/compiler/test/guard_SUITE.erl
@@ -34,7 +34,7 @@
tricky/1,rel_ops/1,rel_op_combinations/1,literal_type_tests/1,
basic_andalso_orelse/1,traverse_dcd/1,
check_qlc_hrl/1,andalso_semi/1,t_tuple_size/1,binary_part/1,
- bad_constants/1,bad_guards/1,scotland/1,
+ bad_constants/1,bad_guards/1,
guard_in_catch/1]).
suite() -> [{ct_hooks,[ts_install_cth]}].
@@ -54,7 +54,7 @@ groups() ->
rel_ops,rel_op_combinations,
literal_type_tests,basic_andalso_orelse,traverse_dcd,
check_qlc_hrl,andalso_semi,t_tuple_size,binary_part,
- bad_constants,bad_guards,scotland,guard_in_catch]}].
+ bad_constants,bad_guards,guard_in_catch]}].
init_per_suite(Config) ->
Config.
@@ -1852,27 +1852,6 @@ bad_guards_2(M, [_]) when M#{a := 0, b => 0}, map_size(M) ->
bad_guards_3(M, [_]) when is_map(M) andalso M#{a := 0, b => 0}, length(M) ->
ok.
-%% beam_bool would remove the initialization of {y,0}.
-%% (Thanks to Thomas Arts and QuickCheck.)
-
-scotland(_Config) ->
- million = do_scotland(placed),
- {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(false)),
- {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(true)),
- {'EXIT',{{badmatch,placed},_}} = (catch do_scotland(echo)),
- ok.
-
-do_scotland(Echo) ->
- found(case Echo of
- Echo when true; Echo, Echo, Echo ->
- Echo;
- echo ->
- []
- end,
- Echo = placed).
-
-found(_, _) -> million.
-
%% Building maps in a guard in a 'catch' would crash v3_codegen.
guard_in_catch(_Config) ->
diff --git a/lib/compiler/test/test_lib.erl b/lib/compiler/test/test_lib.erl
index d141d86021..d5b79e2357 100644
--- a/lib/compiler/test/test_lib.erl
+++ b/lib/compiler/test/test_lib.erl
@@ -22,7 +22,7 @@
-include_lib("common_test/include/ct.hrl").
-compile({no_auto_import,[binary_part/2]}).
-export([id/1,recompile/1,parallel/0,uniq/0,opt_opts/1,get_data_dir/1,
- smoke_disasm/1,p_run/2,binary_part/2]).
+ is_cloned_mod/1,smoke_disasm/1,p_run/2,binary_part/2]).
id(I) -> I.
@@ -91,6 +91,17 @@ get_data_dir(Config) ->
Data = re:replace(Data1, "_post_opt_SUITE", "_SUITE", Opts),
re:replace(Data, "_inline_SUITE", "_SUITE", Opts).
+is_cloned_mod(Mod) ->
+ is_cloned_mod_1(atom_to_list(Mod)).
+
+%% Test whether Mod is a cloned module.
+
+is_cloned_mod_1("no_opt_SUITE") -> true;
+is_cloned_mod_1("post_opt_SUITE") -> true;
+is_cloned_mod_1("inline_SUITE") -> true;
+is_cloned_mod_1([_|T]) -> is_cloned_mod_1(T);
+is_cloned_mod_1([]) -> false.
+
%% p_run(fun(Data) -> ok|error, List) -> ok
%% Will fail the test case if there were any errors.
@@ -106,8 +117,9 @@ p_run(Test, List) ->
%% slightly faster than using 3. Using more than
%% 4 would not buy us much and could actually be
%% slower.
- max(S, 4)
+ min(S, 4)
end,
+ io:format("p_run: ~p parallel processes\n", [N]),
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 f7ad78cb8d..a591d6cc93 100644
--- a/lib/compiler/test/trycatch_SUITE.erl
+++ b/lib/compiler/test/trycatch_SUITE.erl
@@ -1034,6 +1034,9 @@ grab_bag(_Config) ->
end
end,
+ %% Unnecessary catch.
+ 22 = (catch 22),
+
ok.
generated by cgit v1.2.3 (git 2.25.1) at 2024-07-21 08:52:26 +0000