From c0b3be816ff3a960a4237406fee2907f9e44f08f Mon Sep 17 00:00:00 2001 From: Richard Carlsson Date: Sun, 1 Dec 2024 15:50:00 +0100 Subject: [PATCH 1/4] Use a helper function to avoid code duplication --- lib/stdlib/src/erl_lint.erl | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index a24142ead5c3..ce4768798fe7 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -2814,16 +2814,16 @@ expr({'try',Anno,Es,Scs,Ccs,As}, Vt, St0) -> vtupdate(Evt0, Vt), Uvt, St1), Evt1 = vtupdate(Uvt, Evt0), Rvt0 = Sccs, - Rvt1 = vtupdate(vtunsafe(TryAnno, Rvt0, Vt), Rvt0), + Rvt1 = vtupd_unsafe(TryAnno, Rvt0, Vt), Evt2 = vtmerge(Evt1, Rvt1), {Avt0,St} = exprs(As, vtupdate(Evt2, Vt), St2), - Avt1 = vtupdate(vtunsafe(TryAnno, Avt0, Vt), Avt0), + Avt1 = vtupd_unsafe(TryAnno, Avt0, Vt), Avt = vtmerge(Evt2, Avt1), {Avt,St}; expr({'catch',Anno,E}, Vt, St0) -> %% No new variables added, flag new variables as unsafe. {Evt,St} = expr(E, Vt, St0), - {vtupdate(vtunsafe({'catch',Anno}, Evt, Vt), Evt),St}; + {vtupd_unsafe({'catch', Anno}, Evt, Vt), St}; expr({match,_Anno,P,E}, Vt, St0) -> {Evt,St1} = expr(E, Vt, St0), {Pvt,Pnew,St} = pattern(P, vtupdate(Evt, Vt), St1), @@ -2852,7 +2852,7 @@ expr({op,Anno,Op,L,R}, Vt, St0) when Op =:= 'orelse'; Op =:= 'andalso' -> {Evt1,St1} = expr(L, Vt, St0), Vt1 = vtupdate(Evt1, Vt), {Evt2,St2} = expr(R, Vt1, St1), - Evt3 = vtupdate(vtunsafe({Op,Anno}, Evt2, Vt1), Evt2), + Evt3 = vtupd_unsafe({Op, Anno}, Evt2, Vt1), {vtmerge(Evt1, Evt3),St2}; expr({op,_Anno,EqOp,L,R}, Vt, St0) when EqOp =:= '=:='; EqOp =:= '=/=' -> St = expr_check_match_zero(R, expr_check_match_zero(L, St0)), @@ -4439,6 +4439,9 @@ vtunsafe({Tag,Anno}, Uvt, Vt) -> Location = erl_anno:location(Anno), [{V,{{unsafe,{Tag,Location}},U,As}} || {V,{_,U,As}} <- vtnew(Uvt, Vt)]. +vtupd_unsafe(Where, NewVt, OldVt) -> + vtupdate(vtunsafe(Where, NewVt, OldVt), NewVt). + %% vtmerge(VarTable, VarTable) -> VarTable. %% Merge two variables tables generating a new vartable. Give priority to %% errors then warnings. From da363aaf1132642c7b83d34417a47ba29f4ad341 Mon Sep 17 00:00:00 2001 From: Richard Carlsson Date: Sun, 1 Dec 2024 18:22:35 +0100 Subject: [PATCH 2/4] Always warn about exported variables from constructs without clauses There is never a good reason for placing variable bindings inside the arguments of an expression. --- lib/stdlib/src/erl_lint.erl | 97 +++++++++++++++++++++++++++---------- 1 file changed, 71 insertions(+), 26 deletions(-) diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index ce4768798fe7..a4e3e264eba3 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -458,6 +458,13 @@ 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_subexpr_var,V,{What,Where}}) -> + {~""" + variable ~w exported from ~w ~s. + Exporting bindings from subexpressions is deprecated and + may be removed in a future version of Erlang/OTP. + You should move the binding of ~w before the ~w. + """, [V,What,format_where(Where),V,What]}; format_error_1({exported_var,V,{What,Where}}) -> {~"variable ~w exported from ~w ~s", [V,What,format_where(Where)]}; @@ -2679,21 +2686,27 @@ expr({atom,Anno,A}, _Vt, St) -> {[],keyword_warning(Anno, A, St)}; expr({string,_Anno,_S}, _Vt, St) -> {[],St}; expr({nil,_Anno}, _Vt, St) -> {[],St}; -expr({cons,_Anno,H,T}, Vt, St) -> - expr_list([H,T], Vt, St); +expr({cons,Anno,H,T}, Vt, St) -> + vtupd_export_expr_list({list, Anno}, [H, T], Vt, St); expr({lc,_Anno,E,Qs}, Vt, St) -> handle_comprehension(E, Qs, Vt, St); expr({bc,_Anno,E,Qs}, Vt, St) -> handle_comprehension(E, Qs, Vt, St); expr({mc,_Anno,E,Qs}, Vt, St) -> handle_comprehension(E, Qs, Vt, St); -expr({tuple,_Anno,Es}, Vt, St) -> - expr_list(Es, Vt, St); -expr({map,_Anno,Es}, Vt, St) -> - map_fields(Es, Vt, check_assoc_fields(Es, St), fun expr_list/3); +expr({tuple,Anno,Es}, Vt, St) -> + vtupd_export_expr_list({tuple, Anno}, Es, Vt, St); +expr({map,Anno,Es}, Vt, St) -> + map_fields(Es, Vt, check_assoc_fields(Es, St), + fun(Es0, Vt0, St0) -> + vtupd_export_expr_list({map, Anno}, Es0, Vt0, St0) + end); expr({map,Anno,Src,Es}, Vt, St) -> - {Svt,St1} = expr(Src, Vt, St), - {Fvt,St2} = map_fields(Es, Vt, St1, fun expr_list/3), + {Svt,St1} = vtupd_export_expr_list({map, Anno}, [Src], Vt, St), + {Fvt,St2} = map_fields(Es, Vt, St1, + fun(Es0, Vt0, St0) -> + vtupd_export_expr_list({map, Anno}, Es0, Vt0, St0) + end), {vtupdate(Svt, Fvt), warn_if_literal_update(Anno, Src, St2)}; expr({record_index,Anno,Name,Field}, _Vt, St) -> check_record(Anno, Name, St, @@ -2720,11 +2733,13 @@ expr({record,Anno,Rec,Name,Upds}, Vt, St0) -> no -> {vtmerge(Rvt, Usvt), warn_if_literal_update(Anno, Rec, St2)}; WildAnno -> {[],add_error(WildAnno, {wildcard_in_update,Name}, St2)} end; -expr({bin,_Anno,Fs}, Vt, St) -> - expr_bin(Fs, Vt, St, fun expr/3); -expr({block,_Anno,Es}, Vt, St) -> +expr({bin,Anno,Fs}, Vt, St) -> + {Vt1, St1} = expr_bin(Fs, Vt, St, fun expr/3), + {vtupd_export({binary, Anno}, Vt1, Vt), St1}; +expr({block,Anno,Es}, Vt, St) -> %% Unfold block into a sequence. - exprs(Es, Vt, St); + {Vt1, St1} = exprs(Es, Vt, St), + {vtupd_export({'begin', Anno}, Vt1, Vt), St1}; expr({'if',Anno,Cs}, Vt, St) -> icrt_clauses(Cs, {'if',Anno}, Vt, St); expr({'case',Anno,E,Cs}, Vt, St0) -> @@ -2786,7 +2801,7 @@ expr({call,Anno,{remote,_Ar,{atom,_Am,M},{atom,Af,F}},As}, Vt, St0) -> St2 = check_remote_function(Anno, M, F, As, St1), St3 = check_module_name(M, Anno, St2), St4 = check_unexported_function(Anno, M, F, length(As), St3), - expr_list(As, Vt, St4); + vtupd_export_expr_list({call, Anno}, As, Vt, St4); expr({call,Anno,{remote,_Ar,M,F},As}, Vt, St0) -> St1 = keyword_warning(Anno, M, St0), St2 = keyword_warning(Anno, F, St1), @@ -2796,14 +2811,14 @@ expr({call,Anno,{remote,_Ar,M,F},As}, Vt, St0) -> _ -> St2 end, - expr_list([M,F|As], Vt, St3); + vtupd_export_expr_list({call, Anno}, [M, F | As], Vt, St3); expr({call,Anno,{atom,Aa,F},As}, Vt, St0) -> St1 = keyword_warning(Aa, F, St0), - {Asvt,St2} = expr_list(As, Vt, St1), + {Asvt,St2} = vtupd_export_expr_list({call, Anno}, As, Vt, St1), {Asvt, check_call(Anno, F, As, Aa, St2)}; expr({call,Anno,F,As}, Vt, St0) -> St = warn_invalid_call(Anno,F,St0), - expr_list([F|As], Vt, St); %They see the same variables + vtupd_export_expr_list({call, Anno}, [F | As], Vt, St); %They see the same variables expr({'try',Anno,Es,Scs,Ccs,As}, Vt, St0) -> %% The only exports we allow are from the try expressions to the %% success clauses. @@ -2846,19 +2861,19 @@ expr({'maybe',MaybeAnno,Es,{'else',ElseAnno,Cs}}, Vt, St) -> Cvt2 = vtmerge(Cvt0, Cvt1), {vtmerge(Evt2, Cvt2),St2}; %% No comparison or boolean operators yet. -expr({op,_Anno,_Op,A}, Vt, St) -> - expr(A, Vt, St); +expr({op,Anno,Op,A}, Vt, St) -> + vtupd_export_expr_list({Op, Anno}, [A], Vt, St); expr({op,Anno,Op,L,R}, Vt, St0) when Op =:= 'orelse'; Op =:= 'andalso' -> - {Evt1,St1} = expr(L, Vt, St0), + {Evt1, St1} = vtupd_export_expr_list({Op, Anno}, [L], Vt, St0), Vt1 = vtupdate(Evt1, Vt), {Evt2,St2} = expr(R, Vt1, St1), Evt3 = vtupd_unsafe({Op, Anno}, Evt2, Vt1), {vtmerge(Evt1, Evt3),St2}; -expr({op,_Anno,EqOp,L,R}, Vt, St0) when EqOp =:= '=:='; EqOp =:= '=/=' -> +expr({op,Anno,EqOp,L,R}, Vt, St0) when EqOp =:= '=:='; EqOp =:= '=/=' -> St = expr_check_match_zero(R, expr_check_match_zero(L, St0)), - expr_list([L,R], Vt, St); %They see the same variables -expr({op,_Anno,_Op,L,R}, Vt, St) -> - expr_list([L,R], Vt, St); %They see the same variables + vtupd_export_expr_list({EqOp, Anno}, [L, R], Vt, St); %They see the same variables +expr({op,Anno,Op,L,R}, Vt, St) -> + vtupd_export_expr_list({Op, Anno}, [L, R], Vt, St); %They see the same variables %% The following are not allowed to occur anywhere! expr({remote,_Anno,M,_F}, _Vt, St) -> {[],add_error(erl_parse:first_anno(M), illegal_expr, St)}; @@ -2948,6 +2963,12 @@ expr_list(Es, Vt, St0) -> vtmerge_pat(Evt, Esvt, St2) end, {[], St0}, Es). +%% as expr_list but mark new vars as exported + +vtupd_export_expr_list(Where, Es, Vt, St) -> + {Evt, St1} = expr_list(Es, Vt, St), + {vtupd_export(Where, Evt, Vt), St1}. + record_expr(Anno, Rec, Vt, St0) -> St1 = warn_invalid_record(Anno, Rec, St0), expr(Rec, Vt, St1). @@ -4349,12 +4370,18 @@ do_expr_var(V, Anno, Vt, St) -> {[{V,{bound,used,As}}], add_error(Anno, {unsafe_var,V,In}, St)}; {ok,{{export,From},_Usage,As}} -> - case is_warn_enabled(export_vars, St) of + case exported_subexpr_var(From) of true -> {[{V,{bound,used,As}}], - add_warning(Anno, {exported_var,V,From}, St)}; + add_warning(Anno, {exported_subexpr_var,V,From}, St)}; false -> - {[{V,{{export,From},used,As}}],St} + case is_warn_enabled(export_vars, St) of + true -> + {[{V,{bound,used,As}}], + add_warning(Anno, {exported_var,V,From}, St)}; + false -> + {[{V,{{export,From},used,As}}],St} + end end; {ok,{stacktrace,_Usage,As}} -> {[{V,{bound,used,As}}], @@ -4377,6 +4404,14 @@ exported_var(Anno, V, From, St) -> false -> St end. +%% warn about exporting from non-block subexpressions +exported_subexpr_var({'if',_}) -> false; +exported_subexpr_var({'case',_}) -> false; +exported_subexpr_var({'receive',_}) -> false; +exported_subexpr_var({'try',_}) -> false; +exported_subexpr_var({'begin',_}) -> false; +exported_subexpr_var(_) -> true. + shadow_vars(Vt, Vt0, In, St0) -> case is_warn_enabled(shadow_vars, St0) of true -> @@ -4442,6 +4477,16 @@ vtunsafe({Tag,Anno}, Uvt, Vt) -> vtupd_unsafe(Where, NewVt, OldVt) -> vtupdate(vtunsafe(Where, NewVt, OldVt), NewVt). +%% vtexport(From, UpdVarTable, VarTable) -> ExpVarTable. +%% Return all new variables in UpdVarTable as exported. + +vtexport({Tag, FileLine}, Uvt, Vt) -> + Line = erl_anno:location(FileLine), + [{V, {{export, {Tag, Line}}, U, Ls}} || {V, {_, U, Ls}} <- vtnew(Uvt, Vt)]. + +vtupd_export(Where, NewVt, OldVt) -> + vtupdate(vtexport(Where, NewVt, OldVt), NewVt). + %% vtmerge(VarTable, VarTable) -> VarTable. %% Merge two variables tables generating a new vartable. Give priority to %% errors then warnings. From 40159fe94c1938a2e1a90c331a4f0c44337bfcd4 Mon Sep 17 00:00:00 2001 From: Richard Carlsson Date: Sun, 1 Dec 2024 20:45:12 +0100 Subject: [PATCH 3/4] Eliminate exports from expression arguments --- lib/asn1/src/asn1rtt_jer.erl | 3 +- lib/common_test/src/test_server_ctrl.erl | 6 ++-- lib/dialyzer/src/dialyzer_dataflow.erl | 6 ++-- lib/dialyzer/src/dialyzer_typesig.erl | 9 ++++-- lib/dialyzer/src/dialyzer_utils.erl | 6 ++-- lib/edoc/src/edoc_specs.erl | 3 +- lib/et/src/et_wx_viewer.erl | 7 +++-- lib/kernel/src/application_controller.erl | 3 +- lib/kernel/src/dist_ac.erl | 15 ++++++--- lib/mnesia/src/mnesia_recover.erl | 8 +++-- lib/observer/src/crashdump_viewer.erl | 3 +- lib/parsetools/src/yecc.erl | 3 +- lib/snmp/src/agent/snmpa_agent.erl | 3 +- lib/snmp/src/compile/snmpc_lib.erl | 9 ++++-- lib/ssh/src/ssh_connection_handler.erl | 3 +- lib/stdlib/src/edlin_expand.erl | 2 +- lib/stdlib/src/erl_lint.erl | 8 ++--- lib/stdlib/src/qlc.erl | 16 ++++++---- lib/stdlib/src/qlc_pt.erl | 38 +++++++++++++---------- lib/stdlib/src/sofs.erl | 3 +- lib/wx/src/wxe_server.erl | 3 +- 21 files changed, 98 insertions(+), 59 deletions(-) diff --git a/lib/asn1/src/asn1rtt_jer.erl b/lib/asn1/src/asn1rtt_jer.erl index 8361116f6c72..9989a24abf51 100644 --- a/lib/asn1/src/asn1rtt_jer.erl +++ b/lib/asn1/src/asn1rtt_jer.erl @@ -120,7 +120,8 @@ encode_jer({typeinfo,{Module,Type}},Val) -> encode_jer({sof,Type},Vals) when is_list(Vals) -> [encode_jer(Type,Val)||Val <- Vals]; encode_jer({choice,Choices},{Alt,Value}) -> - case is_map_key(AltBin = atom_to_binary(Alt,utf8),Choices) of + AltBin = atom_to_binary(Alt,utf8), + case is_map_key(AltBin,Choices) of true -> EncodedVal = encode_jer(maps:get(AltBin,Choices),Value), #{AltBin => EncodedVal}; diff --git a/lib/common_test/src/test_server_ctrl.erl b/lib/common_test/src/test_server_ctrl.erl index 193b0e80767f..562b8ee4a0bd 100644 --- a/lib/common_test/src/test_server_ctrl.erl +++ b/lib/common_test/src/test_server_ctrl.erl @@ -5774,13 +5774,15 @@ write_html_file(File,Content) -> %% The 'major' log file, which is a pure text file is also written %% with utf8 encoding open_utf8_file(File) -> - case file:open(File,AllOpts=[write,{encoding,utf8}]) of + AllOpts = [write,{encoding,utf8}], + case file:open(File,AllOpts) of {error,Reason} -> {error,{Reason,{File,AllOpts}}}; Result -> Result end. open_utf8_file(File,Opts) -> - case file:open(File,AllOpts=[{encoding,utf8}|Opts]) of + AllOpts = [{encoding,utf8}|Opts], + case file:open(File,AllOpts) of {error,Reason} -> {error,{Reason,{File,AllOpts}}}; Result -> Result end. diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl index 59494fa052b4..6eaea843da01 100644 --- a/lib/dialyzer/src/dialyzer_dataflow.erl +++ b/lib/dialyzer/src/dialyzer_dataflow.erl @@ -1004,7 +1004,8 @@ handle_map(Tree,Map,State) -> traverse_map_pairs(Pairs, Map1, State1, t_none(), [], []), InsertPair = fun({KV,assoc,_},Acc) -> erl_types:t_map_put(KV,Acc); ({KV,exact,KVTree},Acc) -> - case t_is_none(T=erl_types:t_map_update(KV,Acc)) of + T = erl_types:t_map_update(KV,Acc), + case t_is_none(T) of true -> throw({none, Acc, KV, KVTree}); false -> T end @@ -1723,7 +1724,8 @@ bind_guard(Guard, Map, Env, Eval, State0) -> {{Map1, t_none(), State1}, BE} end, Map3 = join_maps_end([BodyMap, HandlerMap], Map1), - case t_is_none(Sup = t_sup(BodyType, HandlerType)) of + Sup = t_sup(BodyType, HandlerType), + case t_is_none(Sup) of true -> %% Pick a reason. N.B. We assume that the handler is always %% compiler-generated if the body is; that way, we won't need to diff --git a/lib/dialyzer/src/dialyzer_typesig.erl b/lib/dialyzer/src/dialyzer_typesig.erl index 482a991bad41..f69160b444f5 100644 --- a/lib/dialyzer/src/dialyzer_typesig.erl +++ b/lib/dialyzer/src/dialyzer_typesig.erl @@ -1135,7 +1135,8 @@ get_safe_underapprox_1([Pat0|Left], Acc, Map) -> %% Some assertions in case the syntax gets more premissive in the future true = #{} =:= cerl:concrete(cerl:map_arg(Pat)), true = lists:all(fun(P) -> - cerl:is_literal(Op = cerl:map_pair_op(P)) andalso + Op = cerl:map_pair_op(P), + cerl:is_literal(Op) andalso exact =:= cerl:concrete(Op) end, cerl:map_es(Pat)), KeyTrees = lists:map(fun cerl:map_pair_key/1, cerl:map_es(Pat)), @@ -1151,7 +1152,8 @@ get_safe_underapprox_1([Pat0|Left], Acc, Map) -> %% We need to deal with duplicates ourselves SquashDuplicates = fun SquashDuplicates([{K,First},{K,Second}|List]) -> - case t_is_none(Inf = t_inf(First, Second)) of + Inf = t_inf(First, Second), + case t_is_none(Inf) of true -> throw(dont_know); false -> [{K, Inf}|SquashDuplicates(List)] end; @@ -1179,7 +1181,8 @@ get_safe_overapprox(Pats) -> lists:map(fun get_safe_overapprox_1/1, Pats). get_safe_overapprox_1(Pat) -> - case cerl:is_literal(Lit = cerl:fold_literal(Pat)) of + Lit = cerl:fold_literal(Pat), + case cerl:is_literal(Lit) of true -> t_from_term(cerl:concrete(Lit)); false -> t_any() end. diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl index ed6edeafdb37..714283739fee 100644 --- a/lib/dialyzer/src/dialyzer_utils.erl +++ b/lib/dialyzer/src/dialyzer_utils.erl @@ -1107,9 +1107,9 @@ refold_concrete_pat(Val) -> false -> label(cerl:c_tuple_skel(Els)) end; [H|T] -> - case cerl:is_literal(HP=refold_concrete_pat(H)) - and cerl:is_literal(TP=refold_concrete_pat(T)) - of + HP = refold_concrete_pat(H), + TP = refold_concrete_pat(T), + case cerl:is_literal(HP) and cerl:is_literal(TP) of true -> cerl:abstract(Val); false -> label(cerl:c_cons_skel(HP, TP)) end; diff --git a/lib/edoc/src/edoc_specs.erl b/lib/edoc/src/edoc_specs.erl index 835c0162213f..f09cff344dd8 100644 --- a/lib/edoc/src/edoc_specs.erl +++ b/lib/edoc/src/edoc_specs.erl @@ -498,7 +498,8 @@ expand_records(Entries, TypeDefs, DT, Opts, File, Module) -> {export_type,Ts} <- Module#module.attributes, is_list(Ts), {N,I} <- Ts, - ets:member(DT, Name = {#t_name{name = N}, I})], + Name <- [{#t_name{name = N}, I}], + ets:member(DT, Name)], _ = lists:foreach(fun({N,A}) -> true = seen_type(N, A, P) end, ExportedTypes), entries(Entries, P, Opts). diff --git a/lib/et/src/et_wx_viewer.erl b/lib/et/src/et_wx_viewer.erl index 4ecea23b24c8..b85259c16818 100644 --- a/lib/et/src/et_wx_viewer.erl +++ b/lib/et/src/et_wx_viewer.erl @@ -1410,18 +1410,19 @@ create_filter_menu(S=#state{filter_menu = {Menu,Data}}, ActiveFilterName, Filter Label = lists:concat([pad_string(F#filter.name, 20), "(", N, ")"]), {N+1, [menuitem(Menu, ?wxID_ANY, Label, {data, F})|Acc]} end, - D1 = [I1 = wxMenu:append(Menu, ?wxID_ANY, "Same Filter New Scale"), - wxMenu:appendSeparator(Menu)], + I1 = wxMenu:append(Menu, ?wxID_ANY, "Same Filter New Scale"), + D1 = [I1, wxMenu:appendSeparator(Menu)], wxMenuItem:enable(I1, [{enable,false}]), {value, Filter} = lists:keysearch(ActiveFilterName, #filter.name, Filters), Same = lists:concat([pad_string(ActiveFilterName, 20), "(=) same scale"]), Larger = lists:concat([pad_string(ActiveFilterName, 20), "(+) bigger scale"]), Smaller = lists:concat([pad_string(ActiveFilterName, 20), "(-) smaller scale"]), + I2 = wxMenu:append(Menu, ?wxID_ANY, "New Filter Same Scale"), D2 = [menuitem(Menu, ?wxID_ANY, Same, {data, Filter, 0}), menuitem(Menu, ?wxID_ANY, Smaller, {data, Filter, -1}), menuitem(Menu, ?wxID_ANY, Larger, {data, Filter, 1}), wxMenu:appendSeparator(Menu), - I2 = wxMenu:append(Menu, ?wxID_ANY, "New Filter Same Scale"), + I2, wxMenu:appendSeparator(Menu)], _ = wxMenuItem:enable(I2, [{enable,false}]), {_,D3} = lists:foldl(Item, {1,[]}, Filters), diff --git a/lib/kernel/src/application_controller.erl b/lib/kernel/src/application_controller.erl index f6ed418b5c4a..43488079c960 100644 --- a/lib/kernel/src/application_controller.erl +++ b/lib/kernel/src/application_controller.erl @@ -1066,7 +1066,8 @@ handle_info({ac_load_application_reply, AppName, Res}, S) -> handle_info({ac_start_application_reply, AppName, Res}, S) -> Start_req = S#state.start_req, - case lists:keyfind(AppName, 1, Starting = S#state.starting) of + Starting = S#state.starting, + case lists:keyfind(AppName, 1, Starting) of {_AppName, RestartType, Type, From} -> case Res of start_it -> diff --git a/lib/kernel/src/dist_ac.erl b/lib/kernel/src/dist_ac.erl index 6f93355d39b3..6a64e536ebf7 100644 --- a/lib/kernel/src/dist_ac.erl +++ b/lib/kernel/src/dist_ac.erl @@ -442,7 +442,8 @@ handle_info({ac_application_run, AppName, Res}, S) -> handle_info({ac_application_not_run, AppName}, S) -> %% We ordered a stop, and now it has stopped - {value, Appl} = keysearch(AppName, #appl.name, Appls = S#state.appls), + Appls = S#state.appls, + {value, Appl} = keysearch(AppName, #appl.name, Appls), %% Check if we have somebody waiting for the takeover result; %% if somebody called stop just before takeover was handled, NTReqs = del_t_reqs(AppName, S#state.t_reqs, {error, stopped}), @@ -470,7 +471,8 @@ handle_info({ac_application_not_run, AppName}, S) -> handle_info({ac_application_stopped, AppName}, S) -> %% Somebody called application:stop - reset state as it was before %% the application was started. - {value, Appl} = keysearch(AppName, #appl.name, Appls = S#state.appls), + Appls = S#state.appls, + {value, Appl} = keysearch(AppName, #appl.name, Appls), %% Check if we have somebody waiting for the takeover result; %% if somebody called stop just before takeover was handled, NTReqs = del_t_reqs(AppName, S#state.t_reqs, {error, stopped}), @@ -646,7 +648,8 @@ handle_info({nodedown, Node}, S) -> handle_info({dist_ac_app_loaded, Node, Name, HisNodes, Permission, HeKnowsMe}, S) -> - Nodes = dist_find_nodes(Appls = S#state.appls, Name), + Appls = S#state.appls, + Nodes = dist_find_nodes(Appls, Name), case is_loaded(Name, S) of true -> case equal_nodes(Nodes, HisNodes) of @@ -719,7 +722,8 @@ code_change(_OldVsn, State, _Extra) -> load(AppName, S) -> Appls0 = S#state.appls, %% Get the dist specification for the app on other nodes - DistLoaded = get_dist_loaded(AppName, Load1 = S#state.dist_loaded), + Load1 = S#state.dist_loaded, + DistLoaded = get_dist_loaded(AppName, Load1), %% Get the local dist specification Nodes = dist_find_nodes(Appls0, AppName), FNodes = flat_nodes(Nodes), @@ -781,7 +785,8 @@ start_appl(AppName, S, Type) -> %% Get nodes, and check if App is loaded on all involved nodes. %% If it is loaded everywhere, we know that we have the same picture %% of the nodes; otherwise the load wouldn't have succeeded. - Appl = case keysearch(AppName, #appl.name, Appls = S#state.appls) of + Appls = S#state.appls, + Appl = case keysearch(AppName, #appl.name, Appls) of {value, A} -> A; _ -> throw({error, {unknown_application, AppName}}) end, diff --git a/lib/mnesia/src/mnesia_recover.erl b/lib/mnesia/src/mnesia_recover.erl index 06bd5211627a..0663da77823d 100644 --- a/lib/mnesia/src/mnesia_recover.erl +++ b/lib/mnesia/src/mnesia_recover.erl @@ -767,7 +767,9 @@ handle_call(Msg, _From, State) -> {noreply, State}. do_log_mnesia_up(Node) -> - Yoyo = {mnesia_up, Node, Date = date(), Time = time()}, + Date = date(), + Time = time(), + Yoyo = {mnesia_up, Node, Date, Time}, case mnesia_monitor:use_dir() of true -> mnesia_log:append(latest_log, Yoyo), @@ -778,7 +780,9 @@ do_log_mnesia_up(Node) -> note_up(Node, Date, Time). do_log_mnesia_down(Node) -> - Yoyo = {mnesia_down, Node, Date = date(), Time = time()}, + Date = date(), + Time = time(), + Yoyo = {mnesia_down, Node, Date, Time}, case mnesia_monitor:use_dir() of true -> mnesia_log:append(latest_log, Yoyo), diff --git a/lib/observer/src/crashdump_viewer.erl b/lib/observer/src/crashdump_viewer.erl index a498aaeb0282..f6bc172f643d 100644 --- a/lib/observer/src/crashdump_viewer.erl +++ b/lib/observer/src/crashdump_viewer.erl @@ -898,7 +898,8 @@ do_read_file(File) -> case check_dump_version(Id) of {ok,DumpVsn} -> reset_tables(), - insert_index(Tag,Id,Pos=N1+1), + Pos = N1+1, + insert_index(Tag,Id,Pos), put_last_tag(Tag,"",Pos), DecodeOpts = get_decode_opts(DumpVsn), indexify(Fd,DecodeOpts,Rest,N1), diff --git a/lib/parsetools/src/yecc.erl b/lib/parsetools/src/yecc.erl index 2c08a5954a75..89d7858b6639 100644 --- a/lib/parsetools/src/yecc.erl +++ b/lib/parsetools/src/yecc.erl @@ -2413,7 +2413,8 @@ select_parts(PartDataL) -> NL = [D#part_data{states = NewS} || {W1, #part_data{states = S0}=D} <- Ws, W1 > 0, - (NewS = ordsets:subtract(S0, S)) =/= []], + NewS <- [ordsets:subtract(S0, S)], + NewS =/= []], if length(S) =:= 1; NActions =:= 1 -> select_parts(NL); diff --git a/lib/snmp/src/agent/snmpa_agent.erl b/lib/snmp/src/agent/snmpa_agent.erl index 77a44cd26bc9..8f0e81392fc8 100644 --- a/lib/snmp/src/agent/snmpa_agent.erl +++ b/lib/snmp/src/agent/snmpa_agent.erl @@ -2535,7 +2535,8 @@ validate_next_v1_2([], _MibView, Res) -> %% problems. %%----------------------------------------------------------------- mk_next_oid(Vb) -> - case snmpa_mib:lookup(get(mibserver), Oid = Vb#varbind.oid) of + Oid = Vb#varbind.oid, + case snmpa_mib:lookup(get(mibserver), Oid) of {table_column, _MibEntry, TableEntryOid} -> [Col | _] = Oid -- TableEntryOid, Vb#varbind{oid = TableEntryOid ++ [Col+1]}; diff --git a/lib/snmp/src/compile/snmpc_lib.erl b/lib/snmp/src/compile/snmpc_lib.erl index 6d5e8fa25ab0..c3175d993636 100644 --- a/lib/snmp/src/compile/snmpc_lib.erl +++ b/lib/snmp/src/compile/snmpc_lib.erl @@ -89,7 +89,8 @@ make_ASN1type({{type,Type},Line}) -> make_ASN1type({{type_with_size,Type,{range,Lo,Hi}},Line}) -> case lookup_vartype(Type) of {value,ASN1type} -> - case allow_size_rfc1902(BaseType = ASN1type#asn1_type.bertype) of + BaseType = ASN1type#asn1_type.bertype, + case allow_size_rfc1902(BaseType) of true -> ok; false -> @@ -126,7 +127,8 @@ test_kibbles([], Line) -> print_error("No kibbles found.",[],Line), []; test_kibbles(Kibbles,Line) -> - test_kibbles2(R = lists:keysort(2,Kibbles),0,Line), + R = lists:keysort(2,Kibbles), + test_kibbles2(R,0,Line), R. test_kibbles2([],_,_) -> @@ -407,7 +409,8 @@ read_mib(_Line, _Filename, []) -> error; read_mib(Line, Filename, [Dir|Path]) -> Dir2 = snmpc_misc:ensure_trailing_dir_delimiter(Dir), - case snmpc_misc:read_mib(AbsFile=lists:append(Dir2, Filename)) of + AbsFile = lists:append(Dir2, Filename), + case snmpc_misc:read_mib(AbsFile) of {ok, MIB} -> MIB; {error, enoent} -> read_mib(Line, Filename, Path); diff --git a/lib/ssh/src/ssh_connection_handler.erl b/lib/ssh/src/ssh_connection_handler.erl index 8746c2bbd4e8..8cc8aaba9f67 100644 --- a/lib/ssh/src/ssh_connection_handler.erl +++ b/lib/ssh/src/ssh_connection_handler.erl @@ -614,7 +614,8 @@ handle_event(cast, socket_control, {wait_for_socket, Role}, handle_event(internal, socket_ready, {hello,_}=StateName, #data{ssh_params = Ssh0} = D) -> VsnMsg = ssh_transport:hello_version_msg(string_version(Ssh0)), send_bytes(VsnMsg, D), - case inet:getopts(Socket=D#data.socket, [recbuf]) of + Socket = D#data.socket, + case inet:getopts(Socket, [recbuf]) of {ok, [{recbuf,Size}]} -> %% Set the socket to the hello text line handling mode: inet:setopts(Socket, [{packet, line}, diff --git a/lib/stdlib/src/edlin_expand.erl b/lib/stdlib/src/edlin_expand.erl index 70c41fe8d21f..7e50f958e1f4 100644 --- a/lib/stdlib/src/edlin_expand.erl +++ b/lib/stdlib/src/edlin_expand.erl @@ -1005,7 +1005,7 @@ match(Prefix, Alts, Extra0) -> Len = string:length(Prefix), Matches = lists:sort( [{S, A} || {H, A} <- Alts2, - lists:prefix(Prefix, S=flat_write(H))]), + S <- [flat_write(H)], lists:prefix(Prefix, S)]), Matches2 = lists:usort( case Extra0 of [] -> [{S,[]} || {S,_} <- Matches]; diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index a4e3e264eba3..530ae7ec0550 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -3758,8 +3758,8 @@ add_missing_spec_warnings(Forms, St0, Type) -> Warns = %% functions + line numbers for which we should warn case Type of all -> - [{FA,Anno} || {function,Anno,F,A,_} <- Forms, - not lists:member(FA = {F,A}, Specs)]; + [{{F,A},Anno} || {function,Anno,F,A,_} <- Forms, + not lists:member({F,A}, Specs)]; _ -> Exps0 = gb_sets:to_list(exports(St0)) -- pseudolocals(), Exps1 = @@ -3769,8 +3769,8 @@ add_missing_spec_warnings(Forms, St0, Type) -> Exps0 end, Exps = Exps1 -- Specs, - [{FA,Anno} || {function,Anno,F,A,_} <- Forms, - member(FA = {F,A}, Exps)] + [{{F,A},Anno} || {function,Anno,F,A,_} <- Forms, + member({F,A}, Exps)] end, foldl(fun ({FA,Anno}, St) -> add_warning(Anno, {missing_spec,FA}, St) diff --git a/lib/stdlib/src/qlc.erl b/lib/stdlib/src/qlc.erl index ec6c8d27f169..2c2d83cc2d1a 100644 --- a/lib/stdlib/src/qlc.erl +++ b/lib/stdlib/src/qlc.erl @@ -1275,8 +1275,9 @@ For the various options recognized by `table/1,2` in respective module, see Args :: [term()], QH :: query_handle(). table(TraverseFun, Options) when is_function(TraverseFun) -> - case {is_function(TraverseFun, 0), - IsFun1 = is_function(TraverseFun, 1)} of + IsFun0 = is_function(TraverseFun, 0), + IsFun1 = is_function(TraverseFun, 1), + case {IsFun0, IsFun1} of {false, false} -> erlang:error(badarg, [TraverseFun, Options]); _ -> @@ -2503,10 +2504,12 @@ qlc_sort_info(Qdata0, QOpt) -> sort_info(#prepared{sort_info = SI, sorted = S} = Prep, QNum, QOpt) -> SI1 = [{{C,Ord},[]} || - S =/= no, - is_integer(Sz = size_of_qualifier(QOpt, QNum)), + S =/= no, + Sz <- [size_of_qualifier(QOpt, QNum)], + is_integer(Sz), Sz > 0, % the size of the pattern - (NConstCols = size_of_constant_prefix(QOpt, QNum)) < Sz, + NConstCols <- [size_of_constant_prefix(QOpt, QNum)], + NConstCols < Sz, C <- [NConstCols+1], Ord <- orders(S)] ++ [{{Pos,Ord},[]} || Pos <- constant_columns(QOpt, QNum), @@ -2588,7 +2591,8 @@ pos_vals(_Pos, _KeyEquality, _T, _Max) -> nub([]) -> []; nub([E | L]) -> - case lists:member(E, Es=nub(L)) of + Es=nub(L), + case lists:member(E, Es) of true -> Es; false -> diff --git a/lib/stdlib/src/qlc_pt.erl b/lib/stdlib/src/qlc_pt.erl index eae3655c4510..17e7b72b7ec7 100644 --- a/lib/stdlib/src/qlc_pt.erl +++ b/lib/stdlib/src/qlc_pt.erl @@ -908,8 +908,8 @@ join_quals(JoinInfo, QCs, Anno, LcNo, ExtraConstants, AllVars) -> H2 = join_handle(AP2, Anno, Aux, Cs2), %% Op is not used. Join = {join,Op,QId1#qid.no,QId2#qid.no,H1,H2,Cs1,Cs2}, - G = {NQId=QId#qid{no = QId#qid.no + 1}, - {QIVs,{{gen,{cons,Anno,P1,P2},Join,GV1},GoI,SI}}}, + NQId=QId#qid{no = QId#qid.no + 1}, + G = {NQId, {QIVs,{{gen,{cons,Anno,P1,P2},Join,GV1},GoI,SI}}}, A = {NQId, GoI + 3, SI + 2}, {G, A} end, @@ -1052,7 +1052,8 @@ template_cols(ColumnClasses) -> Class <- ColumnClasses, {IdNo,Col} <- Class, IdNo =/= ?TNO, - [] =/= (Cs = [C || {?TNO,C} <- Class])]). + Cs <- [[C || {?TNO,C} <- Class]], + [] =/= Cs]). template_as_pattern(E) -> P = simple_template(E), @@ -1312,21 +1313,22 @@ lu_skip(ColConstants, FilterData, PatternFrame, PatternVars, ColFil = [{Column, FId#qid.no} || {FId,{fil,Fil}} <- filter_list(FilterData, Dependencies, State), - [] =/= (SFs = safe_filter(reset_anno(Fil), PatternFrames, - BindFun, State, Imported)), + SFs <- [safe_filter(reset_anno(Fil), PatternFrames, + BindFun, State, Imported)], + [] =/= SFs, {GId,PV} <- PatternVars, - [] =/= - (Cols = hd(frames_to_columns(SFs, [{GId, PV}], - deref_lu_skip(LookupOp, - Imported), - const_selector(Imported), - Imported, LookupOp))), + Cols <- [hd(frames_to_columns(SFs, [{GId, PV}], + deref_lu_skip(LookupOp, Imported), + const_selector(Imported), + Imported, LookupOp))], + [] =/= Cols, %% The filter must not test more than one column (unless the %% pattern has already done the test): %% Note: if the pattern and the filter test the same %% column, the filter will not be skipped. %% (an example: {X=1} <- ..., X =:= 1). - length(D = Cols -- PatternColumns) =:= 1, + D <- [Cols -- PatternColumns], + length(D) =:= 1, {{_,Col} = Column, Constants} <- D, %% Check that the following holds for all frames. lists:all( @@ -1823,8 +1825,10 @@ frames2cols(Fs, PatN, PatSizes, Vars, DerefFun, SelectorFun, CompOp) -> %% seen as a bug.) Note: matching tables %% cannot skip the filter, but looking up %% one of the values should be OK. - tl(Consts = DerefFun(V, F)) =:= [], - (Const = (SelectorFun(F))(hd(Consts))) =/= no], + Consts <- [DerefFun(V, F)], + tl(Consts) =:= [], + Const <- [(SelectorFun(F))(hd(Consts))], + Const =/= no], sofs:relation(RL) % possibly empty end || F <- Fs && PatSz <- PatSizes], Ss = sofs:from_sets(Rs), @@ -1853,7 +1857,8 @@ col_ignore(Vs, '==') -> pattern_sizes(PatternVars, Fs) -> [{QId#qid.no, Size} || {QId,PV} <- PatternVars, - undefined =/= (Size = pattern_size(Fs, {var,anno0(),PV}, true))]. + Size <- [pattern_size(Fs, {var,anno0(),PV}, true)], + undefined =/= (Size)]. pattern_size(Fs, PatternVar, Exact) -> Fun = fun(F) -> (deref_pattern(_Imported = []))(PatternVar, F) end, @@ -2172,7 +2177,8 @@ deref_binding(Bind, Frame, BFun, Imp) -> #bind{value = Value, op = Op0} = Bind, [{Val, Op} || {Val, _Op}=ValOp <- deref(Value, Frame, BFun, Imp), - BFun(Val, Op = value_op(ValOp, Op0, Imp))]. + Op <- [value_op(ValOp, Op0, Imp)], + BFun(Val, Op)]. deref_list(L) -> Op = case lists:usort([Op || {_Val, Op} <- L]) of diff --git a/lib/stdlib/src/sofs.erl b/lib/stdlib/src/sofs.erl index 0141c6d08c3e..4cc4d1442f2d 100644 --- a/lib/stdlib/src/sofs.erl +++ b/lib/stdlib/src/sofs.erl @@ -3517,7 +3517,8 @@ setfun(T, Fun, Type, NType) -> NT -> {?LIST(NS), NT} end; NS when ?IS_ORDSET(NS) -> - case unify_types(NType, NT = ?ORDTYPE(NS)) of + NT = ?ORDTYPE(NS), + case unify_types(NType, NT) of [] -> type_mismatch; NT -> {?ORDDATA(NS), NT} end; diff --git a/lib/wx/src/wxe_server.erl b/lib/wx/src/wxe_server.erl index 2e6c80f9f92c..2bb067f67105 100644 --- a/lib/wx/src/wxe_server.erl +++ b/lib/wx/src/wxe_server.erl @@ -60,7 +60,8 @@ start(SilentStart) -> case gen_server:start(?MODULE, [SilentStart], []) of {ok, Pid} -> {ok, Ref} = gen_server:call(Pid, get_env, infinity), - wx:set_env(Env = #wx_env{ref=Ref,sv=Pid}), + Env = #wx_env{ref=Ref,sv=Pid}, + wx:set_env(Env), Env; {error, {Reason, _Stack}} -> erlang:error(Reason) From 3e0a184ce0871885059aa6eead31c0e793e49f30 Mon Sep 17 00:00:00 2001 From: Richard Carlsson Date: Tue, 3 Dec 2024 13:50:29 +0100 Subject: [PATCH 4/4] Fix race condition getting date and time in mnesia_recover --- lib/mnesia/src/mnesia_recover.erl | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/lib/mnesia/src/mnesia_recover.erl b/lib/mnesia/src/mnesia_recover.erl index 0663da77823d..6d9dbca0118a 100644 --- a/lib/mnesia/src/mnesia_recover.erl +++ b/lib/mnesia/src/mnesia_recover.erl @@ -767,8 +767,7 @@ handle_call(Msg, _From, State) -> {noreply, State}. do_log_mnesia_up(Node) -> - Date = date(), - Time = time(), + {Date, Time} = erlang:localtime(), Yoyo = {mnesia_up, Node, Date, Time}, case mnesia_monitor:use_dir() of true -> @@ -780,8 +779,7 @@ do_log_mnesia_up(Node) -> note_up(Node, Date, Time). do_log_mnesia_down(Node) -> - Date = date(), - Time = time(), + {Date, Time} = erlang:localtime(), Yoyo = {mnesia_down, Node, Date, Time}, case mnesia_monitor:use_dir() of true ->