From 2d95280094fa6429081a9b9df3c73705819e2461 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn-Egil=20Dahlberg?= <egil@erlang.org>
Date: Tue, 25 Mar 2014 19:06:22 +0100
Subject: compiler: Do not evaluate map expressions with bad keys

Map keys with large (non literal) binary keys must fail.
---
 lib/compiler/src/v3_core.erl    | 30 ++++++++++++++++++++++++------
 lib/compiler/test/map_SUITE.erl |  4 +++-
 2 files changed, 27 insertions(+), 7 deletions(-)

(limited to 'lib')

diff --git a/lib/compiler/src/v3_core.erl b/lib/compiler/src/v3_core.erl
index 46db9139c4..a548ba2f7c 100644
--- a/lib/compiler/src/v3_core.erl
+++ b/lib/compiler/src/v3_core.erl
@@ -514,15 +514,26 @@ expr({tuple,L,Es0}, St0) ->
 expr({map,L,Es0}, St0) ->
     % erl_lint should make sure only #{ K => V } are allowed
     % in map construction.
-    {Es1,Eps,St1} = map_pair_list(Es0, St0),
-    A = lineno_anno(L, St1),
-    {ann_c_map(A,Es1),Eps,St1};
+    try map_pair_list(Es0, St0) of
+	{Es1,Eps,St1} ->
+	    A = lineno_anno(L, St1),
+	    {ann_c_map(A,Es1),Eps,St1}
+    catch
+	throw:{bad_map,Warning} ->
+	    St = add_warning(L, Warning, 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({map,L,M0,Es0}, St0) ->
     try expr_map(M0,Es0,lineno_anno(L, St0),St0) of
 	{_,_,_}=Res -> Res
     catch
-	throw:bad_map ->
-	    St = add_warning(L, bad_map, St0),
+	throw:{bad_map,Warning} ->
+	    St = add_warning(L, Warning, St0),
 	    LineAnno = lineno_anno(L, St),
 	    As = [#c_literal{anno=LineAnno,val=badarg}],
 	    {#icall{anno=#a{anno=LineAnno},	%Must have an #a{}
@@ -762,7 +773,7 @@ expr_map(M0,Es0,A,St0) ->
 		    {Es1,Eps,St2} = map_pair_list(Es0, St1),
 		    {ann_c_map(A,M1,Es1),Mps++Eps,St2}
 	    end;
-	false -> throw(bad_map)
+	false -> throw({bad_map,bad_map})
     end.
 
 is_valid_map_src(#c_literal{val = M}) when is_map(M) -> true;
@@ -774,18 +785,23 @@ map_pair_list(Es, St) ->
     foldr(fun
 	    ({map_field_assoc,L,K0,V0}, {Ces,Esp,St0}) ->
 		{K,Ep0,St1} = safe(K0, St0),
+		ok = ensure_valid_map_key(K),
 		{V,Ep1,St2} = safe(V0, St1),
 		A = lineno_anno(L, St2),
 		Pair = #c_map_pair{op=#c_literal{val=assoc},anno=A,key=K,val=V},
 		{[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2};
 	    ({map_field_exact,L,K0,V0}, {Ces,Esp,St0}) ->
 		{K,Ep0,St1} = safe(K0, St0),
+		ok = ensure_valid_map_key(K),
 		{V,Ep1,St2} = safe(V0, St1),
 		A = lineno_anno(L, St2),
 		Pair = #c_map_pair{op=#c_literal{val=exact},anno=A,key=K,val=V},
 		{[Pair|Ces],Ep0 ++ Ep1 ++ Esp,St2}
 	end, {[],[],St}, Es).
 
+ensure_valid_map_key(#c_literal{}) -> ok;
+ensure_valid_map_key(_) -> throw({bad_map,bad_map_key}).
+
 %% try_exception([ExcpClause], St) -> {[ExcpVar],Handler,St}.
 
 try_exception(Ecs0, St0) ->
@@ -2301,6 +2317,8 @@ format_error(nomatch) ->
     "pattern cannot possibly match";
 format_error(bad_binary) ->
     "binary construction will fail because of a type mismatch";
+format_error(bad_map_key) ->
+    "map construction will fail because of none literal key (large binaries are not literals)";
 format_error(bad_map) ->
     "map construction will fail because of a type mismatch".
 
diff --git a/lib/compiler/test/map_SUITE.erl b/lib/compiler/test/map_SUITE.erl
index f1383297ef..cc018e4305 100644
--- a/lib/compiler/test/map_SUITE.erl
+++ b/lib/compiler/test/map_SUITE.erl
@@ -122,6 +122,7 @@ t_build_and_match_literals(Config) when is_list(Config) ->
     {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))),
     {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))),
     {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))),
+    {'EXIT',{badarg,_}} = (catch id(#{<<0:258>> =>"three"})),
     ok.
 
 t_build_and_match_aliasing(Config) when is_list(Config) ->
@@ -239,7 +240,7 @@ t_update_assoc(Config) when is_list(Config) ->
     BadMap = id(badmap),
     {'EXIT',{badarg,_}} = (catch BadMap#{nonexisting=>val}),
     {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting=>val}),
-
+    {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> => val}), %% limitation
     ok.
 
 t_update_exact(Config) when is_list(Config) ->
@@ -268,6 +269,7 @@ t_update_exact(Config) when is_list(Config) ->
     {'EXIT',{badarg,_}} = (catch M0#{42.0:=v,42:=v2}),
     {'EXIT',{badarg,_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}),
     {'EXIT',{badarg,_}} = (catch <<>>#{nonexisting:=val}),
+    {'EXIT',{badarg,_}} = (catch M0#{<<0:257>> := val}), %% limitation
     ok.
 
 t_update_values(Config) when is_list(Config) ->
-- 
cgit v1.2.3