From a34b2e72b07815c3668afcbc0f59c6741d6d0e95 Mon Sep 17 00:00:00 2001 From: Richard Carlsson Date: Sun, 22 Dec 2024 11:25:11 +0100 Subject: [PATCH 1/3] Fix expansion of symbolic local funs If a 'fun f/n' used the same name and arity f/n as a BIF 'erlang:f/n', for example 'max/2', the symbolic fun would get unnecessarily rewritten as 'fun (X1, ..., Xn) -> f(X1, ..., Xn) end'. In addition, the rewritten fun body was then processed as a normal call, so if 'max/2' was declared as an import from some module m, it got expanded to a call to 'm:max/2', making imports "work" for symbolic funs but only if their names look like BIF names in order to sneak past the linter. This change makes the expander do the right thing for all imports, auto or explicit, creating symbolic remote funs. It is up to the linter (standard or modified) to decide whether it is allowed. --- lib/stdlib/src/erl_expand_records.erl | 36 +++++++++++++++++++++------ 1 file changed, 28 insertions(+), 8 deletions(-) diff --git a/lib/stdlib/src/erl_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index 6b093e4c4b8b..f5e79370ccb8 100644 --- a/lib/stdlib/src/erl_expand_records.erl +++ b/lib/stdlib/src/erl_expand_records.erl @@ -366,14 +366,34 @@ expr({'receive',Anno,Cs0,To0,ToEs0}, St0) -> {Cs,St3} = clauses(Cs0, St2), {{'receive',Anno,Cs,To,ToEs},St3}; expr({'fun',Anno,{function,F,A}}=Fun0, St0) -> - case erl_internal:bif(F, A) of - true -> - {As,St1} = new_vars(A, Anno, St0), - Cs = [{clause,Anno,As,[],[{call,Anno,{atom,Anno,F},As}]}], - Fun = {'fun',Anno,{clauses,Cs}}, - expr(Fun, St1); - false -> - {Fun0,St0} + FA = {F,A}, + case St0#exprec.calltype of + #{FA := local} -> + {Fun0,St0}; + #{FA := {imported,M}} -> + %% refers to another module, so keep it symbolic; do not create + %% a local fun which is subject to dynamic code replacement + MAtom = {atom,Anno,M}, + FAtom = {atom,Anno,F}, + AInt = {integer,Anno,A}, + {{'fun',Anno,{function,MAtom,FAtom,AInt}},St0}; + _ -> + case erl_internal:bif(F, A) of + true -> + %% auto-imported from the 'erlang' module; + %% handle like other imports above + MAtom = {atom,Anno,erlang}, + FAtom = {atom,Anno,F}, + AInt = {integer,Anno,A}, + {{'fun',Anno,{function,MAtom,FAtom,AInt}},St0}; + false -> + %% a generated function like module_info/0/1 or a + %% pseudo function; create a local fun wrapper + {As,St1} = new_vars(A, Anno, St0), + Cs = [{clause,Anno,As,[],[{call,Anno,{atom,Anno,F},As}]}], + Fun = {'fun',Anno,{clauses,Cs}}, + expr(Fun, St1) + end end; expr({'fun',_,{function,_M,_F,_A}}=Fun, St) -> {Fun,St}; From 8fb9f1fd55784923d247eaec41b16f543da06992 Mon Sep 17 00:00:00 2001 From: Richard Carlsson Date: Wed, 25 Dec 2024 16:43:57 +0100 Subject: [PATCH 2/3] Better check for funs referring to imports The linting of 'fun f/n' relied on marking f/n as used and later getting a report if function f/n did not exist, except if f/n was not in the list of local functions (could still be local but auto generated) and was listed in auto-imports (erlang:f/n) and the import was not suppressed. This allowed explicit imports of names such as 'max/2' to slip through with a warning, assuming that they were auto-imports, and the expander would then expand them like an explicit import. This change avoids marking f/n as a used local if it is listed as an import, makes it an error to have a 'fun f/n' that refers to an explicit import, and furthermore checks the reference f/n just like a call f(X1, ... Xn) so that we get the same warnings for deprecated functions etc., for example 'fun now/0'. --- lib/dialyzer/src/erl_types.erl | 2 ++ lib/stdlib/src/erl_lint.erl | 26 +++++++++++++++++++------- lib/stdlib/test/erl_lint_SUITE.erl | 4 ++-- 3 files changed, 23 insertions(+), 9 deletions(-) diff --git a/lib/dialyzer/src/erl_types.erl b/lib/dialyzer/src/erl_types.erl index fb533cf046a4..ee43ee56c0ae 100644 --- a/lib/dialyzer/src/erl_types.erl +++ b/lib/dialyzer/src/erl_types.erl @@ -202,6 +202,8 @@ -compile({no_auto_import,[min/2,max/2,map_get/2]}). +-compile({no_auto_import,[is_boolean/1, is_binary/1, is_number/1]}). + -export_type([erl_type/0, type_table/0, var_table/0, cache/0]). %%-define(DEBUG, true). diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index a24142ead5c3..670e530524e1 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -346,6 +346,8 @@ format_error_1({redefine_function,{F,A}}) -> {~"function ~tw/~w already defined", [F,A]}; format_error_1({define_import,{F,A}}) -> {~"defining imported function ~tw/~w", [F,A]}; +format_error_1({fun_import,{F,A}}) -> + {~"creating a fun from imported name ~tw/~w is not allowed", [F,A]}; format_error_1({unused_function,{F,A}}) -> {~"function ~tw/~w is unused", [F,A]}; format_error_1({unexported_function, MFA}) -> @@ -2751,13 +2753,23 @@ expr({'fun',Anno,Body}, Vt, St) -> %% It is illegal to call record_info/2 with unknown arguments. {[],add_error(Anno, illegal_record_info, St)}; {function,F,A} -> - %% BifClash - Fun expression - %% N.B. Only allows BIFs here as well, NO IMPORTS!! - case ((not is_local_function(St#lint.locals,{F,A})) andalso - (erl_internal:bif(F, A) andalso - (not is_autoimport_suppressed(St#lint.no_auto,{F,A})))) of - true -> {[],St}; - false -> {[],call_function(Anno, F, A, St)} + St1 = case is_imported_function(St#lint.imports,{F,A}) of + true -> + add_error(Anno, {fun_import,{F,A}}, St); + false -> + %% check function use like for a call + As = lists:duplicate(A, undefined), % dummy args + check_call(Anno, F, As, Anno, St) + end, + %% do not mark as used as a local function if listed as + %% imported (either auto-imported or explicitly) + case not is_local_function(St1#lint.locals,{F,A}) andalso + (is_imported_function(St1#lint.imports,{F,A}) + orelse + (erl_internal:bif(F, A) andalso + not is_autoimport_suppressed(St1#lint.no_auto,{F,A}))) of + true -> {[],St1}; + false -> {[],call_function(Anno, F, A, St1)} end; {function, {atom, _, M}, {atom, _, F}, {integer, _, A}} -> {[], check_unexported_function(Anno, M, F, A, St)}; diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 0ed40654ddb6..53f2367e9da8 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -3375,7 +3375,7 @@ bif_clash(Config) when is_list(Config) -> binary_part(X,{1,2}) =:= fun binary_part/2. ">>, [], - {errors,[{{5,43},erl_lint,{undefined_function,{binary_part,2}}}],[]}}, + {errors,[{{5,43},erl_lint,{fun_import,{binary_part,2}}}],[]}}, %% Not from erlang and not from anywhere else {clash13, <<"-export([x/1]). @@ -3385,7 +3385,7 @@ bif_clash(Config) when is_list(Config) -> binary_part(X,{1,2}) =:= fun binary_part/2. ">>, [], - {errors,[{{5,43},erl_lint,{undefined_function,{binary_part,2}}}],[]}}, + {errors,[{{5,43},erl_lint,{fun_import,{binary_part,2}}}],[]}}, %% ...while real auto-import is OK. {clash14, <<"-export([x/1]). From e88ee26ba092aae0f69ddb158dfa871fae9220c8 Mon Sep 17 00:00:00 2001 From: Richard Carlsson Date: Thu, 9 Jan 2025 19:12:33 +0100 Subject: [PATCH 3/3] erl_lint: The checks for "old bifs" are no longer required This makes uses of local functions whose names conflict with auto-imported BIFs (without a no_auto_import declaration to resolve the conflict) always be a warning, never an error. Previously, this was an error for "old" BIfs (those that were auto imported pre OTP R14). --- lib/compiler/test/error_SUITE.erl | 8 +- lib/stdlib/src/erl_internal.erl | 132 +---------------------------- lib/stdlib/src/erl_lint.erl | 27 +----- lib/stdlib/test/erl_lint_SUITE.erl | 27 +++--- 4 files changed, 21 insertions(+), 173 deletions(-) diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index 4ed7d4963546..eb61fca3f27f 100644 --- a/lib/compiler/test/error_SUITE.erl +++ b/lib/compiler/test/error_SUITE.erl @@ -64,8 +64,8 @@ bif_clashes(Config) when is_list(Config) -> erlang:length(X). ">>, [return_warnings], - {error, - [{{4,18}, erl_lint,{call_to_redefined_old_bif,{length,1}}}], []} }], + {warning, + [{{4,18}, erl_lint,{call_to_redefined_bif,{length,1}}}]} }], [] = run(Config, Ts), Ts1 = [{bif_clashes2, <<" @@ -75,8 +75,8 @@ bif_clashes(Config) when is_list(Config) -> length([a,b,c]). ">>, [return_warnings], - {error, - [{{3,16}, erl_lint,{redefine_old_bif_import,{length,1}}}], []} }], + {warning, + [{{3,16}, erl_lint,{redefine_bif_import,{length,1}}}]} }], [] = run(Config, Ts1), Ts00 = [{bif_clashes3, <<" diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index a0828ae01268..d7ca8dcbb5a7 100644 --- a/lib/stdlib/src/erl_internal.erl +++ b/lib/stdlib/src/erl_internal.erl @@ -55,7 +55,7 @@ of interest to programmers who manipulate Erlang code. %% -export([bif/2,bif/3,guard_bif/2, - type_test/2,new_type_test/2,old_type_test/2,old_bif/2]). + type_test/2,new_type_test/2,old_type_test/2]). -export([arith_op/2,bool_op/2,comp_op/2,list_op/2,send_op/2,op_type/2]). -export([is_type/2]). @@ -450,136 +450,6 @@ bif(unregister, 1) -> true; bif(whereis, 1) -> true; bif(Name, A) when is_atom(Name), is_integer(A) -> false. --doc false. --spec old_bif(Name::atom(), Arity::arity()) -> boolean(). -%% Returns true if erlang:Name/Arity is an old (pre R14) auto-imported BIF, false otherwise. -%% Use erlang:is_bultin(Mod, Name, Arity) to find whether a function is a BIF -%% (meaning implemented in C) or not. - -old_bif(abs, 1) -> true; -old_bif(apply, 2) -> true; -old_bif(apply, 3) -> true; -old_bif(atom_to_binary, 2) -> true; -old_bif(atom_to_list, 1) -> true; -old_bif(binary_to_atom, 2) -> true; -old_bif(binary_to_existing_atom, 2) -> true; -old_bif(binary_to_list, 1) -> true; -old_bif(binary_to_list, 3) -> true; -old_bif(binary_to_term, 1) -> true; -old_bif(bitsize, 1) -> true; -old_bif(bit_size, 1) -> true; -old_bif(bitstring_to_list, 1) -> true; -old_bif(byte_size, 1) -> true; -old_bif(check_process_code, 2) -> true; -old_bif(date, 0) -> true; -old_bif(delete_module, 1) -> true; -old_bif(disconnect_node, 1) -> true; -old_bif(element, 2) -> true; -old_bif(erase, 0) -> true; -old_bif(erase, 1) -> true; -old_bif(exit, 1) -> true; -old_bif(exit, 2) -> true; -old_bif(float, 1) -> true; -old_bif(float_to_list, 1) -> true; -old_bif(garbage_collect, 0) -> true; -old_bif(garbage_collect, 1) -> true; -old_bif(get, 0) -> true; -old_bif(get, 1) -> true; -old_bif(get_keys, 1) -> true; -old_bif(group_leader, 0) -> true; -old_bif(group_leader, 2) -> true; -old_bif(halt, 0) -> true; -old_bif(halt, 1) -> true; -old_bif(hd, 1) -> true; -old_bif(integer_to_list, 1) -> true; -old_bif(iolist_size, 1) -> true; -old_bif(iolist_to_binary, 1) -> true; -old_bif(is_alive, 0) -> true; -old_bif(is_process_alive, 1) -> true; -old_bif(is_atom, 1) -> true; -old_bif(is_boolean, 1) -> true; -old_bif(is_binary, 1) -> true; -old_bif(is_bitstring, 1) -> true; -old_bif(is_float, 1) -> true; -old_bif(is_function, 1) -> true; -old_bif(is_function, 2) -> true; -old_bif(is_integer, 1) -> true; -old_bif(is_list, 1) -> true; -old_bif(is_number, 1) -> true; -old_bif(is_pid, 1) -> true; -old_bif(is_port, 1) -> true; -old_bif(is_reference, 1) -> true; -old_bif(is_tuple, 1) -> true; -old_bif(is_record, 2) -> true; -old_bif(is_record, 3) -> true; -old_bif(length, 1) -> true; -old_bif(link, 1) -> true; -old_bif(list_to_atom, 1) -> true; -old_bif(list_to_binary, 1) -> true; -old_bif(list_to_bitstring, 1) -> true; -old_bif(list_to_existing_atom, 1) -> true; -old_bif(list_to_float, 1) -> true; -old_bif(list_to_integer, 1) -> true; -old_bif(list_to_pid, 1) -> true; -old_bif(list_to_tuple, 1) -> true; -old_bif(load_module, 2) -> true; -old_bif(make_ref, 0) -> true; -old_bif(module_loaded, 1) -> true; -old_bif(monitor_node, 2) -> true; -old_bif(node, 0) -> true; -old_bif(node, 1) -> true; -old_bif(nodes, 0) -> true; -old_bif(nodes, 1) -> true; -old_bif(now, 0) -> true; -old_bif(open_port, 2) -> true; -old_bif(pid_to_list, 1) -> true; -old_bif(port_close, 1) -> true; -old_bif(port_command, 2) -> true; -old_bif(port_connect, 2) -> true; -old_bif(port_control, 3) -> true; -old_bif(pre_loaded, 0) -> true; -old_bif(process_flag, 2) -> true; -old_bif(process_flag, 3) -> true; -old_bif(process_info, 1) -> true; -old_bif(process_info, 2) -> true; -old_bif(processes, 0) -> true; -old_bif(purge_module, 1) -> true; -old_bif(put, 2) -> true; -old_bif(register, 2) -> true; -old_bif(registered, 0) -> true; -old_bif(round, 1) -> true; -old_bif(self, 0) -> true; -old_bif(setelement, 3) -> true; -old_bif(size, 1) -> true; -old_bif(spawn, 1) -> true; -old_bif(spawn, 2) -> true; -old_bif(spawn, 3) -> true; -old_bif(spawn, 4) -> true; -old_bif(spawn_link, 1) -> true; -old_bif(spawn_link, 2) -> true; -old_bif(spawn_link, 3) -> true; -old_bif(spawn_link, 4) -> true; -old_bif(spawn_monitor, 1) -> true; -old_bif(spawn_monitor, 3) -> true; -old_bif(spawn_opt, 2) -> true; -old_bif(spawn_opt, 3) -> true; -old_bif(spawn_opt, 4) -> true; -old_bif(spawn_opt, 5) -> true; -old_bif(split_binary, 2) -> true; -old_bif(statistics, 1) -> true; -old_bif(term_to_binary, 1) -> true; -old_bif(term_to_binary, 2) -> true; -old_bif(throw, 1) -> true; -old_bif(time, 0) -> true; -old_bif(tl, 1) -> true; -old_bif(trunc, 1) -> true; -old_bif(tuple_size, 1) -> true; -old_bif(tuple_to_list, 1) -> true; -old_bif(unlink, 1) -> true; -old_bif(unregister, 1) -> true; -old_bif(whereis, 1) -> true; -old_bif(Name, A) when is_atom(Name), is_integer(A) -> false. - -doc false. -spec is_type(Name, NumberOfTypeVariables) -> boolean() when Name :: atom(), diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 670e530524e1..9ce455f5198a 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -357,16 +357,6 @@ format_error_1({call_to_redefined_bif,{F,A}}) -> ambiguous call of overridden auto-imported BIF ~w/~w -- use erlang:~w/~w or "-compile({no_auto_import,[~w/~w]})." to resolve name clash """, [F,A,F,A,F,A]}; -format_error_1({call_to_redefined_old_bif,{F,A}}) -> - {~""" - ambiguous call of overridden pre Erlang/OTP R14 auto-imported BIF ~w/~w -- - use erlang:~w/~w or \"-compile({no_auto_import,[~w/~w]}).\" to resolve name clash - """, [F,A,F,A,F,A]}; -format_error_1({redefine_old_bif_import,{F,A}}) -> - {~""" - import directive overrides pre Erlang/OTP R14 auto-imported BIF ~w/~w -- - use "-compile({no_auto_import,[~w/~w]})." to resolve name clash - """, [F,A,F,A]}; format_error_1({redefine_bif_import,{F,A}}) -> {~""" import directive overrides auto-imported BIF ~w/~w -- @@ -1830,13 +1820,7 @@ import(Anno, {Mod,Fs}, St00) -> Warn = is_warn_enabled(bif_clash, St0) andalso (not bif_clash_specifically_disabled(St0,{F,A})), AutoImpSup = is_autoimport_suppressed(St0#lint.no_auto,{F,A}), - OldBif = erl_internal:old_bif(F,A), {Err,if - Warn and (not AutoImpSup) and OldBif -> - add_error - (Anno, - {redefine_old_bif_import, {F,A}}, - St0); Warn and (not AutoImpSup) -> add_warning (Anno, @@ -2910,16 +2894,7 @@ check_call(Anno, F, As, _Aa, St0) -> false ?= AutoSuppressed, true ?= is_warn_enabled(bif_clash, St0), false ?= bif_clash_specifically_disabled(St0, {F,A}), - case erl_internal:old_bif(F, A) of - true -> - add_error(Anno, - {call_to_redefined_old_bif, {F,A}}, - St0); - false -> - add_warning(Anno, - {call_to_redefined_bif, {F,A}}, - St0) - end + add_warning(Anno, {call_to_redefined_bif, {F,A}}, St0) else _ -> St0 diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index 53f2367e9da8..6b86a528e720 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -2416,12 +2416,12 @@ otp_5362(Config) when is_list(Config) -> ">>, {[nowarn_unused_function, warn_deprecated_function]}, - {error, - [{{5,19},erl_lint,{call_to_redefined_old_bif,{spawn,1}}}], + {warnings, [{{4,19},erl_lint,{deprecated,{erlang,now,0}, "see the \"Time and Time Correction in Erlang\" " "chapter of the ERTS User's Guide for more " - "information"}}]}}, + "information"}}, + {{5,19},erl_lint,{call_to_redefined_bif,{spawn,1}}}]}}, {otp_5362_5, <<"-compile(nowarn_deprecated_function). -compile(nowarn_bif_clash). @@ -3250,7 +3250,7 @@ bif_clash(Config) when is_list(Config) -> N. ">>, [nowarn_unexported_function], - {errors,[{{2,19},erl_lint,{call_to_redefined_old_bif,{size,1}}}],[]}}, + {warnings,[{{2,19},erl_lint,{call_to_redefined_bif,{size,1}}}]}}, %% Verify that warnings cannot be turned off in the old way. {clash2, @@ -3279,7 +3279,7 @@ bif_clash(Config) when is_list(Config) -> ">>, [], []}, - %% But this is totally wrong - meaning of the program changed in R14, so this is an error + %% For a pre R14 bif, it used to be an error, but is now a warning {clash4, <<"-export([size/1]). size({N,_}) -> @@ -3288,20 +3288,22 @@ bif_clash(Config) when is_list(Config) -> size(X). ">>, [], - {errors,[{{5,17},erl_lint,{call_to_redefined_old_bif,{size,1}}}],[]}}, - %% For a post R14 bif, its only a warning + {warnings,[{{5,17},erl_lint,{call_to_redefined_bif,{size,1}}}]}}, + %% For a post R14 bif, its only a warning; also check symbolic funs {clash5, - <<"-export([binary_part/2]). + <<"-export([binary_part/2,f/0]). binary_part({B,_},{X,Y}) -> binary_part(B,{X,Y}); binary_part(B,{X,Y}) -> binary:part(B,X,Y). + f() -> fun binary_part/2. ">>, [], - {warnings,[{{3,17},erl_lint,{call_to_redefined_bif,{binary_part,2}}}]}}, + {warnings,[{{3,17},erl_lint,{call_to_redefined_bif,{binary_part,2}}}, + {{6,22},erl_lint,{call_to_redefined_bif,{binary_part,2}}}]}}, %% If you really mean to call yourself here, you can "unimport" size/1 {clash6, - <<"-export([size/1]). + <<"-export([size/1,f/0]). -compile({no_auto_import,[size/1]}). size([]) -> 0; @@ -3309,6 +3311,7 @@ bif_clash(Config) when is_list(Config) -> N; size([_|T]) -> 1+size(T). + f() -> fun size/1. ">>, [], []}, @@ -3394,7 +3397,7 @@ bif_clash(Config) when is_list(Config) -> ">>, [], []}, - %% Import directive clashing with old bif is an error, regardless of if it's called or not + %% Import directive clashing with old bif used to be an error, now a warning {clash15, <<"-export([x/1]). -import(x,[abs/1]). @@ -3402,7 +3405,7 @@ bif_clash(Config) when is_list(Config) -> binary_part(X,{1,2}). ">>, [], - {errors,[{{2,16},erl_lint,{redefine_old_bif_import,{abs,1}}}],[]}}, + {warnings,[{{2,16},erl_lint,{redefine_bif_import,{abs,1}}}]}}, %% For a new BIF, it's only a warning {clash16, <<"-export([x/1]).