compiler: Validate Map src

Reject all expressions that are known to fail.
Emit 'badarg' for those expressions.

Ex.

    []#{ a => 1}

Is not a valid map update expression.

5 files changed, 65 insertions, 15 deletions

diff --git a/lib/compiler/src/cerl.erl b/lib/compiler/src/cerl.erl
index 744ebc7aca..9024999d7f 100644
--- a/lib/compiler/src/cerl.erl
+++ b/lib/compiler/src/cerl.erl
@@ -1585,9 +1585,9 @@ map_val(#c_map{var = M}) ->
     M.
 
 ann_c_map(As,Es) ->
-    ann_c_map(As, #c_literal{val=[]}, Es).
+    ann_c_map(As, #c_literal{val=#{}}, Es).
 
-ann_c_map(As,#c_literal{val=[]}=M,Es) ->
+ann_c_map(As,#c_literal{val=Mval}=M,Es) when is_map(Mval), map_size(Mval) =:= 0 ->
     Pairs = [[K,V]||#c_map_pair{key=K,val=V}<-Es],
     IsLit = lists:foldl(fun(Pair,Res) ->
 		Res andalso is_lit_list(Pair)
diff --git a/lib/compiler/src/core_parse.hrl b/lib/compiler/src/core_parse.hrl
index d54715ef59..094bbb8a71 100644
--- a/lib/compiler/src/core_parse.hrl
+++ b/lib/compiler/src/core_parse.hrl
@@ -103,5 +103,5 @@
 		     val}).
 
 -record(c_map, {anno=[],
-		var=#c_literal{val=[]} :: #c_var{} | #c_literal{},
+		var=#c_literal{val=#{}} :: #c_var{} | #c_literal{},
 		es :: [#c_map_pair{}]}).
diff --git a/lib/compiler/src/sys_core_fold.erl b/lib/compiler/src/sys_core_fold.erl
index 058abd3357..90cc3b9051 100644
--- a/lib/compiler/src/sys_core_fold.erl
+++ b/lib/compiler/src/sys_core_fold.erl
@@ -72,7 +72,7 @@
 -import(lists, [map/2,foldl/3,foldr/3,mapfoldl/3,all/2,any/2,
 		reverse/1,reverse/2,member/2,nth/2,flatten/1,unzip/1]).
 
--import(cerl, [ann_c_cons/3,ann_c_tuple/2]).
+-import(cerl, [ann_c_cons/3,ann_c_tuple/2,ann_c_map/3]).
 
 -include("core_parse.hrl").
 
@@ -246,7 +246,7 @@ expr(#c_tuple{anno=Anno,es=Es0}=Tuple, Ctxt, Sub) ->
 	value ->
 	    ann_c_tuple(Anno, Es)
     end;
-expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) ->
+expr(#c_map{anno=Anno,var=V0,es=Es0}=Map, Ctxt, Sub) ->
     Es = pair_list(Es0, Ctxt, Sub),
     case Ctxt of
 	effect ->
@@ -254,7 +254,7 @@ expr(#c_map{var=V0,es=Es0}=Map, Ctxt, Sub) ->
 	    expr(make_effect_seq(Es, Sub), Ctxt, Sub);
 	value ->
 	    V = expr(V0, Ctxt, Sub),
-	    Map#c_map{var=V,es=Es}
+	    ann_c_map(Anno,V,Es)
     end;
 expr(#c_binary{segments=Ss}=Bin0, Ctxt, Sub) ->
     %% Warn for useless building, but always build the binary
diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 80e9aca3d0..bf3368c31d 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -518,10 +518,18 @@ expr({map,L,Es0}, St0) ->
     A = lineno_anno(L, St1),
     {ann_c_map(A,Es1),Eps,St1};
 expr({map,L,M0,Es0}, St0) ->
-    {M1,Mps,St1} = safe(M0, St0),
-    {Es1,Eps,St2} = map_pair_list(Es0, St1),
-    A = lineno_anno(L, St2),
-    {ann_c_map(A,M1,Es1),Mps++Eps,St2};
+    try expr_map(M0,Es0,lineno_anno(L, St0),St0) of
+	{_,_,_}=Res -> Res
+    catch
+	throw:bad_map ->
+	    St = add_warning(L, bad_map, St0),
+	    LineAnno = lineno_anno(L, St),
+	    As = [#c_literal{anno=LineAnno,val=badarg}],
+	    {#icall{anno=#a{anno=LineAnno},	%Must have an #a{}
+		    module=#c_literal{anno=LineAnno,val=erlang},
+		    name=#c_literal{anno=LineAnno,val=error},
+		    args=As},[],St}
+    end;
 expr({bin,L,Es0}, St0) ->
     try expr_bin(Es0, lineno_anno(L, St0), St0) of
 	{_,_,_}=Res -> Res
@@ -731,6 +739,20 @@ make_bool_switch_guard(L, E, V, T, F) ->
       {clause,NegL,[V],[],[V]}
      ]}.
 
+expr_map(M0,Es0,A,St0) ->
+    {M1,Mps,St1} = safe(M0, St0),
+    case is_valid_map_src(M1) of
+	true ->
+	    {Es1,Eps,St2} = map_pair_list(Es0, St1),
+	    {ann_c_map(A,M1,Es1),Mps++Eps,St2};
+	false -> throw(bad_map)
+    end.
+
+is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true;
+is_valid_map_src(#c_map{})  -> true;
+is_valid_map_src(#c_var{})  -> true;
+is_valid_map_src(_)         -> false.
+
 map_pair_list(Es, St) ->
     foldr(fun
 	    ({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) ->
@@ -2257,7 +2279,9 @@ is_simple_list(Es) -> lists:all(fun is_simple/1, Es).
 format_error(nomatch) ->
     "pattern cannot possibly match";
 format_error(bad_binary) ->
-    "binary construction will fail because of a type mismatch".
+    "binary construction will fail because of a type mismatch";
+format_error(bad_map) ->
+    "map construction will fail because of a type mismatch".
 
 add_warning(Line, Term, #core{ws=Ws,file=[{file,File}]}=St) when Line >= 0 ->
     St#core{ws=[{File,[{location(Line),?MODULE,Term}]}|Ws]};
diff --git a/lib/compiler/src/v3_kernel.erl b/lib/compiler/src/v3_kernel.erl
index d00dd56f30..ecff01c4e5 100644
--- a/lib/compiler/src/v3_kernel.erl
+++ b/lib/compiler/src/v3_kernel.erl
@@ -272,9 +272,18 @@ expr(#c_cons{anno=A,hd=Ch,tl=Ct}, Sub, St0) ->
 expr(#c_tuple{anno=A,es=Ces}, Sub, St0) ->
     {Kes,Ep,St1} = atomic_list(Ces, Sub, St0),
     {#k_tuple{anno=A,es=Kes},Ep,St1};
-expr(#c_map{anno=A,var=Var0,es=Ces}, Sub, St0) ->
-    {Var,[],St1} = expr(Var0, Sub, St0),
-    map_split_pairs(A, Var, Ces, Sub, St1);
+expr(#c_map{anno=A,var=Var,es=Ces}, Sub, St0) ->
+    try expr_map(A,Var,Ces,Sub,St0) of
+	{_,_,_}=Res -> Res
+    catch
+	throw:bad_map ->
+	    St1 = add_warning(get_line(A), bad_map, A, St0),
+	    Erl = #c_literal{val=erlang},
+	    Name = #c_literal{val=error},
+	    Args = [#c_literal{val=badarg}],
+	    Error = #c_call{anno=A,module=Erl,name=Name,args=Args},
+	    expr(Error, Sub, St1)
+    end;
 expr(#c_binary{anno=A,segments=Cv}, Sub, St0) ->
     try atomic_bin(Cv, Sub, St0) of
 	{Kv,Ep,St1} ->
@@ -496,6 +505,21 @@ translate_match_fail_1(Anno, As, Sub, #kern{ff=FF}) ->
 translate_fc(Args) ->
     [#c_literal{val=function_clause},make_list(Args)].
 
+expr_map(A,Var0,Ces,Sub,St0) ->
+    %% An extra pass of validation of Map src because of inlining
+    {Var,Mps,St1} = expr(Var0, Sub, St0),
+    case is_valid_map_src(Var) of
+	true ->
+	    {Km,Eps,St2} = map_split_pairs(A, Var, Ces, Sub, St1),
+	    {Km,Eps++Mps,St2};
+	false -> throw(bad_map)
+    end.
+
+is_valid_map_src(#k_map{}) -> true;
+is_valid_map_src(#k_literal{val=M}) when is_map(M) -> true;
+is_valid_map_src(#k_var{}) -> true;
+is_valid_map_src(_) -> false.
+
 map_split_pairs(A, Var, Ces, Sub, St0) ->
     %% two steps
     %% 1. force variables
@@ -1986,7 +2010,9 @@ format_error(nomatch_shadow) ->
 format_error(bad_call) ->
     "invalid module and/or function name; this call will always fail";
 format_error(bad_segment_size) ->
-    "binary construction will fail because of a type mismatch".
+    "binary construction will fail because of a type mismatch";
+format_error(bad_map) ->
+    "map construction will fail because of a type mismatch".
 
 add_warning(none, Term, Anno, #kern{ws=Ws}=St) ->
     File = get_file(Anno),