diff --git a/lib/compiler/test/error_SUITE.erl b/lib/compiler/test/error_SUITE.erl index 4ed7d496354..eb61fca3f27 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/dialyzer/src/erl_types.erl b/lib/dialyzer/src/erl_types.erl index ec3720b1a4f..337f64e6286 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_expand_records.erl b/lib/stdlib/src/erl_expand_records.erl index 6b093e4c4b8..f5e79370ccb 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}; diff --git a/lib/stdlib/src/erl_internal.erl b/lib/stdlib/src/erl_internal.erl index a0828ae0126..d7ca8dcbb5a 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 7dd991e4ab9..f41d3a37435 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}) -> @@ -355,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 -- @@ -1836,13 +1828,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, @@ -2759,13 +2745,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)}; @@ -2910,16 +2906,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 0ed40654ddb..6b86a528e72 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. ">>, [], []}, @@ -3375,7 +3378,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 +3388,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]). @@ -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]).