Merge branch 'pan/ms_transform_warnings/OTP-6759' into dev

* pan/ms_transform_warnings/OTP-6759:
  Add testcases for ms_transform warning and fix scoping
  Add warnings for shadowed variables in ms_transform funs

3 files changed, 241 insertions, 57 deletions

diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl
index ed7a9144a8..26da3ecad2 100644
--- a/lib/compiler/src/compile.erl
+++ b/lib/compiler/src/compile.erl
@@ -824,6 +824,10 @@ foldl_transform(St, [T|Ts]) ->
 	{'EXIT',R} ->
 	    Es = [{St#compile.ifile,[{none,compile,{parse_transform,T,R}}]}],
 	    {error,St#compile{errors=St#compile.errors ++ Es}};
+	{warning, Forms, Ws} ->
+	    foldl_transform(
+	      St#compile{code=Forms,
+			 warnings=St#compile.warnings ++ Ws}, Ts);
 	Forms ->
 	    foldl_transform(St#compile{code=Forms}, Ts)
     end;
diff --git a/lib/stdlib/src/ms_transform.erl b/lib/stdlib/src/ms_transform.erl
index 78b1de6e16..a249dea525 100644
--- a/lib/stdlib/src/ms_transform.erl
+++ b/lib/stdlib/src/ms_transform.erl
@@ -43,6 +43,7 @@
 -define(ERR_GENREMOTECALL,22).
 -define(ERR_GENBINCONSTRUCT,23).
 -define(ERR_GENDISALLOWEDOP,24).
+-define(WARN_SHADOW_VAR,50).
 -define(ERR_GUARDMATCH,?ERR_GENMATCH+?ERROR_BASE_GUARD).
 -define(ERR_BODYMATCH,?ERR_GENMATCH+?ERROR_BASE_BODY).
 -define(ERR_GUARDLOCALCALL,?ERR_GENLOCALCALL+?ERROR_BASE_GUARD).
@@ -63,8 +64,13 @@
 -define(ERR_BODYDISALLOWEDOP,?ERR_GENDISALLOWEDOP+?ERROR_BASE_BODY).
 
 %%
-%% Called by compiler or ets/dbg:fun2ms when errors occur
+%% Called by compiler or ets/dbg:fun2ms when errors/warnings occur
 %%
+format_error({?WARN_SHADOW_VAR,Name}) ->
+    lists:flatten(
+      io_lib:format("variable ~p shadowed in ms_transform fun head",
+		    [Name]));
+
 format_error(?ERR_NOFUN) ->	    
     "Parameter of ets/dbg:fun2ms/1 is not a literal fun";
 format_error(?ERR_ETS_HEAD) ->	    
@@ -182,7 +188,7 @@ format_error(Else) ->
 %%
 transform_from_shell(Dialect, Clauses, BoundEnvironment) ->
     SaveFilename = setup_filename(),
-    case catch ms_clause_list(1,Clauses,Dialect) of
+    case catch ms_clause_list(1,Clauses,Dialect,gb_sets:new()) of
 	{'EXIT',Reason} ->
 	    cleanup_filename(SaveFilename),
 	    exit(Reason);
@@ -207,6 +213,7 @@ transform_from_shell(Dialect, Clauses, BoundEnvironment) ->
 %%
 parse_transform(Forms, _Options) ->
     SaveFilename = setup_filename(),
+    %io:format("Forms: ~p~n",[Forms]),
     case catch forms(Forms) of
 	{'EXIT',Reason} ->
 	    cleanup_filename(SaveFilename),
@@ -215,12 +222,31 @@ parse_transform(Forms, _Options) ->
 	    {error, [{cleanup_filename(SaveFilename),
 		      [{Line, ?MODULE, R}]}], []};
 	Else ->
-	    cleanup_filename(SaveFilename),
+	    %io:format("Transformed into: ~p~n",[Else]),
+	    case get_warnings() of
+		[] ->
+		    cleanup_filename(SaveFilename),
+		    Else;
+		WL ->
+		    FName = cleanup_filename(SaveFilename) ,
+		    WList = [ {FName, [{L, ?MODULE, R}]} || {L,R} <- WL ],
+		    {warning, Else, WList}
+	    end
+    end.
+
+get_warnings() ->
+    case get(warnings) of
+	undefined ->
+	    [];
+	Else ->
 	    Else
     end.
 
+add_warning(Line,R) ->
+    put(warnings,[{Line,R}| get_warnings()]).
+
 setup_filename() ->
-    {erase(filename),erase(records)}.
+    {erase(filename),erase(records),erase(warnings)}.
 
 put_filename(Name) ->
     put(filename,Name).
@@ -235,7 +261,7 @@ get_records() ->
 	Else ->
 	    Else
     end.
-cleanup_filename({Old,OldRec}) ->
+cleanup_filename({Old,OldRec,OldWarnings}) ->
     Ret = case erase(filename) of
 	      undefined ->
 		  "TOP_LEVEL";
@@ -248,6 +274,12 @@ cleanup_filename({Old,OldRec}) ->
 	Rec ->
 	    put(records,Rec)
     end,
+    case OldWarnings of
+	undefined ->
+	    erase(warnings);
+	Warn ->
+	    put(warnings,Warn)
+    end,
     case Old of
 	undefined ->
 	    Ret;
@@ -285,42 +317,77 @@ form({function,Line,Name0,Arity0,Clauses0}) ->
 form(AnyOther) ->
     AnyOther.
 function(Name, Arity, Clauses0) ->
-    Clauses1 = clauses(Clauses0),
+    {Clauses1,_} = clauses(Clauses0,gb_sets:new()),
     {Name,Arity,Clauses1}.
-clauses([C0|Cs]) ->
-    C1 = clause(C0),
-    [C1|clauses(Cs)];
-clauses([]) -> [].
-clause({clause,Line,H0,G0,B0}) ->
-    B1 = copy(B0),
-    {clause,Line,H0,G0,B1}.
+clauses([C0|Cs],Bound) ->
+    {C1,Bound1} = clause(C0,Bound),
+    {C2,Bound2} = clauses(Cs,Bound1),
+    {[C1|C2],Bound2};
+clauses([],Bound) -> {[],Bound}.
+clause({clause,Line,H0,G0,B0},Bound) ->
+    {H1,Bound1} = copy(H0,Bound),
+    {B1,Bound2} = copy(B0,Bound1),
+    {{clause,Line,H1,G0,B1},Bound2}.
 
 copy({call,Line,{remote,_Line2,{atom,_Line3,ets},{atom,_Line4,fun2ms}},
-      As0}) ->
-    transform_call(ets,Line,As0);
+      As0},Bound) ->
+    {transform_call(ets,Line,As0,Bound),Bound};
 copy({call,Line,{remote,_Line2,{record_field,_Line3,
                                 {atom,_Line4,''},{atom,_Line5,ets}},
-                 {atom,_Line6,fun2ms}}, As0}) ->
+                 {atom,_Line6,fun2ms}}, As0},Bound) ->
     %% Packages...
