From aa30fb09bca19916c82c239ce4d21897897a1b03 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 18 May 2016 06:33:33 +0200 Subject: beam_validator: Keep better track of tuple literals As a preparation for upcoming better optimizations in beam_type, we will need to keep better track of tuple literals so that beam_validator will not falsely reject safe code. --- lib/compiler/src/beam_validator.erl | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) (limited to 'lib') diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index 6877141885..d53aff004f 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1165,12 +1165,15 @@ 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(Needed, Actual) -> error({bad_type,{needed,Needed},{actual,Actual}}). @@ -1549,8 +1552,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; -- cgit v1.2.3 From 6515f262cba9325bef84ce90758f2e74ebfb8c9e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 19 May 2016 10:09:18 +0200 Subject: beam_validator: Handle cons literals better As a preparation for better optimizations in beam_type, a list literal must be accepted as a 'cons'. --- lib/compiler/src/beam_validator.erl | 2 ++ 1 file changed, 2 insertions(+) (limited to 'lib') diff --git a/lib/compiler/src/beam_validator.erl b/lib/compiler/src/beam_validator.erl index d53aff004f..faff9940ec 100644 --- a/lib/compiler/src/beam_validator.erl +++ b/lib/compiler/src/beam_validator.erl @@ -1174,6 +1174,8 @@ assert_type({tuple_element,I}, {tuple,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}}). -- cgit v1.2.3 From 0f222d55ce46358aa7891ea482655937daaf8b52 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 18 May 2016 06:21:34 +0200 Subject: beam_type: Correct handling of setelement/3 We must be careful how we treat the type info for the result of: setelement(Index, Tuple, NewValue) If Tuple had type information, the result of setelement/3 (in x(0)) would be assigned the same type information. But that is not safe for: setelement(1, Tuple, NewValue) since the type for the first element will be changed. Therefore, we must take care to remove the type information for the first element of the tuple if might have been modified by setelement/3. --- lib/compiler/src/beam_type.erl | 23 +++++++++++++++++------ lib/compiler/test/beam_type_SUITE.erl | 11 +++++++++-- 2 files changed, 26 insertions(+), 8 deletions(-) (limited to 'lib') diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 5076c5eb96..79f93d7548 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); diff --git a/lib/compiler/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index 8d5c0190ed..063a27ad8d 100644 --- a/lib/compiler/test/beam_type_SUITE.erl +++ b/lib/compiler/test/beam_type_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, - integers/1,coverage/1,booleans/1]). + integers/1,coverage/1,booleans/1,setelement/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -33,7 +33,8 @@ groups() -> [{p,[parallel], [integers, coverage, - booleans + booleans, + setelement ]}]. init_per_suite(Config) -> @@ -94,5 +95,11 @@ do_booleans(B) -> no -> no end. +setelement(_Config) -> + T0 = id({a,42}), + {a,_} = T0, + {b,_} = setelement(1, T0, b), + ok. + id(I) -> I. -- cgit v1.2.3 From 121cc9ba61e44e9c47d831d837dfb0f0b2d81990 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Tue, 17 May 2016 07:09:59 +0200 Subject: beam_type: Eliminate crash The following code: simple() -> case try 0 after [] end of 0 -> college; 1 -> 0 end. would crash the compiler like this: crash reason: {case_clause, {'EXIT', {function_clause, [{beam_type,simplify_select_val_int, [{select,select_val, {x,0}, {f,7}, [{integer,1},{f,9},{integer,0},{f,8}]}, 0], [{file,"beam_type.erl"},{line,169}]}, {beam_type,simplify_basic_1,3, [{file,"beam_type.erl"},{line,155}]}, {beam_type,opt,3,[{file,"beam_type.erl"},{line,57}]}, {beam_type,function,1,[{file,"beam_type.erl"},{line,36}]}, {beam_type,'-module/2-lc$^0/1-0-',1, [{file,"beam_type.erl"},{line,30}]}, {beam_type,module,2,[{file,"beam_type.erl"},{line,30}]}, {compile,'-select_passes/2-anonymous-2-',2, [{file,"compile.erl"},{line,521}]}, {compile,'-internal_comp/4-anonymous-1-',2, [{file,"compile.erl"},{line,306}]}]}}} The root cause is that the type representation is not well-defined. Integers could be represented in three different ways: integer {integer,{1,10}} {integer,0} However, only the first two forms were handled. To avoid similar problems in the future: * Make the type representation stricter. Make sure that integers are only represented as 'integer' or {integer,{Min,Max}}. * Call verify_type/1 whenever a new type is added (not only when merging types) to ensure that only the supported types are added to the type database). (ERL-150) --- lib/compiler/src/beam_type.erl | 43 ++++++++++++++++++++++++++++------- lib/compiler/test/beam_type_SUITE.erl | 29 +++++++++++++++++++++-- 2 files changed, 62 insertions(+), 10 deletions(-) (limited to 'lib') diff --git a/lib/compiler/src/beam_type.erl b/lib/compiler/src/beam_type.erl index 79f93d7548..acaf3ede66 100644 --- a/lib/compiler/src/beam_type.erl +++ b/lib/compiler/src/beam_type.erl @@ -759,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). %%% @@ -796,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; @@ -821,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); @@ -831,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. @@ -866,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/test/beam_type_SUITE.erl b/lib/compiler/test/beam_type_SUITE.erl index 063a27ad8d..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,setelement/1]). + integers/1,coverage/1,booleans/1,setelement/1,cons/1, + tuple/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -34,7 +35,9 @@ groups() -> [integers, coverage, booleans, - setelement + setelement, + cons, + tuple ]}]. init_per_suite(Config) -> @@ -56,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) -> @@ -72,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), @@ -101,5 +112,19 @@ setelement(_Config) -> {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. -- cgit v1.2.3 From 9ab0dcce5a2bf609917cb09c36cbf63dad6bb679 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Wed, 18 May 2016 19:14:09 +0200 Subject: v3_core: Don't depend on sys_core_fold for cleaning up a3ec2644f5 attempted to teach v3_core not to generate code with unbound variables. The approach taken in that commit is to discard all expressions following a badmatch. That does not work if the badmatch is nested: {[V] = [] = foo,V}, V That would be rewritten to: {error({badmatch,foo})}, V where V is unbound. If we were to follow the same approach, the tuple construction code would have to look out for a badmatch. As would list construction, begin...end, and so on. Therefore, as it is impractical to discard all expressions that follow a badmatch, the only other solution is to ensure that the variables that the pattern binds will somehow be bound. That can be arranged by rewriting the pattern to a pattern that binds the same variables. Thus: error({badmatch,foo}), E = foo, case E of {[V],[]} -> V; Other -> error({badmatch,Other} end --- lib/compiler/src/v3_core.erl | 66 +++++++++++++++++++++++++------- lib/compiler/test/match_SUITE.erl | 80 ++++++++++++++++++++++++++++++++------- 2 files changed, 120 insertions(+), 26 deletions(-) (limited to 'lib') 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/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) -> {a,X}; mixed_aliases([b] = <>) -> {b,X}; mixed_aliases(<> = {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) -> -- cgit v1.2.3 From 69bb7b21a552c6e7d0615d4ead0345370deec2a0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Fri, 20 May 2016 15:18:53 +0200 Subject: beam_bool: Reject potentially unsafe optimization When calculating the sets of registers that must be killed or unused, registers set in a {protected,_,_,_} block were not considered. That could result in a crash in the assertion in beam_utils:live_opt_block/4. --- lib/compiler/src/beam_bool.erl | 2 ++ lib/compiler/test/beam_bool_SUITE.erl | 31 +++++++++++++++++++++++++++++-- 2 files changed, 31 insertions(+), 2 deletions(-) (limited to 'lib') diff --git a/lib/compiler/src/beam_bool.erl b/lib/compiler/src/beam_bool.erl index 359fdb6d3c..99e4ccb1e9 100644 --- a/lib/compiler/src/beam_bool.erl +++ b/lib/compiler/src/beam_bool.erl @@ -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/test/beam_bool_SUITE.erl b/lib/compiler/test/beam_bool_SUITE.erl index 84d634e5ca..a07d010879 100644 --- a/lib/compiler/test/beam_bool_SUITE.erl +++ b/lib/compiler/test/beam_bool_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, before_and_inside_if/1, - scotland/1,y_registers/1]). + scotland/1,y_registers/1,protected/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -35,7 +35,8 @@ groups() -> [{p,[parallel], [before_and_inside_if, scotland, - y_registers + y_registers, + protected ]}]. init_per_suite(Config) -> @@ -158,3 +159,29 @@ potter(Modes) -> _ -> 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. + +%%% +%%% Common utilities. +%%% + +id(I) -> + I. -- cgit v1.2.3 From 57c4432ed543898676ccc646ab6d556c7e6ea79a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sat, 21 May 2016 08:57:28 +0200 Subject: beam_reorder: Don't confuse beam_validator Make sure we don't optimize code such as: is_tuple Fail Src test_arity Fail Src Arity get_tuple_element Src Pos Dst is_map Fail Src If we would reorder the instructions like this: is_tuple Fail Src test_arity Fail Src Arity is_map Fail Src get_tuple_element Src Pos Dst beam_validator would complain that the type for Src is a map instead of a tuple. Since the code has problems to begin with, there is no need to do the optimization. --- lib/compiler/src/beam_reorder.erl | 9 +++++++++ lib/compiler/test/beam_reorder_SUITE.erl | 16 ++++++++++++++-- 2 files changed, 23 insertions(+), 2 deletions(-) (limited to 'lib') 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/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. -- cgit v1.2.3 From 09d729daa2350fc4de577467dca4a8e65f30979b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Thu, 19 May 2016 15:04:21 +0200 Subject: beam_utils_SUITE: Cover more lines in beam_utils By first adding a call to error/1 to each uncovered line, QuickCheck could find test cases that would cover the lines. --- lib/compiler/test/beam_utils_SUITE.erl | 47 ++++++++++++++++++++++++++++++++-- 1 file changed, 45 insertions(+), 2 deletions(-) (limited to 'lib') diff --git a/lib/compiler/test/beam_utils_SUITE.erl b/lib/compiler/test/beam_utils_SUITE.erl index 6353ed3242..ae813d563b 100644 --- a/lib/compiler/test/beam_utils_SUITE.erl +++ b/lib/compiler/test/beam_utils_SUITE.erl @@ -23,7 +23,7 @@ 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]). -export([id/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -43,7 +43,8 @@ groups() -> select, y_catch, otp_8949_b, - liveopt + liveopt, + coverage ]}]. init_per_suite(Config) -> @@ -268,6 +269,48 @@ 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. + %% The identity function. id(I) -> I. -- cgit v1.2.3 From 69dd6018b7731becda651393b837639746aa63c7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= Date: Sat, 21 May 2016 07:53:00 +0200 Subject: beam_bool_SUITE: Cover one more line --- lib/compiler/test/beam_bool_SUITE.erl | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) (limited to 'lib') diff --git a/lib/compiler/test/beam_bool_SUITE.erl b/lib/compiler/test/beam_bool_SUITE.erl index a07d010879..e585eaedb5 100644 --- a/lib/compiler/test/beam_bool_SUITE.erl +++ b/lib/compiler/test/beam_bool_SUITE.erl @@ -22,7 +22,8 @@ -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]). + scotland/1,y_registers/1,protected/1, + maps/1]). suite() -> [{ct_hooks,[ts_install_cth]}]. @@ -36,7 +37,8 @@ groups() -> [before_and_inside_if, scotland, y_registers, - protected + protected, + maps ]}]. init_per_suite(Config) -> @@ -179,6 +181,14 @@ welcome({perfect, Profit}) -> {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. %%% -- cgit v1.2.3