diff options
Diffstat (limited to 'lib/compiler')
36 files changed, 1159 insertions, 373 deletions
diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index f9a08f8718..99e4ccb1e9 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]) @@ -311,6 +311,8 @@ dst_regs([{set,[D],_,{bif,_,{f,_}}}|Is], Acc) -> dst_regs(Is, [D|Acc]); dst_regs([{set,[D],_,{alloc,_,{gc_bif,_,{f,_}}}}|Is], Acc) -> dst_regs(Is, [D|Acc]); +dst_regs([{protected,_,Bl,_}|Is], Acc) -> + dst_regs(Bl, dst_regs(Is, Acc)); dst_regs([_|Is], Acc) -> dst_regs(Is, Acc); dst_regs([], Acc) -> ordsets:from_list(Acc). diff --git a/lib/compiler/src/beam_dead.erl b/lib/compiler/src/beam_dead.erl index dd42add433..b01f58f683 100644 --- a/lib/compiler/src/beam_dead.erl +++ b/lib/compiler/src/beam_dead.erl @@ -262,7 +262,7 @@ backward([{select,select_val,Reg,{f,Fail0},List0}|Is], D, Acc) -> backward([{jump,{f,To0}},{move,Src,Reg}=Move|Is], D, Acc) -> To = shortcut_select_label(To0, Reg, Src, D), Jump = {jump,{f,To}}, - case beam_utils:is_killed_at(Reg, To, D) of + case is_killed_at(Reg, To, D) of false -> backward([Move|Is], D, [Jump|Acc]); true -> backward([Jump|Is], D, Acc) end; @@ -420,7 +420,7 @@ comp_op_find_shortcut(To0, Reg, Val, D) -> To0 -> not_possible(); To -> - case beam_utils:is_killed_at(Reg, To, D) of + case is_killed_at(Reg, To, D) of false -> not_possible(); true -> To end @@ -863,3 +863,17 @@ get_literal(nil) -> get_literal({literal,_}=Lit) -> Lit; get_literal({_,_}) -> error. + + +%%% +%%% Removing stores to Y registers is not always safe +%%% if there is an instruction that causes an exception +%%% within a catch. In practice, there are few or no +%%% opportunities for removing stores to Y registers anyway +%%% if sys_core_fold has been run. +%%% + +is_killed_at({x,_}=Reg, Lbl, D) -> + beam_utils:is_killed_at(Reg, Lbl, D); +is_killed_at({y,_}, _, _) -> + false. diff --git a/lib/compiler/src/beam_disasm.erl b/lib/compiler/src/beam_disasm.erl index 5badcce696..c699672db1 100644 --- a/lib/compiler/src/beam_disasm.erl +++ b/lib/compiler/src/beam_disasm.erl @@ -314,10 +314,7 @@ get_funs({LsR0,[{func_info,[{atom,M}=AtomM,{atom,F}=AtomF,ArityArg]}|Code0]}) when is_atom(M), is_atom(F) -> Arity = resolve_arg_unsigned(ArityArg), {LsR,Code,RestCode} = get_fun(Code0, []), - Entry = case Code of - [{label,[{u,E}]}|_] -> E; - _ -> undefined - end, + [{label,[{u,Entry}]}|_] = Code, [#function{name=F, arity=Arity, entry=Entry, diff --git a/lib/compiler/src/beam_disasm.hrl b/lib/compiler/src/beam_disasm.hrl index e18214644f..d968cd9587 100644 --- a/lib/compiler/src/beam_disasm.hrl +++ b/lib/compiler/src/beam_disasm.hrl @@ -22,7 +22,9 @@ %% the system (e.g. in the translation from Beam to Icode). %% -%% XXX: THE FOLLOWING TYPE DECLARATION DOES NOT BELONG HERE... +%% XXX: THE FOLLOWING TYPE DECLARATION DOES NOT BELONG HERE. +%% IT SHOULD BE MOVED TO A FILE THAT DEFINES (AND EXPORTS) +%% PROPER TYPES FOR THE SET OF BEAM INSTRUCTIONS. %% -type beam_instr() :: 'bs_init_writable' | 'fclearerror' | 'if_end' | 'remove_message' | 'return' | 'send' | 'timeout' @@ -34,7 +36,7 @@ -record(function, {name :: atom(), arity :: byte(), - entry, %% unused ?? + entry :: beam_lib:label(), %% unnecessary ? code = [] :: [beam_instr()]}). -record(beam_file, {module :: module(), diff --git a/lib/compiler/src/beam_except.erl b/lib/compiler/src/beam_except.erl index cb3a6b79de..4a181c1923 100644 --- a/lib/compiler/src/beam_except.erl +++ b/lib/compiler/src/beam_except.erl @@ -133,10 +133,12 @@ translate_exception(_, _, _, _) -> no. fix_block(Is, 0) -> reverse(Is); fix_block(Is, Words) -> - fix_block_1(reverse(Is), Words). + reverse(fix_block_1(Is, Words)). -fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is], Words) -> - [{set,[],[],{alloc,Live,{F1,F2,Needed-Words,F3}}}|Is]; +fix_block_1([{set,[],[],{alloc,Live,{F1,F2,Needed0,F3}}}|Is], Words) -> + Needed = Needed0 - Words, + true = Needed >= 0, %Assertion. + [{set,[],[],{alloc,Live,{F1,F2,Needed,F3}}}|Is]; fix_block_1([I|Is], Words) -> [I|fix_block_1(Is, Words)]. diff --git a/lib/compiler/src/beam_jump.erl b/lib/compiler/src/beam_jump.erl index 359248c6af..09cd3aa2d4 100644 --- a/lib/compiler/src/beam_jump.erl +++ b/lib/compiler/src/beam_jump.erl @@ -266,17 +266,17 @@ extract_seq_1(_, _) -> no. %%% (3) (4) (5) (6) Jump and unreachable code optimizations. %%% --record(st, {fc, %Label for function class errors. - entry, %Entry label (must not be moved). - mlbl, %Moved labels. - labels :: cerl_sets:set() %Set of referenced labels. - }). - -opt([{label,Fc}|_]=Is0, CLabel) -> - Lbls = initial_labels(Is0), +-record(st, + { + entry, %Entry label (must not be moved). + mlbl, %Moved labels. + labels :: cerl_sets:set() %Set of referenced labels. + }). + +opt(Is0, CLabel) -> find_fixpoint(fun(Is) -> - St = #st{fc=Fc,entry=CLabel,mlbl=#{}, - labels=Lbls}, + Lbls = initial_labels(Is), + St = #st{entry=CLabel,mlbl=#{},labels=Lbls}, opt(Is, [], St) end, Is0). @@ -327,7 +327,8 @@ opt([{label,Lbl}=I|Is], Acc, #st{mlbl=Mlbl}=St0) -> %% since we will rescan the inserted labels. We MUST rescan. St = St0#st{mlbl=maps:remove(Lbl, Mlbl)}, insert_labels([Lbl|Lbls], Is, Acc, St); - error -> opt(Is, [I|Acc], St0) + error -> + opt(Is, [I|Acc], St0) end; opt([{jump,{f,_}=X}|[{label,_},{jump,X}|_]=Is], Acc, St) -> opt(Is, Acc, St); @@ -362,12 +363,19 @@ opt([I|Is], Acc, #st{labels=Used0}=St0) -> true -> skip_unreachable(Is, [I|Acc], St); false -> opt(Is, [I|Acc], St) end; -opt([], Acc, #st{fc=Fc,mlbl=Mlbl}) -> +opt([], Acc, #st{mlbl=Mlbl}) -> Code = reverse(Acc), - case maps:find(Fc, Mlbl) of - {ok,Lbls} -> insert_fc_labels(Lbls, Mlbl, Code); - error -> Code - end. + insert_fc_labels(Code, Mlbl). + +insert_fc_labels([{label,L}=I|Is0], Mlbl) -> + case maps:find(L, Mlbl) of + error -> + [I|insert_fc_labels(Is0, Mlbl)]; + {ok,Lbls} -> + Is = [{label,Lb} || Lb <- Lbls] ++ Is0, + [I|insert_fc_labels(Is, maps:remove(L, Mlbl))] + end; +insert_fc_labels([_|_]=Is, _) -> Is. maps_append_list(K,Vs,M) -> case M of @@ -375,16 +383,6 @@ maps_append_list(K,Vs,M) -> _ -> M#{K => Vs} end. -insert_fc_labels([L|Ls], Mlbl, Acc0) -> - Acc = [{label,L}|Acc0], - case maps:find(L, Mlbl) of - error -> - insert_fc_labels(Ls, Mlbl, Acc); - {ok,Lbls} -> - insert_fc_labels(Lbls++Ls, Mlbl, Acc) - end; -insert_fc_labels([], _, Acc) -> Acc. - collect_labels(Is, #st{entry=Entry}) -> collect_labels_1(Is, Entry, []). diff --git a/lib/compiler/src/beam_receive.erl b/lib/compiler/src/beam_receive.erl index c593184746..89cafe27ce 100644 --- a/lib/compiler/src/beam_receive.erl +++ b/lib/compiler/src/beam_receive.erl @@ -177,7 +177,8 @@ opt_recv([I|Is], D, R0, L0, Acc) -> no; false -> opt_recv(Is, D, R, L, [I|Acc]) - end. + end; +opt_recv([], _, _, _, _) -> no. opt_update_regs({block,Bl}, R, L) -> {opt_update_regs_bl(Bl, R),L}; diff --git a/lib/compiler/src/beam_reorder.erl b/lib/compiler/src/beam_reorder.erl index f1c0b3ef91..6a7c033ec6 100644 --- a/lib/compiler/src/beam_reorder.erl +++ b/lib/compiler/src/beam_reorder.erl @@ -87,6 +87,15 @@ reorder_1([{test,_,_,_}=I, %% instruction between the test instruction and the select %% instruction. reorder_1(Is, D, [S,I|Acc]); +reorder_1([{test,_,{f,_},[Src|_]}=I|Is], D, + [{get_tuple_element,Src,_,_}|_]=Acc) -> + %% We want to avoid code that can confuse beam_validator such as: + %% is_tuple Fail Src + %% test_arity Fail Src Arity + %% is_map Fail Src + %% get_tuple_element Src Pos Dst + %% Therefore, don't reorder the instructions in such cases. + reorder_1(Is, D, [I|Acc]); reorder_1([{test,_,{f,L},Ss}=I|Is0], D0, [{get_tuple_element,_,_,El}=G|Acc0]=Acc) -> case member(El, Ss) of diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 5076c5eb96..acaf3ede66 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -513,12 +513,23 @@ update({call_ext,Ar,{extfunc,math,Math,Ar}}, Ts) -> false -> tdb_kill_xregs(Ts) end; update({call_ext,3,{extfunc,erlang,setelement,3}}, Ts0) -> - Op = case tdb_find({x,1}, Ts0) of - error -> kill; - Info -> Info - end, - Ts1 = tdb_kill_xregs(Ts0), - tdb_update([{{x,0},Op}], Ts1); + Ts = tdb_kill_xregs(Ts0), + case tdb_find({x,1}, Ts0) of + {tuple,Sz,_}=T0 -> + T = case tdb_find({x,0}, Ts0) of + {integer,{I,I}} when I > 1 -> + %% First element is not changed. The result + %% will have the same type. + T0; + _ -> + %% Position is 1 or unknown. May change the + %% first element of the tuple. + {tuple,Sz,[]} + end, + tdb_update([{{x,0},T}], Ts); + _ -> + Ts + end; update({call,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); update({call_ext,_Arity,_Func}, Ts) -> tdb_kill_xregs(Ts); update({make_fun2,_,_,_,_}, Ts) -> tdb_kill_xregs(Ts); @@ -748,7 +759,7 @@ checkerror_2(OrigIs) -> [{set,[],[],fcheckerror}|OrigIs]. %%% %%% {tuple,Size,First} means that the corresponding register contains a %%% tuple with *at least* Size elements. An tuple with unknown -%%% size is represented as {tuple,0}. First is either [] (meaning that +%%% size is represented as {tuple,0,[]}. First is either [] (meaning that %%% the tuple's first element is unknown) or [FirstElement] (the contents %%% of the first element). %%% @@ -785,21 +796,45 @@ tdb_copy({Tag,_}=S, D, Ts) when Tag =:= x; Tag =:= y -> error -> orddict:erase(D, Ts); Type -> orddict:store(D, Type, Ts) end; -tdb_copy(Literal, D, Ts) -> orddict:store(D, Literal, Ts). +tdb_copy(Literal, D, Ts) -> + Type = case Literal of + {atom,_} -> Literal; + {float,_} -> float; + {integer,Int} -> {integer,{Int,Int}}; + {literal,[_|_]} -> nonempty_list; + {literal,#{}} -> map; + {literal,Tuple} when tuple_size(Tuple) >= 1 -> + Lit = tag_literal(element(1, Tuple)), + {tuple,tuple_size(Tuple),[Lit]}; + _ -> term + end, + if + Type =:= term -> + orddict:erase(D, Ts); + true -> + verify_type(Type), + orddict:store(D, Type, Ts) + end. + +tag_literal(A) when is_atom(A) -> {atom,A}; +tag_literal(F) when is_float(F) -> {float,F}; +tag_literal(I) when is_integer(I) -> {integer,I}; +tag_literal([]) -> nil; +tag_literal(Lit) -> {literal,Lit}. %% tdb_update([UpdateOp], Db) -> NewDb %% UpdateOp = {Register,kill}|{Register,NewInfo} %% Updates a type database. If a 'kill' operation is given, the type %% information for that register will be removed from the database. %% A kill operation takes precedence over other operations for the same -%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5}}] means that the +%% register (i.e. [{{x,0},kill},{{x,0},{tuple,5,[]}}] means that the %% the existing type information, if any, will be discarded, and the -%% the '{tuple,5}' information ignored. +%% the '{tuple,5,[]}' information ignored. %% %% If NewInfo information is given and there exists information about %% the register, the old and new type information will be merged. -%% For instance, {tuple,5} and {tuple,10} will be merged to produce -%% {tuple,10}. +%% For instance, {tuple,5,_} and {tuple,10,_} will be merged to produce +%% {tuple,10,_}. tdb_update(Uis0, Ts0) -> Uis1 = filter(fun ({{x,_},_Op}) -> true; @@ -810,7 +845,8 @@ tdb_update(Uis0, Ts0) -> tdb_update1([{Key,kill}|Ops], [{K,_Old}|_]=Db) when Key < K -> tdb_update1(remove_key(Key, Ops), Db); -tdb_update1([{Key,_New}=New|Ops], [{K,_Old}|_]=Db) when Key < K -> +tdb_update1([{Key,Type}=New|Ops], [{K,_Old}|_]=Db) when Key < K -> + verify_type(Type), [New|tdb_update1(Ops, Db)]; tdb_update1([{Key,kill}|Ops], [{Key,_}|Db]) -> tdb_update1(remove_key(Key, Ops), Db); @@ -820,7 +856,8 @@ tdb_update1([{_,_}|_]=Ops, [Old|Db]) -> [Old|tdb_update1(Ops, Db)]; tdb_update1([{Key,kill}|Ops], []) -> tdb_update1(remove_key(Key, Ops), []); -tdb_update1([{_,_}=New|Ops], []) -> +tdb_update1([{_,Type}=New|Ops], []) -> + verify_type(Type), [New|tdb_update1(Ops, [])]; tdb_update1([], Db) -> Db. @@ -855,6 +892,7 @@ merge_type_info(NewType, _) -> verify_type(NewType), NewType. +verify_type({atom,_}) -> ok; verify_type(boolean) -> ok; verify_type(integer) -> ok; verify_type({integer,{Min,Max}}) diff --git a/lib/compiler/src/beam_utils.erl b/lib/compiler/src/beam_utils.erl index 37f89dd677..a15ecf633e 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}. @@ -175,8 +167,7 @@ bif_to_test(is_record, [_,_,_]=Ops, Fail) -> {test,is_record,Fail,Ops}. %% is_pure_test({test,Op,Fail,Ops}) -> true|false. %% Return 'true' if the test instruction does not modify any -%% registers and/or bit syntax matching state, nor modifies -%% any bit syntax matching state. +%% registers and/or bit syntax matching state. %% is_pure_test({test,is_eq,_,[_,_]}) -> true; is_pure_test({test,is_ne,_,[_,_]}) -> true; @@ -188,6 +179,8 @@ is_pure_test({test,is_nil,_,[_]}) -> true; is_pure_test({test,is_nonempty_list,_,[_]}) -> true; is_pure_test({test,test_arity,_,[_,_]}) -> true; is_pure_test({test,has_map_fields,_,[_|_]}) -> true; +is_pure_test({test,is_bitstr,_,[_]}) -> true; +is_pure_test({test,is_function2,_,[_,_]}) -> true; is_pure_test({test,Op,_,Ops}) -> erl_internal:new_type_test(Op, length(Ops)). @@ -235,21 +228,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); @@ -325,8 +325,11 @@ check_liveness(R, [{deallocate,_}|Is], St) -> {y,_} -> {killed,St}; _ -> check_liveness(R, Is, St) end; -check_liveness(R, [return|_], St) -> - check_liveness_live_ret(R, 1, St); +check_liveness({x,_}=R, [return|_], St) -> + case R of + {x,0} -> {used,St}; + {x,_} -> {killed,St} + end; check_liveness(R, [{call,Live,_}|Is], St) -> case R of {x,X} when X < Live -> {used,St}; @@ -461,8 +464,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 +497,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 +510,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 +530,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. @@ -537,14 +538,6 @@ check_liveness_at(R, Lbl, #live{lbl=Ll,res=ResMemorized}=St0) -> check_liveness_ret(R, R, St) -> {used,St}; check_liveness_ret(_, _, St) -> {killed,St}. -check_liveness_live_ret({x,R}, Live, St) -> - if - R < Live -> {used,St}; - true -> {killed,St} - end; -check_liveness_live_ret({y,_}, _, St) -> - {killed,St}. - check_liveness_fail(_, _, _, 0, St) -> {killed,St}; check_liveness_fail(R, Op, Args, Fail, St) -> @@ -594,8 +587,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 +599,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 +629,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 +745,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 +844,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/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 6877141885..13aa31b7c9 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -161,6 +161,13 @@ validate_0(Module, [{function,Name,Ar,Entry,Code}|Fs], Ft) -> % in the module (those that start with bs_start_match2). }). +%% Match context type. +-record(ms, + {id=make_ref() :: reference(), %Unique ID. + valid=0 :: non_neg_integer(), %Valid slots + slots=0 :: non_neg_integer() %Number of slots + }). + validate_1(Is, Name, Arity, Entry, Ft) -> validate_2(labels(Is), Name, Arity, Entry, Ft). @@ -274,7 +281,7 @@ valfun_1({bs_context_to_binary,Ctx}, #vst{current=#st{x=Xs}}=Vst) -> case Ctx of {Tag,X} when Tag =:= x; Tag =:= y -> Type = case gb_trees:lookup(X, Xs) of - {value,{match_context,_,_}} -> term; + {value,#ms{}} -> term; _ -> get_term_type(Ctx, Vst) end, set_type_reg(Type, Ctx, Vst); @@ -575,7 +582,7 @@ valfun_4({test,bs_start_match2,{f,Fail},Live,[Ctx,NeedSlots],Ctx}, Vst0) -> verify_live(Live, Vst0), Vst1 = prune_x_regs(Live, Vst0), BranchVst = case CtxType of - {match_context,_,_} -> + #ms{} -> %% The failure branch will never be taken when Ctx %% is a match context. Therefore, the type for Ctx %% at the failure label must not be match_context @@ -828,7 +835,7 @@ kill_state_1(Vst) -> %% The stackframe must be initialized. %% The instruction will return to the instruction following the call. call(Name, Live, #vst{current=St}=Vst) -> - verify_live(Live, Vst), + verify_call_args(Name, Live, Vst), verify_y_init(Vst), case return_type(Name, Vst) of Type when Type =/= exception -> @@ -840,44 +847,74 @@ call(Name, Live, #vst{current=St}=Vst) -> %% Tail call. %% The stackframe must have a known size and be initialized. %% Does not return to the instruction following the call. -tail_call(Name, Live, Vst) -> +tail_call(Name, Live, Vst0) -> + verify_y_init(Vst0), + Vst = deallocate(Vst0), verify_call_args(Name, Live, Vst), - verify_y_init(Vst), verify_no_ct(Vst), kill_state(Vst). verify_call_args(_, 0, #vst{}) -> ok; verify_call_args({f,Lbl}, Live, Vst) when is_integer(Live)-> - Verify = fun(R) -> - case get_move_term_type(R, Vst) of - {match_context,_,_} -> - verify_call_match_context(Lbl, Vst); - _ -> - ok - end - end, - verify_call_args_1(Live, Verify, Vst); + verify_local_call(Lbl, Live, Vst); verify_call_args(_, Live, Vst) when is_integer(Live)-> - Verify = fun(R) -> get_term_type(R, Vst) end, - verify_call_args_1(Live, Verify, Vst); + verify_call_args_1(Live, Vst); verify_call_args(_, Live, _) -> error({bad_number_of_live_regs,Live}). -verify_call_args_1(0, _, _) -> ok; -verify_call_args_1(N, Verify, Vst) -> +verify_call_args_1(0, _) -> ok; +verify_call_args_1(N, Vst) -> X = N - 1, - Verify({x,X}), - verify_call_args_1(X, Verify, Vst). + get_term_type({x,X}, Vst), + verify_call_args_1(X, Vst). + +verify_local_call(Lbl, Live, Vst) -> + case all_ms_in_x_regs(Live, Vst) of + [{R,Ctx}] -> + %% Verify that there is a suitable bs_start_match2 instruction. + verify_call_match_context(Lbl, R, Vst), + + %% Since the callee has consumed the match context, + %% there must be no additional copies in Y registers. + #ms{id=Id} = Ctx, + case ms_in_y_regs(Id, Vst) of + [] -> + ok; + [_|_]=Ys -> + error({multiple_match_contexts,[R|Ys]}) + end; + [_,_|_]=Xs0 -> + Xs = [R || {R,_} <- Xs0], + error({multiple_match_contexts,Xs}); + [] -> + ok + end. + +all_ms_in_x_regs(0, _Vst) -> + []; +all_ms_in_x_regs(Live0, Vst) -> + Live = Live0 - 1, + R = {x,Live}, + case get_move_term_type(R, Vst) of + #ms{}=M -> + [{R,M}|all_ms_in_x_regs(Live, Vst)]; + _ -> + all_ms_in_x_regs(Live, Vst) + end. -verify_call_match_context(Lbl, #vst{ft=Ft}) -> +ms_in_y_regs(Id, #vst{current=#st{y=Ys0}}) -> + Ys = gb_trees:to_list(Ys0), + [Y || {Y,#ms{id=OtherId}} <- Ys, OtherId =:= Id]. + +verify_call_match_context(Lbl, Ctx, #vst{ft=Ft}) -> case gb_trees:lookup(Lbl, Ft) of none -> error(no_bs_start_match2); {value,[{test,bs_start_match2,_,_,[Ctx,_],Ctx}|_]} -> ok; - {value,[{test,bs_start_match2,_,_,[Bin,_,_],Ctx}|_]} -> - error({binary_and_context_regs_different,Bin,Ctx}) + {value,[{test,bs_start_match2,_,_,_,_}=I|_]} -> + error({unsuitable_bs_start_match2,I}) end. allocate(Zero, Stk, Heap, Live, #vst{current=#st{numy=none}=St}=Vst0) -> @@ -1009,7 +1046,7 @@ assert_unique_map_keys([_,_|_]=Ls) -> %%% bsm_match_state(Slots) -> - {match_context,0,Slots}. + #ms{slots=Slots}. bsm_validate_context(Reg, Vst) -> _ = bsm_get_context(Reg, Vst), @@ -1017,7 +1054,7 @@ bsm_validate_context(Reg, Vst) -> bsm_get_context({x,X}=Reg, #vst{current=#st{x=Xs}}=_Vst) when is_integer(X) -> case gb_trees:lookup(X, Xs) of - {value,{match_context,_,_}=Ctx} -> Ctx; + {value,#ms{}=Ctx} -> Ctx; _ -> error({no_bsm_context,Reg}) end; bsm_get_context(Reg, _) -> error({bad_source,Reg}). @@ -1029,8 +1066,8 @@ bsm_save(Reg, {atom,start}, Vst) -> Vst; bsm_save(Reg, SavePoint, Vst) -> case bsm_get_context(Reg, Vst) of - {match_context,Bits,Slots} when SavePoint < Slots -> - Ctx = {match_context,Bits bor (1 bsl SavePoint),Slots}, + #ms{valid=Bits,slots=Slots}=Ctxt0 when SavePoint < Slots -> + Ctx = Ctxt0#ms{valid=Bits bor (1 bsl SavePoint),slots=Slots}, set_type_reg(Ctx, Reg, Vst); _ -> error({illegal_save,SavePoint}) end. @@ -1042,7 +1079,7 @@ bsm_restore(Reg, {atom,start}, Vst) -> Vst; bsm_restore(Reg, SavePoint, Vst) -> case bsm_get_context(Reg, Vst) of - {match_context,Bits,Slots} when SavePoint < Slots -> + #ms{valid=Bits,slots=Slots} when SavePoint < Slots -> case Bits band (1 bsl SavePoint) of 0 -> error({illegal_restore,SavePoint,not_set}); _ -> Vst @@ -1123,7 +1160,7 @@ assert_term(Src, Vst) -> %% Thus 'exception' is never stored as type descriptor %% for a register. %% -%% {match_context,_,_} A matching context for bit syntax matching. We do allow +%% #ms{} A match context for bit syntax matching. We do allow %% it to moved/to from stack, but otherwise it must only %% be accessed by bit syntax matching instructions. %% @@ -1165,12 +1202,17 @@ assert_type(WantedType, Term, Vst) -> assert_type(Correct, Correct) -> ok; assert_type(float, {float,_}) -> ok; assert_type(tuple, {tuple,_}) -> ok; +assert_type(tuple, {literal,Tuple}) when is_tuple(Tuple) -> ok; assert_type({tuple_element,I}, {tuple,[Sz]}) when 1 =< I, I =< Sz -> ok; assert_type({tuple_element,I}, {tuple,Sz}) when is_integer(Sz), 1 =< I, I =< Sz -> ok; +assert_type({tuple_element,I}, {literal,Lit}) when I =< tuple_size(Lit) -> + ok; +assert_type(cons, {literal,[_|_]}) -> + ok; assert_type(Needed, Actual) -> error({bad_type,{needed,Needed},{actual,Actual}}). @@ -1225,7 +1267,7 @@ get_term_type(Src, Vst) -> initialized -> error({unassigned,Src}); {catchtag,_} -> error({catchtag,Src}); {trytag,_} -> error({trytag,Src}); - {match_context,_,_} -> error({match_context,Src}); + #ms{} -> error({match_context,Src}); Type -> Type end. @@ -1377,11 +1419,12 @@ merge_types(bool, {atom,A}) -> merge_bool(A); merge_types({atom,A}, bool) -> merge_bool(A); -merge_types({match_context,B0,Slots},{match_context,B1,Slots}) -> - {match_context,B0 bor B1,Slots}; -merge_types({match_context,_,_}=M, _) -> +merge_types(#ms{id=Id,valid=B0,slots=Slots}=M, + #ms{id=Id,valid=B1,slots=Slots}) -> + M#ms{valid=B0 bor B1,slots=Slots}; +merge_types(#ms{}=M, _) -> M; -merge_types(_, {match_context,_,_}=M) -> +merge_types(_, #ms{}=M) -> M; merge_types(T1, T2) when T1 =/= T2 -> %% Too different. All we know is that the type is a 'term'. @@ -1505,7 +1548,6 @@ bif_type(node, [_], _) -> {atom,[]}; bif_type(hd, [_], _) -> term; bif_type(tl, [_], _) -> term; bif_type(get, [_], _) -> term; -bif_type(raise, [_,_], _) -> exception; bif_type(Bif, _, _) when is_atom(Bif) -> term. is_bif_safe('/=', 2) -> true; @@ -1519,6 +1561,7 @@ is_bif_safe('>=', 2) -> true; is_bif_safe(is_atom, 1) -> true; is_bif_safe(is_boolean, 1) -> true; is_bif_safe(is_binary, 1) -> true; +is_bif_safe(is_bitstring, 1) -> true; is_bif_safe(is_float, 1) -> true; is_bif_safe(is_function, 1) -> true; is_bif_safe(is_integer, 1) -> true; @@ -1549,8 +1592,12 @@ return_type_1(erlang, setelement, 3, Vst) -> Tuple = {x,1}, TupleType = case get_term_type(Tuple, Vst) of - {tuple,_}=TT -> TT; - _ -> {tuple,[0]} + {tuple,_}=TT -> + TT; + {literal,Lit} when is_tuple(Lit) -> + {tuple,tuple_size(Lit)}; + _ -> + {tuple,[0]} end, case get_term_type({x,0}, Vst) of {integer,[]} -> TupleType; diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl index 6dc162db40..61abae344c 100644 --- a/lib/compiler/src/cerl.erl +++ b/lib/compiler/src/cerl.erl @@ -1955,7 +1955,7 @@ is_c_var(_) -> false. -%% @spec c_fname(Name::atom(), Arity::integer()) -> cerl() +%% @spec c_fname(Name::atom(), Arity::arity()) -> cerl() %% @equiv c_var({Name, Arity}) %% @see fname_id/1 %% @see fname_arity/1 @@ -1963,18 +1963,18 @@ is_c_var(_) -> %% @see ann_c_fname/3 %% @see update_c_fname/3 --spec c_fname(atom(), non_neg_integer()) -> c_var(). +-spec c_fname(atom(), arity()) -> c_var(). c_fname(Atom, Arity) -> c_var({Atom, Arity}). -%% @spec ann_c_fname(As::[term()], Name::atom(), Arity::integer()) -> +%% @spec ann_c_fname(As::[term()], Name::atom(), Arity::arity()) -> %% cerl() %% @equiv ann_c_var(As, {Atom, Arity}) %% @see c_fname/2 --spec ann_c_fname([term()], atom(), non_neg_integer()) -> c_var(). +-spec ann_c_fname([term()], atom(), arity()) -> c_var(). ann_c_fname(As, Atom, Arity) -> ann_c_var(As, {Atom, Arity}). @@ -1992,13 +1992,13 @@ update_c_fname(#c_var{name = {_, Arity}, anno = As}, Atom) -> #c_var{name = {Atom, Arity}, anno = As}. -%% @spec update_c_fname(Old::cerl(), Name::atom(), Arity::integer()) -> +%% @spec update_c_fname(Old::cerl(), Name::atom(), Arity::arity()) -> %% cerl() %% @equiv update_c_var(Old, {Atom, Arity}) %% @see update_c_fname/2 %% @see c_fname/2 --spec update_c_fname(c_var(), atom(), integer()) -> c_var(). +-spec update_c_fname(c_var(), atom(), arity()) -> c_var(). update_c_fname(Node, Atom, Arity) -> update_c_var(Node, {Atom, Arity}). @@ -2047,14 +2047,14 @@ fname_id(#c_var{name={A,_}}) -> A. -%% @spec fname_arity(cerl()) -> byte() +%% @spec fname_arity(cerl()) -> arity() %% %% @doc Returns the arity part of an abstract function name variable. %% %% @see fname_id/1 %% @see c_fname/2 --spec fname_arity(c_var()) -> byte(). +-spec fname_arity(c_var()) -> arity(). fname_arity(#c_var{name={_,N}}) -> N. @@ -2500,7 +2500,7 @@ fun_body(Node) -> Node#c_fun.body. -%% @spec fun_arity(Node::cerl()) -> integer() +%% @spec fun_arity(Node::cerl()) -> arity() %% %% @doc Returns the number of parameter subtrees of an abstract %% fun-expression. @@ -2511,7 +2511,7 @@ fun_body(Node) -> %% @see c_fun/2 %% @see fun_vars/1 --spec fun_arity(c_fun()) -> non_neg_integer(). +-spec fun_arity(c_fun()) -> arity(). fun_arity(Node) -> length(fun_vars(Node)). @@ -3418,7 +3418,7 @@ apply_args(Node) -> Node#c_apply.args. -%% @spec apply_arity(Node::cerl()) -> integer() +%% @spec apply_arity(Node::cerl()) -> arity() %% %% @doc Returns the number of argument subtrees of an abstract %% function application. @@ -3430,7 +3430,7 @@ apply_args(Node) -> %% @see c_apply/2 %% @see apply_args/1 --spec apply_arity(c_apply()) -> non_neg_integer(). +-spec apply_arity(c_apply()) -> arity(). apply_arity(Node) -> length(apply_args(Node)). @@ -3536,7 +3536,7 @@ call_args(Node) -> Node#c_call.args. -%% @spec call_arity(Node::cerl()) -> integer() +%% @spec call_arity(Node::cerl()) -> arity() %% %% @doc Returns the number of argument subtrees of an abstract %% inter-module call. @@ -3548,7 +3548,7 @@ call_args(Node) -> %% @see c_call/3 %% @see call_args/1 --spec call_arity(c_call()) -> non_neg_integer(). +-spec call_arity(c_call()) -> arity(). call_arity(Node) -> length(call_args(Node)). @@ -3640,7 +3640,7 @@ primop_args(Node) -> Node#c_primop.args. -%% @spec primop_arity(Node::cerl()) -> integer() +%% @spec primop_arity(Node::cerl()) -> arity() %% %% @doc Returns the number of argument subtrees of an abstract %% primitive operation call. @@ -3652,7 +3652,7 @@ primop_args(Node) -> %% @see c_primop/2 %% @see primop_args/1 --spec primop_arity(c_primop()) -> non_neg_integer(). +-spec primop_arity(c_primop()) -> arity(). primop_arity(Node) -> length(primop_args(Node)). 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_codegen.erl b/lib/compiler/src/v3_codegen.erl index f531056591..f5f3c73793 100644 --- a/lib/compiler/src/v3_codegen.erl +++ b/lib/compiler/src/v3_codegen.erl @@ -1089,6 +1089,23 @@ protected_cg(Ts, Rs, _Fail, I, Vdb, Bef, St0) -> %% test_cg(TestName, Args, Fail, I, Vdb, Bef, St) -> {[Ainstr],Aft,St}. %% Generate test instruction. Use explicit fail label here. +test_cg(is_map, [A], Fail, I, Vdb, Bef, St) -> + %% We must avoid creating code like this: + %% + %% move x(0) y(0) + %% is_map Fail [x(0)] + %% make_fun => x(0) %% Overwrite x(0) + %% put_map_assoc y(0) ... + %% + %% The code is safe, but beam_validator does not understand that. + %% Extending beam_validator to handle such (rare) code as the + %% above would make it slower for all programs. Instead, change + %% the code generator to always prefer the Y register for is_map() + %% and put_map_assoc() instructions, ensuring that they use the + %% same register. + Arg = cg_reg_arg_prefer_y(A, Bef), + Aft = clear_dead(Bef, I, Vdb), + {[{test,is_map,{f,Fail},[Arg]}],Aft,St}; test_cg(Test, As, Fail, I, Vdb, Bef, St) -> Args = cg_reg_args(As, Bef), Aft = clear_dead(Bef, I, Vdb), @@ -1155,19 +1172,15 @@ call_cg(Func, As, Rs, Le, Vdb, Bef, St0) -> %% Inside a guard. The only allowed function call is to %% erlang:error/1,2. We will generate the following code: %% - %% jump FailureLabel %% move {atom,ok} DestReg - %% - %% The 'move' instruction will never be executed, but we - %% generate it anyway in case the beam_validator is run - %% on unoptimized code. + %% jump FailureLabel {remote,{atom,erlang},{atom,error}} = Func, %Assertion. [{var,DestVar}] = Rs, Int0 = clear_dead(Bef, Le#l.i, Vdb), Reg = put_reg(DestVar, Int0#sr.reg), Int = Int0#sr{reg=Reg}, Dst = fetch_reg(DestVar, Reg), - {[{jump,{f,Fail}},{move,{atom,ok},Dst}], + {[{move,{atom,ok},Dst},{jump,{f,Fail}}], clear_dead(Int, Le#l.i, Vdb),St0}; #cg{} -> %% Ordinary function call in a function body. @@ -1545,7 +1558,7 @@ set_cg([{var,R}], {map,Op,Map,[{map_pair,{var,_}=K,V}]}, Le, Vdb, Bef, Fail = {f,Bfail}, {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), - SrcReg = cg_reg_arg(Map,Int0), + SrcReg = cg_reg_arg_prefer_y(Map, Int0), Line = line(Le#l.a), List = [cg_reg_arg(K,Int0),cg_reg_arg(V,Int0)], @@ -1572,7 +1585,7 @@ set_cg([{var,R}], {map,Op,Map,Es}, Le, Vdb, Bef, Fail = {f,Bfail}, {Sis,Int0} = maybe_adjust_stack(Bef, Le#l.i, Le#l.i+1, Vdb, St), - SrcReg = cg_reg_arg(Map,Int0), + SrcReg = cg_reg_arg_prefer_y(Map, Int0), Line = line(Le#l.a), %% fetch registers for values to be put into the map @@ -1845,6 +1858,9 @@ cg_reg_args(As, Bef) -> [cg_reg_arg(A, Bef) || A <- As]. cg_reg_arg({var,V}, Bef) -> fetch_var(V, Bef); cg_reg_arg(Literal, _) -> Literal. +cg_reg_arg_prefer_y({var,V}, Bef) -> fetch_var_prefer_y(V, Bef); +cg_reg_arg_prefer_y(Literal, _) -> Literal. + %% cg_setup_call([Arg], Bef, Cur, Vdb) -> {[Instr],Aft}. %% Do the complete setup for a call/enter. @@ -2086,6 +2102,12 @@ fetch_var(V, Sr) -> error -> fetch_stack(V, Sr#sr.stk) end. +fetch_var_prefer_y(V, #sr{reg=Reg,stk=Stk}) -> + case find_stack(V, Stk) of + {ok,R} -> R; + error -> fetch_reg(V, Reg) + end. + load_vars(Vs, Regs) -> foldl(fun ({var,V}, Rs) -> put_reg(V, Rs) end, Regs, Vs). @@ -2159,11 +2181,11 @@ fetch_stack(Var, Stk) -> fetch_stack(Var, Stk, 0). fetch_stack(V, [{V}|_], I) -> {yy,I}; fetch_stack(V, [_|Stk], I) -> fetch_stack(V, Stk, I+1). -% find_stack(Var, Stk) -> find_stack(Var, Stk, 0). +find_stack(Var, Stk) -> find_stack(Var, Stk, 0). -% find_stack(V, [{V}|Stk], I) -> {ok,{yy,I}}; -% find_stack(V, [O|Stk], I) -> find_stack(V, Stk, I+1); -% find_stack(V, [], I) -> error. +find_stack(V, [{V}|_], I) -> {ok,{yy,I}}; +find_stack(V, [_|Stk], I) -> find_stack(V, Stk, I+1); +find_stack(_, [], _) -> error. on_stack(V, Stk) -> keymember(V, 1, Stk). diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl index 83b3650180..a3b0236134 100644 --- a/lib/compiler/src/v3_core.erl +++ b/lib/compiler/src/v3_core.erl @@ -510,16 +510,8 @@ unforce(_, Vs) -> Vs. exprs([E0|Es0], St0) -> {E1,Eps,St1} = expr(E0, St0), - case E1 of - #iprimop{name=#c_literal{val=match_fail}} -> - %% Must discard the rest of the body, because it - %% may refer to variables that have not been bound. - %% Example: {ok={error,E}} = foo(), E. - {Eps ++ [E1],St1}; - _ -> - {Es1,St2} = exprs(Es0, St1), - {Eps ++ [E1] ++ Es1,St2} - end; + {Es1,St2} = exprs(Es0, St1), + {Eps ++ [E1] ++ Es1,St2}; exprs([], St) -> {[],St}. %% expr(Expr, State) -> {Cexpr,[PreExp],State}. @@ -689,14 +681,36 @@ expr({match,L,P0,E0}, St0) -> Fc = fail_clause([Fpat], Lanno, c_tuple([#c_literal{val=badmatch},Fpat])), case P2 of nomatch -> + %% The pattern will not match. We must take care here to + %% bind all variables that the pattern would have bound + %% so that subsequent expressions do not refer to unbound + %% variables. + %% + %% As an example, this code: + %% + %% [X] = {Y} = E, + %% X + Y. + %% + %% will be rewritten to: + %% + %% error({badmatch,E}), + %% case E of + %% {[X],{Y}} -> + %% X + Y; + %% Other -> + %% error({badmatch,Other}) + %% end. + %% St6 = add_warning(L, nomatch, St5), - {Expr,Eps3,St} = safe(E1, St6), - Eps = Eps1 ++ Eps2 ++ Eps3, + {Expr,Eps3,St7} = safe(E1, St6), + SanPat0 = sanitize(P1), + {SanPat,Eps4,St} = pattern(SanPat0, St7), Badmatch = c_tuple([#c_literal{val=badmatch},Expr]), Fail = #iprimop{anno=#a{anno=Lanno}, name=#c_literal{val=match_fail}, args=[Badmatch]}, - {Fail,Eps,St}; + Eps = Eps3 ++ Eps4 ++ [Fail], + {#imatch{anno=#a{anno=Lanno},pat=SanPat,arg=Expr,fc=Fc},Eps,St}; Other when not is_atom(Other) -> {#imatch{anno=#a{anno=Lanno},pat=P2,arg=E2,fc=Fc},Eps1++Eps2,St5} end; @@ -738,6 +752,32 @@ expr({op,L,Op,L0,R0}, St0) -> module=#c_literal{anno=LineAnno,val=erlang}, name=#c_literal{anno=LineAnno,val=Op},args=As},Aps,St1}. + +%% sanitize(Pat) -> SanitizedPattern +%% Rewrite Pat so that it will be accepted by pattern/2 and will +%% bind the same variables as the original pattern. +%% +%% Here is an example of a pattern that would cause a pattern/2 +%% to generate a 'nomatch' exception: +%% +%% #{k:=X,k:=Y} = [Z] +%% +%% The sanitized pattern will look like: +%% +%% {{X,Y},[Z]} + +sanitize({match,L,P1,P2}) -> + {tuple,L,[sanitize(P1),sanitize(P2)]}; +sanitize({cons,L,H,T}) -> + {cons,L,sanitize(H),sanitize(T)}; +sanitize({tuple,L,Ps0}) -> + Ps = [sanitize(P) || P <- Ps0], + {tuple,L,Ps}; +sanitize({map,L,Ps0}) -> + Ps = [sanitize(V) || {map_field_exact,_,_,V} <- Ps0], + {tuple,L,Ps}; +sanitize(P) -> P. + make_bool_switch(L, E, V, T, F, #core{in_guard=true}) -> make_bool_switch_guard(L, E, V, T, F); make_bool_switch(L, E, V, T, F, #core{}) -> diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl index 4a6330fce4..b4bbc5e739 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) -> @@ -241,7 +242,7 @@ gexpr_test_add(Ke, St0) -> expr(#c_var{anno=A,name={_Name,Arity}}=Fname, Sub, St) -> %% A local in an expression. %% For now, these are wrapped into a fun by reverse - %% etha-conversion, but really, there should be exactly one + %% eta-conversion, but really, there should be exactly one %% such "lambda function" for each escaping local name, %% instead of one for each occurrence as done now. Vs = [#c_var{name=list_to_atom("V" ++ integer_to_list(V))} || diff --git a/lib/compiler/test/Makefile b/lib/compiler/test/Makefile index 85118502e3..f0185acbc7 100644 --- a/lib/compiler/test/Makefile +++ b/lib/compiler/test/Makefile @@ -9,12 +9,15 @@ MODULES= \ andor_SUITE \ apply_SUITE \ beam_block_SUITE \ + beam_bool_SUITE \ beam_validator_SUITE \ beam_disasm_SUITE \ beam_except_SUITE \ + beam_jump_SUITE \ beam_reorder_SUITE \ beam_type_SUITE \ beam_utils_SUITE \ + bif_SUITE \ bs_bincomp_SUITE \ bs_bit_binaries_SUITE \ bs_construct_SUITE \ @@ -46,10 +49,13 @@ NO_OPT= \ andor \ apply \ beam_block \ + beam_bool \ beam_except \ + beam_jump \ beam_reorder \ beam_type \ beam_utils \ + bif \ bs_construct \ bs_match \ bs_utf \ @@ -70,6 +76,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..e585eaedb5 --- /dev/null +++ b/lib/compiler/test/beam_bool_SUITE.erl @@ -0,0 +1,197 @@ +%% +%% %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,protected/1, + maps/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [{group,p}]. + +groups() -> + [{p,[parallel], + [before_and_inside_if, + scotland, + y_registers, + protected, + maps + ]}]. + +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}. + +protected(_Config) -> + {'EXIT',{if_clause,_}} = (catch photographs({1, surprise, true}, opinions)), + + {{true}} = welcome({perfect, true}), + {'EXIT',{if_clause,_}} = (catch welcome({perfect, false})), + ok. + +photographs({_Violation, surprise, Deep}, opinions) -> + {if + 0; "here", Deep -> + Deep = Deep + end}. + +welcome({perfect, Profit}) -> + if + Profit, Profit, Profit; 0 -> + {id({Profit})} + end. + +maps(_Config) -> + ok = evidence(#{0 => 42}). + +%% Cover handling of put_map in in split_block_label_used/2. +evidence(#{0 := Charge}) when 0; #{[] => Charge} == #{[] => 42} -> + ok. + + +%%% +%%% Common utilities. +%%% + +id(I) -> + I. diff --git a/lib/compiler/test/beam_except_SUITE.erl b/lib/compiler/test/beam_except_SUITE.erl index 8746e62fb9..47367d6eab 100644 --- a/lib/compiler/test/beam_except_SUITE.erl +++ b/lib/compiler/test/beam_except_SUITE.erl @@ -21,15 +21,18 @@ -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]). + multiple_allocs/1,coverage/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. all() -> - [coverage]. + test_lib:recompile(?MODULE), + [{group,p}]. groups() -> - []. + [{p,[parallel], + [multiple_allocs, + coverage]}]. init_per_suite(Config) -> Config. @@ -43,6 +46,23 @@ init_per_group(_GroupName, Config) -> end_per_group(_GroupName, Config) -> Config. +multiple_allocs(_Config) -> + {'EXIT',{{badmatch,#{true:=[p]}},_}} = + (catch could(pda, 0.0, {false,true}, {p})), + {'EXIT',{function_clause,_}} = (catch place(lee)), + {'EXIT',{{badmatch,wanted},_}} = (catch conditions()), + + ok. + +could(Coupons = pda, Favorite = _pleasure = 0.0, {_, true}, {Presents}) -> + (0 = true) = #{true => [Presents]}. + +place(lee) -> + (pregnancy = presentations) = [hours | [purchase || _ <- 0]] + wine. + +conditions() -> + (talking = going) = storage + [large = wanted]. + coverage(_) -> File = {file,"fake.erl"}, ok = fc(a), diff --git a/lib/compiler/test/beam_jump_SUITE.erl b/lib/compiler/test/beam_jump_SUITE.erl new file mode 100644 index 0000000000..0b13adaff2 --- /dev/null +++ b/lib/compiler/test/beam_jump_SUITE.erl @@ -0,0 +1,59 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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_jump_SUITE). + +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + undefined_label/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [{group,p}]. + +groups() -> + [{p,[parallel], + [undefined_label + ]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +undefined_label(_Config) -> + {'EXIT',{function_clause,_}} = (catch flights(0, [], [])), + ok. + +%% Would lose a label when compiled with no_copt. + +flights(0, [], []) when [], 0; 0.0, [], false -> + clark; +flights(_, Reproduction, introduction) when false, Reproduction -> + responsible. diff --git a/lib/compiler/test/beam_reorder_SUITE.erl b/lib/compiler/test/beam_reorder_SUITE.erl index 4b2262f65b..ff31f2d3bd 100644 --- a/lib/compiler/test/beam_reorder_SUITE.erl +++ b/lib/compiler/test/beam_reorder_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, - alloc/1]). + alloc/1,confused_beam_validator/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -31,7 +31,8 @@ all() -> groups() -> [{p,[parallel], - [alloc + [alloc, + confused_beam_validator ]}]. init_per_suite(Config) -> @@ -65,5 +66,16 @@ alloc_b(_U1, _U2, R) -> _ = id(0), Res. +confused_beam_validator(_Config) -> + {'EXIT',{{badmap,{any}},_}} = (catch efficient({any})), + ok. + +efficient({Var}=God) -> + id(God#{}), + catch + receive _ -> + Var + end. + id(I) -> I. diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index 8d5c0190ed..69e2f1838d 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_SUITE.erl @@ -21,7 +21,8 @@ -export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, init_per_group/2,end_per_group/2, - integers/1,coverage/1,booleans/1]). + integers/1,coverage/1,booleans/1,setelement/1,cons/1, + tuple/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -33,7 +34,10 @@ groups() -> [{p,[parallel], [integers, coverage, - booleans + booleans, + setelement, + cons, + tuple ]}]. init_per_suite(Config) -> @@ -55,6 +59,8 @@ integers(_Config) -> a = do_integers_2(<<0:1>>), {'EXIT',{{case_clause,-1},_}} = (catch do_integers_2(<<1:1>>)), + college = do_integers_3(), + ok. do_integers_1(B0) -> @@ -71,6 +77,12 @@ do_integers_2(Bin) -> 1 -> b end. +do_integers_3() -> + case try 0 after [] end of + 0 -> college; + 1 -> 0 + end. + coverage(_Config) -> {'EXIT',{badarith,_}} = (catch id(1) bsl 0.5), {'EXIT',{badarith,_}} = (catch id(2.0) bsl 2), @@ -94,5 +106,25 @@ do_booleans(B) -> no -> no end. +setelement(_Config) -> + T0 = id({a,42}), + {a,_} = T0, + {b,_} = setelement(1, T0, b), + ok. + +cons(_Config) -> + [did] = cons(assigned, did), + ok. + +cons(assigned, Instrument) -> + [Instrument] = [did]. + +tuple(_Config) -> + {'EXIT',{{badmatch,{necessary}},_}} = (catch do_tuple()), + ok. + +do_tuple() -> + {0, _} = {necessary}. + id(I) -> I. diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl index 6353ed3242..f6d4a311bb 100644 --- a/lib/compiler/test/beam_utils_SUITE.erl +++ b/lib/compiler/test/beam_utils_SUITE.erl @@ -23,7 +23,8 @@ init_per_group/2,end_per_group/2, apply_fun/1,apply_mf/1,bs_init/1,bs_save/1, is_not_killed/1,is_not_used_at/1, - select/1,y_catch/1,otp_8949_b/1,liveopt/1]). + select/1,y_catch/1,otp_8949_b/1,liveopt/1,coverage/1, + y_registers/1]). -export([id/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -43,7 +44,9 @@ groups() -> select, y_catch, otp_8949_b, - liveopt + liveopt, + coverage, + y_registers ]}]. init_per_suite(Config) -> @@ -268,6 +271,87 @@ liveopt_fun(Peer, Cause, Origin) -> void end. +%% Thanks to QuickCheck. +coverage(_Config) -> + 42+7 = merchant([[],7,false]), + + {'EXIT',{{try_clause,0},_}} = (catch resulting([0], stone)), + 0.0 = resulting([true], stone), + + {'EXIT',{if_clause,_}} = (catch clinic(false)), + {'EXIT',{{try_clause,"trials"},_}} = (catch clinic(true)), + + {'EXIT',{function_clause,_}} = (catch town(overall, {{abc},alcohol})), + + ok. + +%% Cover check_liveness/3. +merchant([Merchant, Laws, Electric]) -> + id(42), + oklahoma([[] || 0 <- Merchant], + if true; Electric -> Laws end) + 42. +oklahoma([], Int) -> Int. + +town(overall, {{If}, Healing = alcohol}) + when Healing#{[] => Healing}; include -> + [If || Healing <- awareness]. + +%% Cover is_reg_used_at/3. +resulting([Conservation], stone) -> + try 0 of + Conservation when Conservation -> Conservation; + _ when Conservation; 0 -> 0.0 + after + Conservation + end. + +%% Cover is_reg_used_at_1/3. +clinic(Damage) -> + if + Damage -> + try "trials" of Damage when Damage -> Damage catch true -> [] end + end, + carefully. + +y_registers(_Config) -> + {'EXIT',{{badfun,0},_}} = (catch economic(0.0, jim)), + {'EXIT',{{badmatch,apartments},_}} = (catch louisiana()), + {a,b} = (boxes(true))({a,b}), + {'EXIT',{{case_clause,webmaster},_}} = (catch yellow(true)), + ok. + +economic(0.0 = Serves, Existence) -> + case Serves of + Serves -> 0 + end, + Existence = jim, + 0(), + Serves, + Existence. + +louisiana() -> + {catch necessarily, + try + [] == reg, + true = apartments + catch [] -> barbara + end}. + +boxes(Call) -> + case Call of + Call -> approval + end, + Call, + fun id/1. + +yellow(Hill) -> + case webmaster of + station -> eyes; Hill -> + "under" + end, + Hill, + id(42). + %% The identity function. id(I) -> I. diff --git a/lib/compiler/test/beam_validator_SUITE.erl b/lib/compiler/test/beam_validator_SUITE.erl index 7c4e88ca3e..263fd2ca7e 100644 --- a/lib/compiler/test/beam_validator_SUITE.erl +++ b/lib/compiler/test/beam_validator_SUITE.erl @@ -32,7 +32,7 @@ bad_bin_match/1,bad_dsetel/1, state_after_fault_in_catch/1,no_exception_in_catch/1, undef_label/1,illegal_instruction/1,failing_gc_guard_bif/1, - map_field_lists/1]). + map_field_lists/1,cover_bin_opt/1]). -include_lib("common_test/include/ct.hrl"). @@ -60,7 +60,7 @@ groups() -> freg_state,bad_bin_match,bad_dsetel, state_after_fault_in_catch,no_exception_in_catch, undef_label,illegal_instruction,failing_gc_guard_bif, - map_field_lists]}]. + map_field_lists,cover_bin_opt]}]. init_per_suite(Config) -> Config. @@ -406,8 +406,124 @@ map_field_lists(Config) -> empty_field_list}} ] = Errors. +%% Coverage and smoke test of beam_validator. +cover_bin_opt(_Config) -> + Ms = [beam_utils_SUITE, + bs_match_SUITE, + bs_bincomp_SUITE, + bs_bit_binaries_SUITE, + bs_utf_SUITE], + test_lib:p_run(fun try_bin_opt/1, Ms), + ok. + +try_bin_opt(Mod) -> + try + do_bin_opt(Mod) + catch + Class:Error -> + io:format("~p: ~p ~p\n~p\n", + [Mod,Class,Error,erlang:get_stacktrace()]), + error + end. + +do_bin_opt(Mod) -> + Beam = code:which(Mod), + {ok,{Mod,[{abstract_code, + {raw_abstract_v1,Abstr}}]}} = + beam_lib:chunks(Beam, [abstract_code]), + {ok,Mod,Asm} = compile:forms(Abstr, ['S']), + do_bin_opt(Mod, Asm). + +do_bin_opt(Mod, Asm) -> + do_bin_opt(fun enable_bin_opt/1, Mod, Asm), + do_bin_opt(fun remove_bs_start_match/1, Mod, Asm), + do_bin_opt(fun remove_bs_save/1, Mod, Asm), + do_bin_opt(fun destroy_ctxt/1, Mod, Asm), + do_bin_opt(fun destroy_save_point/1, Mod, Asm), + ok. + +do_bin_opt(Transform, Mod, Asm0) -> + Asm = Transform(Asm0), + case compile:forms(Asm, [from_asm,no_postopt,return]) of + {ok,[],Code,_Warnings} when is_binary(Code) -> + ok; + {error,Errors0,_} -> + %% beam_validator must return errors, not simply crash, + %% when illegal code is found. + ModString = atom_to_list(Mod), + [{ModString,Errors}] = Errors0, + _ = [verify_bin_opt_error(E) || E <- Errors], + ok + end. + +verify_bin_opt_error({beam_validator,_}) -> + ok. + +enable_bin_opt(Module) -> + transform_is(fun enable_bin_opt_body/1, Module). + +enable_bin_opt_body([_,{'%',{no_bin_opt,_Reason,_Anno}}|Is]) -> + enable_bin_opt_body(Is); +enable_bin_opt_body([I|Is]) -> + [I|enable_bin_opt_body(Is)]; +enable_bin_opt_body([]) -> + []. + +remove_bs_start_match(Module) -> + transform_remove(fun({test,bs_start_match2,_,_,_,_}) -> true; + (_) -> false + end, Module). + +remove_bs_save(Module) -> + transform_remove(fun({bs_save2,_,_}) -> true; + (_) -> false + end, Module). + +destroy_save_point(Module) -> + transform_i(fun do_destroy_save_point/1, Module). + +do_destroy_save_point({I,Ctx,_Point}) + when I =:= bs_save2; I =:= bs_restore2 -> + {I,Ctx,42}; +do_destroy_save_point(I) -> + I. + +destroy_ctxt(Module) -> + transform_i(fun do_destroy_ctxt/1, Module). + +do_destroy_ctxt({bs_save2=I,Ctx,Point}) -> + {I,destroy_reg(Ctx),Point}; +do_destroy_ctxt({bs_restore2=I,Ctx,Point}) -> + {I,destroy_reg(Ctx),Point}; +do_destroy_ctxt({bs_context_to_binary=I,Ctx}) -> + {I,destroy_reg(Ctx)}; +do_destroy_ctxt(I) -> + I. + +destroy_reg({Tag,N}) -> + case rand:uniform() of + R when R < 0.6 -> + {Tag,N+1}; + _ -> + {y,N+1} + end. + %%%------------------------------------------------------------------------- +transform_remove(Remove, Module) -> + transform_is(fun(Is) -> [I || I <- Is, not Remove(I)] end, Module). + +transform_i(Transform, Module) -> + transform_is(fun(Is) -> [Transform(I) || I <- Is] end, Module). + +transform_is(Transform, {Mod,Exp,Imp,Fs0,Lc}) -> + Fs = [transform_is_1(Transform, F) || F <- Fs0], + {Mod,Exp,Imp,Fs,Lc}. + +transform_is_1(Transform, {function,N,A,E,Is0}) -> + Is = Transform(Is0), + {function,N,A,E,Is}. + do_val(Mod, Config) -> Data = proplists:get_value(data_dir, Config), Base = atom_to_list(Mod), diff --git a/lib/compiler/test/bif_SUITE.erl b/lib/compiler/test/bif_SUITE.erl new file mode 100644 index 0000000000..51bc71da81 --- /dev/null +++ b/lib/compiler/test/bif_SUITE.erl @@ -0,0 +1,65 @@ +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 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(bif_SUITE). + +-export([all/0,suite/0,groups/0,init_per_suite/1,end_per_suite/1, + init_per_group/2,end_per_group/2, + beam_validator/1]). + +suite() -> + [{ct_hooks,[ts_install_cth]}]. + +all() -> + test_lib:recompile(?MODULE), + [{group,p}]. + +groups() -> + [{p,[parallel], + [beam_validator + ]}]. + +init_per_suite(Config) -> + Config. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +%% Cover code in beam_validator. + +beam_validator(Config) -> + [false,Config] = food(Config), + + true = is_number(42.0), + false = is_port(Config), + + ok. + +food(Curriculum) -> + [try + is_bitstring(functions) + catch _ -> + 0 + end, Curriculum]. 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..6302f82f29 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. @@ -1835,6 +1835,8 @@ bad_guards(Config) when is_list(Config) -> fc(catch bad_guards_3(not_a_map, [x])), fc(catch bad_guards_3(42, [x])), + fc(catch bad_guards_4()), + ok. %% beam_bool used to produce GC BIF instructions whose @@ -1852,26 +1854,11 @@ 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). +%% v3_codegen would generate a jump to the failure label, but +%% without initializing x(0). The code at the failure label expected +%% x(0) to be initialized. -found(_, _) -> million. +bad_guards_4() when not (error#{}); {not 0.0} -> freedom. %% Building maps in a guard in a 'catch' would crash v3_codegen. diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl index 14d175b92c..c3c4862794 100644 --- a/lib/compiler/test/map_SUITE.erl +++ b/lib/compiler/test/map_SUITE.erl @@ -66,7 +66,9 @@ t_export/1, %% errors in 18 - t_register_corruption/1 + t_register_corruption/1, + t_bad_update/1 + ]). suite() -> []. @@ -117,7 +119,8 @@ all() -> t_export, %% errors in 18 - t_register_corruption + t_register_corruption, + t_bad_update ]. groups() -> []. @@ -1922,6 +1925,19 @@ validate_frequency([{T,C}|Fs],Tf) -> validate_frequency([], _) -> ok. +t_bad_update(_Config) -> + {#{0.0:=Id},#{}} = properly(#{}), + 42 = Id(42), + {'EXIT',{{badmap,_},_}} = (catch increase(0)), + ok. + +properly(Item) -> + {Item#{0.0 => fun id/1},Item}. + +increase(Allows) -> + catch fun() -> Allows end#{[] => +Allows, "warranty" => fun id/1}. + + %% aux rand_terms(0) -> []; diff --git a/lib/compiler/test/match_SUITE.erl b/lib/compiler/test/match_SUITE.erl index 92a9802cad..31402ac717 100644 --- a/lib/compiler/test/match_SUITE.erl +++ b/lib/compiler/test/match_SUITE.erl @@ -21,8 +21,8 @@ -export([all/0, suite/0,groups/0,init_per_suite/1, end_per_suite/1, init_per_group/2,end_per_group/2, - pmatch/1,mixed/1,aliases/1,match_in_call/1, - untuplify/1,shortcut_boolean/1,letify_guard/1, + pmatch/1,mixed/1,aliases/1,non_matching_aliases/1, + match_in_call/1,untuplify/1,shortcut_boolean/1,letify_guard/1, selectify/1,underscore/1,match_map/1,map_vars_used/1, coverage/1,grab_bag/1]). @@ -36,7 +36,8 @@ all() -> groups() -> [{p,[parallel], - [pmatch,mixed,aliases,match_in_call,untuplify, + [pmatch,mixed,aliases,non_matching_aliases, + match_in_call,untuplify, shortcut_boolean,letify_guard,selectify, underscore,match_map,map_vars_used,coverage, grab_bag]}]. @@ -143,16 +144,6 @@ aliases(Config) when is_list(Config) -> {a,b} = list_alias2([a,b]), {a,b} = list_alias3([a,b]), - %% Non-matching aliases. - none = mixed_aliases(<<42>>), - none = mixed_aliases([b]), - none = mixed_aliases([d]), - none = mixed_aliases({a,42}), - none = mixed_aliases(42), - - %% Non-matching aliases. - {'EXIT',{{badmatch,42},_}} = (catch nomatch_alias(42)), - ok. str_alias(V) -> @@ -256,6 +247,33 @@ list_alias2([X,Y]=[a,b]) -> list_alias3([X,b]=[a,Y]) -> {X,Y}. +non_matching_aliases(_Config) -> + none = mixed_aliases(<<42>>), + none = mixed_aliases([b]), + none = mixed_aliases([d]), + none = mixed_aliases({a,42}), + none = mixed_aliases(42), + + {'EXIT',{{badmatch,42},_}} = (catch nomatch_alias(42)), + {'EXIT',{{badmatch,job},_}} = (catch entirely()), + {'EXIT',{{badmatch,associates},_}} = (catch printer()), + {'EXIT',{{badmatch,borogoves},_}} = (catch tench()), + + put(perch, 0), + {'EXIT',{{badmatch,{spine,42}},_}} = (catch perch(42)), + 1 = erase(perch), + + put(salmon, 0), + {'EXIT',{{badmatch,mimsy},_}} = (catch salmon()), + 1 = erase(salmon), + + put(shark, 0), + {'EXIT',{{badmatch,_},_}} = (catch shark()), + 1 = erase(shark), + + {'EXIT',{{badmatch,_},_}} = (catch radio(research)), + ok. + mixed_aliases(<<X:8>> = x) -> {a,X}; mixed_aliases([b] = <<X:8>>) -> {b,X}; mixed_aliases(<<X:8>> = {a,X}) -> {c,X}; @@ -266,6 +284,42 @@ nomatch_alias(I) -> {ok={A,B}} = id(I), {A,B}. +entirely() -> + 0(((Voice = true) = cool) = job), + [receive _ -> Voice end || banking <- printer]. + +printer() -> + {[Indoor] = [] = associates}, + [ireland || Indoor <- Indoor]. + +tench() -> + E = begin + [A] = [] = borogoves, + A + 1 + end, + E + 7 * A. + +perch(X) -> + begin + put(perch, get(perch)+1), + [A] = [] = {spine,X} + end. + +salmon() -> + {put(salmon, get(salmon)+1),#{key:=([A]=[])}=mimsy,exit(fail)}, + A + 10. + +shark() -> + (hello = there) = (catch shark(put(shark, get(shark)+1), a = b)). + +shark(_, _) -> + ok. + +radio(research) -> + (connection = proof) = + (catch erlang:trace_pattern(catch mechanisms + assist, + summary = mechanisms)). + %% OTP-7018. match_in_call(Config) when is_list(Config) -> diff --git a/lib/compiler/test/receive_SUITE.erl b/lib/compiler/test/receive_SUITE.erl index 3c397561fc..8304672558 100644 --- a/lib/compiler/test/receive_SUITE.erl +++ b/lib/compiler/test/receive_SUITE.erl @@ -118,8 +118,14 @@ coverage(Config) when is_list(Config) -> 59 = tuple_to_values(infinity, x), 61 = tuple_to_values(999999, x), 0 = tuple_to_values(1, x), + + {'EXIT',{{badmap,[]},_}} = (catch monitor_plus_badmap(self())), + ok. +monitor_plus_badmap(Pid) -> + monitor(process, Pid) + []#{}. + receive_all() -> receive Any -> 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. |