-    transform_call(ets,Line,As0);
+    {transform_call(ets,Line,As0,Bound),Bound};
 copy({call,Line,{remote,_Line2,{atom,_Line3,dbg},{atom,_Line4,fun2ms}},
-      As0}) ->
-    transform_call(dbg,Line,As0);
-copy(T) when is_tuple(T) ->
-    list_to_tuple(copy_list(tuple_to_list(T)));
-copy(L) when is_list(L) ->
-    copy_list(L);
-copy(AnyOther) ->
-    AnyOther.
+      As0},Bound) ->
+    {transform_call(dbg,Line,As0,Bound),Bound};
+copy({match,Line,A,B},Bound) ->
+    {B1,Bound1} = copy(B,Bound),
+    {A1,Bound2} = copy(A,Bound),
+    {{match,Line,A1,B1},gb_sets:union(Bound1,Bound2)};
+copy({var,_Line,'_'} = VarDef,Bound) ->
+    {VarDef,Bound};
+copy({var,_Line,Name} = VarDef,Bound) ->
+    Bound1 = gb_sets:add(Name,Bound),
+    {VarDef,Bound1};
+copy({'fun',Line,{clauses,Clauses}},Bound) -> % Dont export bindings from funs
+    {NewClauses,_IgnoredBindings} = copy_list(Clauses,Bound),
+    {{'fun',Line,{clauses,NewClauses}},Bound};
+copy({'case',Line,Of,ClausesList},Bound) -> % Dont export bindings from funs
+    {NewOf,NewBind0} = copy(Of,Bound),
+    {NewClausesList,NewBindings} = copy_case_clauses(ClausesList,NewBind0,[]),
+    {{'case',Line,NewOf,NewClausesList},NewBindings};
+copy(T,Bound) when is_tuple(T) ->
+    {L,Bound1} = copy_list(tuple_to_list(T),Bound),
+    {list_to_tuple(L),Bound1};
+copy(L,Bound) when is_list(L) ->
+    copy_list(L,Bound);
+copy(AnyOther,Bound) ->
+    {AnyOther,Bound}.
 
