From fc096c62a2d3f62e8f3559038d8313a01dd74570 Mon Sep 17 00:00:00 2001 From: Fredrik Frantzen Date: Tue, 4 Feb 2025 06:54:47 +0100 Subject: [PATCH] fix: throw warnings when record fields use previously bound variables update erl_lint_SUITE tests --- lib/stdlib/src/erl_expand_records.erl | 2 +- lib/stdlib/src/erl_lint.erl | 22 ++++++++++------- lib/stdlib/test/erl_lint_SUITE.erl | 34 +++++++++++++++++---------- 3 files changed, 36 insertions(+), 22 deletions(-) diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index f969e3e2cb6d..30669d9177bc 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -295,7 +295,7 @@ free_variables(AF, Acc) -> catch throw:{error,unsafe_variable} -> true end. -free_variables1({'fun',_anno,_}, Acc) -> +free_variables1({'fun',_anno,{clauses, _}}, Acc) -> {function,Acc}; %% tag that we are in a 'fun' now that can define new variables free_variables1({clause,_anno,Pattern,_guards,_body}, {function,Acc}) -> lists:flatten(traverse_af(Pattern, fun save_vars/2, [])++Acc); diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 98fe8be12130..a560203b4e5f 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -449,6 +449,9 @@ format_error_1({unbound_var,V,GuessV}) -> format_error_1({unsafe_var,V,{What,Where}}) -> {~"variable ~w unsafe in ~w ~s", [V,What,format_where(Where)]}; +format_error_1({exported_var,V,{{record_field,R,F},Where}}) -> + {~"variable ~w exported from #~w.~w ~s", + [V,R,F,format_where(Where)]}; format_error_1({exported_var,V,{What,Where}}) -> {~"variable ~w exported from ~w ~s", [V,What,format_where(Where)]}; @@ -467,8 +470,6 @@ format_error_1({shadowed_var,V,In}) -> {~"variable ~w shadowed in ~w", [V,In]}; format_error_1({unused_var, V}) -> {~"variable ~w is unused", [V]}; -format_error_1({variable_in_record_def,V}) -> - {~"variable ~w in record definition", [V]}; format_error_1({stacktrace_guard,V}) -> {~"stacktrace variable ~w must not be used in a guard", [V]}; format_error_1({stacktrace_bound,V}) -> @@ -3071,7 +3072,7 @@ record_def(Anno, Name, Fs0, St0) -> case is_map_key(Name, St0#lint.records) of true -> add_error(Anno, {redefine_record,Name}, St0); false -> - {Fs1,St1} = def_fields(normalise_fields(Fs0), Name, St0), + {Fs1,_,St1} = def_fields(normalise_fields(Fs0), Name, St0), St2 = St1#lint{records=maps:put(Name, {Anno,Fs1}, St1#lint.records)}, Types = [T || {typed_record_field, _, T} <- Fs0], @@ -3084,11 +3085,16 @@ record_def(Anno, Name, Fs0, St0) -> %% record and set State. def_fields(Fs0, Name, St0) -> - foldl(fun ({record_field,Af,{atom,Aa,F},V}, {Fs,St}) -> + foldl(fun ({record_field,Af,{atom,Aa,F},V}, {Fs,Vt0,St}) -> case exist_field(F, Fs) of - true -> {Fs,add_error(Af, {redefine_field,Name,F}, St)}; + true -> {Fs,Vt0,add_error(Af, {redefine_field,Name,F}, St)}; false -> - {_,St2} = expr(V, [], St), + {Vt1,St2} = expr(V, Vt0, St), + %% Everything that was bound is exported to the next field + Vt2 = lists:map( + fun({Var,{bound,Usage,Ls}}) -> + {Var, {{export, {{'record_field', Name, F}, Af}}, Usage,Ls}}; + (X) -> X end, Vt1), %% Warnings and errors found are kept, but %% updated calls, records, etc. are discarded. St3 = St#lint{warnings = St2#lint.warnings, @@ -3100,9 +3106,9 @@ def_fields(Fs0, Name, St0) -> true -> V; false -> {atom,Aa,undefined} end, - {[{record_field,Af,{atom,Aa,F},NV}|Fs],St3} + {[{record_field,Af,{atom,Aa,F},NV}|Fs],Vt2,St3} end - end, {[],St0}, Fs0). + end, {[],[],St0}, Fs0). %% normalise_fields([RecDef]) -> [Field]. %% Normalise the field definitions to always have a default value. If diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index eb2dddd7941a..1d2e18c9bdc4 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -877,7 +877,22 @@ export_vars_warn(Config) when is_list(Config) -> Z = X. ">>, [], - {warnings,[{{7,19},erl_lint,{exported_var,'Z',{'if',{2,19}}}}]}} + {warnings,[{{7,19},erl_lint,{exported_var,'Z',{'if',{2,19}}}}]}}, + {exp5, + <<"-record(r0, {a=X=1, + b=X=2}). + -record(r1, {a=case 1 of Z -> X=Z end, + b=case 2 of X -> Y=Z=2 end}). + -record(r2, {a=case 1 of X -> X end, + b=(fun()-> X=2 end)()}). + ">>, + [],{warnings,[{{1,22},erl_lint,{unused_record,r0}}, + {{2,31},erl_lint,{exported_var,'X',{{record_field,r0,a},{1,34}}}}, + {{3,17},erl_lint,{unused_record,r1}}, + {{4,41},erl_lint,{exported_var,'X',{'case',{3,31}}}}, + {{4,48},erl_lint,{exported_var,'Z',{'case',{3,31}}}}, + {{5,17},erl_lint,{unused_record,r2}}, + {{6,40},erl_lint,{exported_var,'X',{'case',{5,31}}}}]}} ], [] = run(Config, Ts), ok. @@ -2846,10 +2861,8 @@ otp_5878(Config) when is_list(Config) -> t() -> #r2{}. ">>, [warn_unused_record], - {error,[{{1,44},erl_lint,{variable_in_record_def,'A'}}, - {{1,54},erl_lint,{unbound_var,'B'}}, - {{2,38},erl_lint,{variable_in_record_def,'A'}}], - [{{1,22},erl_lint,{unused_record,r1}}]}}, + {errors,[{{1,54},erl_lint,{unbound_var,'B'}}], + []}}, {otp_5878_30, <<"-record(r1, {t = case foo of _ -> 3 end}). @@ -2859,9 +2872,7 @@ otp_5878(Config) when is_list(Config) -> t() -> {#r1{},#r2{},#r3{},#r4{}}. ">>, [warn_unused_record], - {errors,[{{2,44},erl_lint,{variable_in_record_def,'A'}}, - {{3,44},erl_lint,{variable_in_record_def,'A'}}], - []}}, + []}, {otp_5878_40, <<"-record(r1, {foo = A}). % A unbound @@ -2898,9 +2909,7 @@ otp_5878(Config) when is_list(Config) -> ">>, [warn_unused_record], {error,[{{1,39},erl_lint,{unbound_var,'A'}}, - {{2,33},erl_lint,{unbound_var,'A'}}, - {{4,42},erl_lint,{variable_in_record_def,'A'}}, - {{17,44},erl_lint,{variable_in_record_def,'A'}}], + {{2,33},erl_lint,{unbound_var,'A'}}], [{{8,36},erl_lint,{unused_var,'X'}}]}}, {otp_5878_60, @@ -2922,8 +2931,7 @@ otp_5878(Config) when is_list(Config) -> t() -> #r1{}. ">>, [warn_unused_record], - {errors,[{{3,40},erl_lint,{unbound_var,'Y'}}, - {{4,38},erl_lint,{variable_in_record_def,'Y'}}], + {errors,[{{3,40},erl_lint,{unbound_var,'Y'}}], []}}, {otp_5878_80,