Merge branch 'bjorn/compiler/misc'

* bjorn/compiler/misc:
  beam_bool_SUITE: Cover one more line
  beam_utils_SUITE: Cover more lines in beam_utils
  beam_reorder: Don't confuse beam_validator
  beam_bool: Reject potentially unsafe optimization
  v3_core: Don't depend on sys_core_fold for cleaning up
  beam_type: Eliminate crash
  beam_type: Correct handling of setelement/3
  beam_validator: Handle cons literals better
  beam_validator: Keep better track of tuple literals

5 files changed, 127 insertions, 29 deletions

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/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_validator.erl b/lib/compiler/src/beam_validator.erl
index 6877141885..faff9940ec 100644
--- a/lib/compiler/src/beam_validator.erl
+++ b/lib/compiler/src/beam_validator.erl
@@ -1165,12 +1165,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}}).
 
@@ -1549,8 +1554,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/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{}) ->