-copy_list([H|T]) ->
-    [copy(H)|copy_list(T)];
-copy_list([]) ->
-    [].
+copy_case_clauses([],Bound,AddSets) ->
+    ReallyAdded = gb_sets:intersection(AddSets),
+    {[],gb_sets:union(Bound,ReallyAdded)};
+copy_case_clauses([{clause,Line,Match,Guard,Clauses}|T],Bound,AddSets) ->
+    {NewMatch,MatchBinds} = copy(Match,Bound),
+    {NewGuard,GuardBinds} = copy(Guard,MatchBinds), %% Really no new binds
+    {NewClauses,AllBinds} = copy(Clauses,GuardBinds),
+    %% To limit the setsizes, I subtract what I had before the case clause
+    %% and add it in the end
+    AddedBinds = gb_sets:subtract(AllBinds,Bound),
+    {NewTail,ExportedBindings} =
+	copy_case_clauses(T,Bound,[AddedBinds | AddSets]),
+    {[{clause,Line,NewMatch,NewGuard,NewClauses}|NewTail],ExportedBindings}.
 
-transform_call(Type,_Line,[{'fun',Line2,{clauses, ClauseList}}]) ->
-    ms_clause_list(Line2, ClauseList,Type);
-transform_call(_Type,Line,_NoAbstractFun) ->
+copy_list([H|T],Bound) ->
+    {C1,Bound1} = copy(H,Bound),
+    {C2,Bound2} = copy_list(T,Bound1),
+    {[C1|C2],Bound2};
+copy_list([],Bound) ->
+    {[],Bound}.
+
+transform_call(Type,_Line,[{'fun',Line2,{clauses, ClauseList}}],Bound) ->
+    ms_clause_list(Line2, ClauseList,Type,Bound);
+transform_call(_Type,Line,_NoAbstractFun,_) ->
     throw({error,Line,?ERR_NOFUN}).
 
 % Fixup semicolons in guards
@@ -329,18 +396,19 @@ ms_clause_expand({clause, Line, Parameters, Guard = [_,_|_], Body}) ->
 ms_clause_expand(_Other) ->
     false.
 
-ms_clause_list(Line,[H|T],Type) ->
+ms_clause_list(Line,[H|T],Type,Bound) ->
     case ms_clause_expand(H) of
 	NewHead when is_list(NewHead) ->
-	    ms_clause_list(Line,NewHead ++ T, Type);
+	    ms_clause_list(Line,NewHead ++ T, Type, Bound);
 	false ->
-	    {cons, Line, ms_clause(H,Type), ms_clause_list(Line, T,Type)}
+	    {cons, Line, ms_clause(H, Type, Bound),
+	     ms_clause_list(Line, T, Type, Bound)}
     end;
-ms_clause_list(Line,[],_) ->
+ms_clause_list(Line,[],_,_) ->
     {nil,Line}.
-ms_clause({clause, Line, Parameters, Guards, Body},Type) ->
+ms_clause({clause, Line, Parameters, Guards, Body},Type,Bound) ->
     check_type(Line,Parameters,Type),
-    {MSHead,Bindings} = transform_head(Parameters),
+    {MSHead,Bindings} = transform_head(Parameters,Bound),
     MSGuards = transform_guards(Line, Guards, Bindings),
     MSBody = transform_body(Line,Body,Bindings),
     {tuple, Line, [MSHead,MSGuards,MSBody]}.
