diff --git a/lib/compiler/src/compile.erl b/lib/compiler/src/compile.erl index 0dbf6685e23d..f45df6bef348 100644 --- a/lib/compiler/src/compile.erl +++ b/lib/compiler/src/compile.erl @@ -736,6 +736,34 @@ value are listed. this kind of warning for the types in `Types`, where `Types` is a tuple `{TypeName,Arity}` or a list of such tuples. +- **`nowarn_conflicting_behaviours`** - By default, warnings are emitted when + an module opts in to multiple behaviours that share the names of one or more + callback functions. Use this option to turn off this kind of warning. + +- **`nowarn_undefined_behaviour_func`** - By default, a warning is + emitted when a module that uses a behaviour does not export a + mandatory callback function required by that behaviour. Use this + option to turn off this kind of warning. + +- **`nowarn_undefined_behaviour`** - By default, a warning is emitted + when a module attempts to us an unknown behaviour. Use this option + to turn off this kind of warning. + +- **`nowarn_undefined_behaviour_callbacks`** - By default, a warning + is emitted when `behaviour_info(callbacks)` in the behaviour module + returns `undefined` instead of a list of callback functions. Use this + option to turn off this kind of warning. + +- **`nowarn_ill_defined_behaviour_callbacks`** - By default, a warning + is emitted when `behaviour_info(callbacks)` in the behaviour module + returns a badly formed list of functions. Use this option to turn + off this kind of warning. + +- **`nowarn_ill_defined_optional_callbacks`** - By default, a warning + is emitted when `behaviour_info(optional_callbacks)` in the + behaviour module returns a badly formed list of functions. Use this + option to turn off this kind of warning. + Other kinds of warnings are _opportunistic warnings_. They are generated when the compiler happens to notice potential issues during optimization and code generation. diff --git a/lib/stdlib/src/erl_lint.erl b/lib/stdlib/src/erl_lint.erl index 850191ca2216..b871e76491b6 100644 --- a/lib/stdlib/src/erl_lint.erl +++ b/lib/stdlib/src/erl_lint.erl @@ -821,6 +821,31 @@ start(File, Opts) -> true, Opts)}, {update_literal, bool_option(warn_update_literal, nowarn_update_literal, + true, Opts)}, + %% Behaviour warnings. + {conflicting_behaviours, + bool_option(warn_conflicting_behaviours, + nowarn_conflicting_behaviours, + true, Opts)}, + {undefined_behaviour_func, + bool_option(warn_undefined_behaviour_func, + nowarn_undefined_behaviour_func, + true, Opts)}, + {undefined_behaviour, + bool_option(warn_undefined_behaviour, + nowarn_undefined_behaviour, + true, Opts)}, + {undefined_behaviour_callbacks, + bool_option(warn_undefined_behaviour_callbacks, + nowarn_undefined_behaviour_callbacks, + true, Opts)}, + {ill_defined_behaviour_callbacks, + bool_option(warn_ill_defined_behaviour_callbacks, + nowarn_ill_defined_behaviour_callbacks, + true, Opts)}, + {ill_defined_optional_callbacks, + bool_option(warn_ill_defined_optional_callbacks, + nowarn_ill_defined_optional_callbacks, true, Opts)} ], Enabled1 = [Category || {Category,true} <- Enabled0], @@ -1256,10 +1281,21 @@ all_behaviour_callbacks([{Anno,B}|Bs], Acc, St0) -> all_behaviour_callbacks(Bs, [{{Anno,B},Bfs0,OBfs0}|Acc], St); all_behaviour_callbacks([], Acc, St) -> {reverse(Acc),St}. +add_behaviour_warning(Anno, Warning, St) when is_tuple(Warning) -> + Tag = element(1, Warning), + case is_warn_enabled(Tag, St) of + true -> + add_warning(Anno, Warning, St); + false -> + St + end. + behaviour_callbacks(Anno, B, St0) -> try B:behaviour_info(callbacks) of undefined -> - St1 = add_warning(Anno, {undefined_behaviour_callbacks, B}, St0), + St1 = add_behaviour_warning(Anno, + {undefined_behaviour_callbacks, B}, + St0), {[], [], St1}; Funcs -> case is_fa_list(Funcs) of @@ -1275,7 +1311,7 @@ behaviour_callbacks(Anno, B, St0) -> {Funcs, OptFuncs, St0}; false -> W = {ill_defined_optional_callbacks, B}, - St1 = add_warning(Anno, W, St0), + St1 = add_behaviour_warning(Anno, W, St0), {Funcs, [], St1} end catch @@ -1283,14 +1319,14 @@ behaviour_callbacks(Anno, B, St0) -> {Funcs, [], St0} end; false -> - St1 = add_warning(Anno, - {ill_defined_behaviour_callbacks, B}, - St0), + St1 = add_behaviour_warning(Anno, + {ill_defined_behaviour_callbacks, B}, + St0), {[], [], St1} end catch _:_ -> - St1 = add_warning(Anno, {undefined_behaviour, B}, St0), + St1 = add_behaviour_warning(Anno, {undefined_behaviour, B}, St0), St2 = check_module_name(B, Anno, St1), {[], [], St2} end. @@ -1334,7 +1370,7 @@ behaviour_missing_callbacks([{{Anno,B},Bfs0,OBfs}|T], St0) -> case is_fa(F) of true -> M = {undefined_behaviour_func,F,B}, - add_warning(Anno, M, S0); + add_behaviour_warning(Anno, M, S0); false -> S0 % ill_defined_behaviour_callbacks end @@ -1358,7 +1394,9 @@ behaviour_add_conflicts([{Cb,[{FirstAnno,FirstB}|Cs]}|T], St0) -> behaviour_add_conflicts([], St) -> St. behaviour_add_conflict([{Anno,B}|Cs], Cb, FirstL, FirstB, St0) -> - St = add_warning(Anno, {conflicting_behaviours,Cb,B,FirstL,FirstB}, St0), + St = add_behaviour_warning(Anno, + {conflicting_behaviours,Cb,B,FirstL,FirstB}, + St0), behaviour_add_conflict(Cs, Cb, FirstL, FirstB, St); behaviour_add_conflict([], _, _, _, St) -> St. diff --git a/lib/stdlib/test/erl_lint_SUITE.erl b/lib/stdlib/test/erl_lint_SUITE.erl index b515191639fb..e1ca2ebe2459 100644 --- a/lib/stdlib/test/erl_lint_SUITE.erl +++ b/lib/stdlib/test/erl_lint_SUITE.erl @@ -3471,6 +3471,11 @@ behaviour_basic(Config) when is_list(Config) -> {warnings,[{{1,22},erl_lint,{undefined_behaviour_func,{start,2},application}}]}} ], [] = run(Config, Ts), + + Subst = #{behaviour1 => [nowarn_undefined_behaviour_func], + behaviour2 => [nowarn_undefined_behaviour_func], + behaviour4 => [nowarn_undefined_behaviour_func]}, + [] = run(Config, rewrite(Ts, Subst)), ok. %% Basic tests with multiple behaviours. @@ -3568,12 +3573,21 @@ behaviour_multiple(Config) when is_list(Config) -> {conflicting_behaviours,{init,1},supervisor,{1,22},gen_server}}]}} ], [] = run(Config, Ts), + + Subst = #{behaviour3 => [nowarn_undefined_behaviour_func, + nowarn_conflicting_behaviours], + american_behavior3 => [nowarn_undefined_behaviour_func, + nowarn_conflicting_behaviours], + behaviour4 => [nowarn_conflicting_behaviours]}, + [] = run(Config, rewrite(Ts, Subst)), + ok. %% OTP-11861. behaviour_info() and -callback. otp_11861(Conf) when is_list(Conf) -> CallbackFiles = [callback1, callback2, callback3, - bad_behaviour1, bad_behaviour2], + bad_behaviour1, bad_behaviour2, + bad_behaviour3], lists:foreach(fun(M) -> F = filename:join(?datadir, M), Opts = [{outdir,?privdir}, return], @@ -3754,9 +3768,28 @@ otp_11861(Conf) when is_list(Conf) -> f1(_) -> ok. ">>, [], - []} + []}, + + {otp_11861_19, + <<" + -export([good/1]). + -behaviour(bad_behaviour3). + good(_) -> ok. + ">>, + [], + {warnings,[{{3,16},erl_lint,{ill_defined_optional_callbacks,bad_behaviour3}}]}} ], [] = run(Conf, Ts), + + Subst = #{otp_11861_1 => [nowarn_conflicting_behaviours], + otp_11861_11 => [nowarn_ill_defined_behaviour_callbacks], + otp_11861_12 => [nowarn_undefined_behaviour], + otp_11861_13 => [nowarn_undefined_behaviour], + otp_11861_17 => [nowarn_undefined_behaviour_callbacks], + otp_11861_19 => [nowarn_ill_defined_optional_callbacks] + }, + [] = run(Conf, rewrite(Ts, Subst)), + true = code:set_path(CodePath), ok. @@ -5455,6 +5488,19 @@ messages_with_jaro_suggestions(Config) -> %%% Common utilities. %%% +rewrite([{Name,Code,[],{warnings,_}}=H|T], Subst) -> + case Subst of + #{Name := Opts} -> + io:format("~s: testing with options ~p\n", [Name,Opts]), + [{Name,Code,Opts,[]}|rewrite(T, Subst)]; + #{} -> + [H|rewrite(T, Subst)] + end; +rewrite([H|T], Subst) -> + [H|rewrite(T, Subst)]; +rewrite([], _Subst) -> + []. + format_error(E) -> lists:flatten(erl_lint:format_error(E)). diff --git a/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl index 230f4b45194d..8e4c305d6dc1 100644 --- a/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl +++ b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl @@ -3,4 +3,6 @@ -export([behaviour_info/1]). behaviour_info(callbacks) -> - [{a,1,bad}]. + [{a,1,bad}]; +behaviour_info(optional_callbacks) -> + [{b,1,bad}]. diff --git a/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour3.erl b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour3.erl new file mode 100644 index 000000000000..b156f6184a29 --- /dev/null +++ b/lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour3.erl @@ -0,0 +1,7 @@ +-module(bad_behaviour3). +-export([behaviour_info/1]). + +behaviour_info(callbacks) -> + [{good,1}]; +behaviour_info(optional_callbacks) -> + [{b,1,bad}].