@@ -627,29 +695,31 @@ tg(Other,B) ->
     Element = io_lib:format("unknown element ~w", [Other]),
     throw({error,unknown,{?ERR_GENELEMENT+B#tgd.eb,Element}}).
 
-transform_head([V]) ->
+transform_head([V],OuterBound) ->
     Bind = cre_bind(),
-    {NewV,NewBind} = toplevel_head_match(V,Bind),
-    th(NewV,NewBind).
+    {NewV,NewBind} = toplevel_head_match(V,Bind,OuterBound),
+    th(NewV,NewBind,OuterBound).
 
 
-toplevel_head_match({match,_,{var,_,VName},Expr},B) ->
+toplevel_head_match({match,Line,{var,_,VName},Expr},B,OB) ->
+    warn_var_clash(Line,VName,OB),
     {Expr,new_bind({VName,'$_'},B)};
-toplevel_head_match({match,_,Expr,{var,_,VName}},B) ->
+toplevel_head_match({match,Line,Expr,{var,_,VName}},B,OB) ->
+    warn_var_clash(Line,VName,OB),
     {Expr,new_bind({VName,'$_'},B)};
-toplevel_head_match(Other,B) ->
+toplevel_head_match(Other,B,_OB) ->
     {Other,B}.
 
-th({record,Line,RName,RFields},B) ->
+th({record,Line,RName,RFields},B,OB) ->
     % youch...
     RDefs = get_records(),
     {KeyList0,NewB} = lists:foldl(fun({record_field,_,{atom,_,Key},Value},
 				     {L,B0}) ->
-					 {NV,B1} = th(Value,B0),
+					 {NV,B1} = th(Value,B0,OB),
 					 {[{Key,NV}|L],B1};
 				    ({record_field,_,{var,_,'_'},Value},
 				     {L,B0}) ->
-					 {NV,B1} = th(Value,B0),
+					 {NV,B1} = th(Value,B0,OB),
 					 {[{{default},NV}|L],B1};
 				    (_,_) ->
 					 throw({error,Line,{?ERR_HEADBADREC,
@@ -692,9 +762,9 @@ th({record,Line,RName,RFields},B) ->
 	_ ->
 	    throw({error,Line,{?ERR_HEADBADREC,RName}})
     end;
-th({match,Line,_,_},_) -> 
+th({match,Line,_,_},_,_) ->
     throw({error,Line,?ERR_HEADMATCH});
-th({atom,Line,A},B) ->
+th({atom,Line,A},B,_OB) ->
     case atom_to_list(A) of
 	[$$|NL] ->
 	    case (catch list_to_integer(NL)) of
@@ -706,10 +776,11 @@ th({atom,Line,A},B) ->
 	_ ->
 	    {{atom,Line,A},B}
     end;
-th({bin_element,_Line0,{var, Line, A},_,_},_) ->
+th({bin_element,_Line0,{var, Line, A},_,_},_,_) ->
     throw({error,Line,{?ERR_HEADBINMATCH,A}});
 
-th({var,Line,Name},B) ->
+th({var,Line,Name},B,OB) ->
+    warn_var_clash(Line,Name,OB),
     case lkup_bind(Name,B) of
 	undefined ->
 	    NewB = new_bind(Name,B),
@@ -717,16 +788,24 @@ th({var,Line,Name},B) ->
 	Trans ->
 	    {{atom,Line,Trans},B}
     end;
-th([H|T],B) ->
-    {NH,NB} = th(H,B),
-    {NT,NNB} = th(T,NB),
+th([H|T],B,OB) ->
+    {NH,NB} = th(H,B,OB),
+    {NT,NNB} = th(T,NB,OB),
     {[NH|NT],NNB};
-th(T,B) when is_tuple(T) ->
-    {L,NB} = th(tuple_to_list(T),B),
+th(T,B,OB) when is_tuple(T) ->
+    {L,NB} = th(tuple_to_list(T),B,OB),
     {list_to_tuple(L),NB};
-th(Nonstruct,B) ->
+th(Nonstruct,B,_OB) ->
     {Nonstruct,B}.
 
+warn_var_clash(Line,Name,OuterBound) ->
+    case gb_sets:is_member(Name,OuterBound) of
+	true ->
+	    add_warning(Line,{?WARN_SHADOW_VAR,Name});
+	_ ->
+	    ok
+    end.
+
 %% Could be more efficient...
 check_multi_field(_, _, [], _) ->
     ok;
diff --git a/lib/stdlib/test/ms_transform_SUITE.erl b/lib/stdlib/test/ms_transform_SUITE.erl
index 79a0a9af89..2d90d5b823 100644
--- a/lib/stdlib/test/ms_transform_SUITE.erl
+++ b/lib/stdlib/test/ms_transform_SUITE.erl
@@ -37,6 +37,7 @@
 -export([andalso_orelse/1]).
 -export([float_1_function/1]).
 -export([action_function/1]).
+-export([warnings/1]).
 -export([init_per_testcase/2, fin_per_testcase/2]).
 
 init_per_testcase(_Func, Config) ->
@@ -50,8 +51,90 @@ fin_per_testcase(_Func, Config) ->
 all(suite) -> [from_shell,basic_ets,basic_dbg,records,record_index,multipass,
 	       bitsyntax, record_defaults, andalso_orelse,
                float_1_function, action_function, 
+	       warnings,
 	       top_match, old_guards, autoimported, semicolon].
 
+%% This may be subject to change
+-define(WARN_NUMBER_SHADOW,50).
+warnings(suite) ->
+    [];
+warnings(doc) ->
+    ["Check that shadowed variables in fun head generate warning"];
+warnings(Config) when is_list(Config) ->
+    ?line setup(Config),
+    Prog = <<"A=5, "
+	    "ets:fun2ms(fun({A,B}) "
+	    "            when is_integer(A) and (A+5 > B) -> "
+	    "              A andalso B "
+	    "            end)">>,
+    ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}}]}] =
+	compile_ww(Prog),
+    Prog2 = <<"C=5, "
+	    "ets:fun2ms(fun({A,B} = C) "
+	    "            when is_integer(A) and (A+5 > B) -> "
+	    "              {A andalso B,C} "
+	    "            end)">>,
+    ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] =
+	compile_ww(Prog2),
+    Rec3 = <<"-record(a,{a,b,c,d=foppa}).">>,
+    Prog3 = <<"A=3,C=5, "
+	    "ets:fun2ms(fun(#a{a = A, b = B} = C) "
+	    "            when is_integer(A) and (A+5 > B) -> "
+	    "              {A andalso B,C} "
+	    "            end)">>,
+    ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}},
+	       {_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] =
+	compile_ww(Rec3,Prog3),
+    Rec4 = <<"-record(a,{a,b,c,d=foppa}).">>,
+    Prog4 = <<"A=3,C=5, "
+	     "F = fun(B) -> B*3 end,"
+	     "erlang:display(F(A)),"
+	     "ets:fun2ms(fun(#a{a = A, b = B} = C) "
+	     "            when is_integer(A) and (A+5 > B) -> "
+	     "              {A andalso B,C} "
+	     "            end)">>,
+    ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}},
+	       {_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] =
+	compile_ww(Rec4,Prog4),
+    Rec5 = <<"-record(a,{a,b,c,d=foppa}).">>,
+    Prog5 = <<"A=3,C=5, "
+	     "F = fun(B) -> B*3 end,"
+	     "erlang:display(F(A)),"
+	     "B = ets:fun2ms(fun(#a{a = A, b = B} = C) "
+	     "            when is_integer(A) and (A+5 > B) -> "
+	     "              {A andalso B,C} "
+	     "            end)">>,
+    ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'A'}},
+	       {_,ms_transform,{?WARN_NUMBER_SHADOW,'C'}}]}] =
+	compile_ww(Rec5,Prog5),
+    Prog6 = <<"   X=bar, "
+	     "    A = case X of"
+	     "       foo ->"
+	     "          foo;"
+	     "       Y ->"
+	     "          ets:fun2ms(fun(Y) ->" % This is a warning
+	     "                         3*Y"
+	     "                     end)"
+	     "   end,"
+	     "   ets:fun2ms(fun(Y) ->" % Y out of "scope" here, so no warning
+	     "                  {3*Y,A}"
+	     "              end)">>,
+    ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'Y'}}]}] =
+	compile_ww(Prog6),
+    Prog7 = <<"   X=bar, "
+	     "    A = case X of"
+	     "       foo ->"
+	     "          Y = foo;"
+	     "       Y ->"
+	     "          bar"
+	     "   end,"
+	     "   ets:fun2ms(fun(Y) ->" % Y exported from case and safe, so warn
+	     "                  {3*Y,A}"
+	     "              end)">>,
+    ?line [{_,[{_,ms_transform,{?WARN_NUMBER_SHADOW,'Y'}}]}] =
+	compile_ww(Prog7),
+    ok.
+
 andalso_orelse(suite) ->
     [];
 andalso_orelse(doc) ->
@@ -721,6 +804,24 @@ compile_and_run(Records,Expr) ->
     code:load_binary(tmp,FN,Bin),
     tmp:tmp().
 
+compile_ww(Expr) ->
+    compile_ww(<<>>,Expr).
+compile_ww(Records,Expr) ->
+    Prog = <<
+	"-module(tmp).\n",
+    "-include_lib(\"stdlib/include/ms_transform.hrl\").\n",
+    "-export([tmp/0]).\n",
+    Records/binary,"\n",
+    "tmp() ->\n",
+    Expr/binary,".\n">>,
+    FN=temp_name(),
+    file:write_file(FN,Prog),
+    {ok,Forms} = epp:parse_file(FN,"",""),
+    {ok,tmp,_Bin,Wlist} = compile:forms(Forms,[return_warnings,
+					       nowarn_unused_vars,
+					       nowarn_unused_record]),
+    Wlist.
+
 do_eval(String) ->
     {done,{ok,T,_},[]} = erl_scan:tokens(
 			   [],