Skip to content

Commit 0f24dee

Browse files
committed
Add options for silencing warnings for behaviours
This commit adds the following compiler options for suppressing warnings having to do with behaviours: * nowarn_conflicting_behaviours * nowarn_undefined_behaviour_func * nowarn_undefined_behaviour * nowarn_undefined_behaviour_callbacks * nowarn_ill_defined_behaviour_callbacks * nowarn_ill_defined_optional_callbacks Closes #8985
1 parent e6737da commit 0f24dee

File tree

5 files changed

+132
-11
lines changed

5 files changed

+132
-11
lines changed

lib/compiler/src/compile.erl

Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -736,6 +736,34 @@ value are listed.
736736
this kind of warning for the types in `Types`, where `Types` is a tuple
737737
`{TypeName,Arity}` or a list of such tuples.
738738

739+
- **`nowarn_conflicting_behaviours`** - By default, warnings are emitted when
740+
a module opts in to multiple behaviours that share the names of one or more
741+
callback functions. Use this option to turn off this kind of warning.
742+
743+
- **`nowarn_undefined_behaviour_func`** - By default, a warning is
744+
emitted when a module that uses a behaviour does not export a
745+
mandatory callback function required by that behaviour. Use this
746+
option to turn off this kind of warning.
747+
748+
- **`nowarn_undefined_behaviour`** - By default, a warning is emitted
749+
when a module attempts to us an unknown behaviour. Use this option
750+
to turn off this kind of warning.
751+
752+
- **`nowarn_undefined_behaviour_callbacks`** - By default, a warning
753+
is emitted when `behaviour_info(callbacks)` in the behaviour module
754+
returns `undefined` instead of a list of callback functions. Use this
755+
option to turn off this kind of warning.
756+
757+
- **`nowarn_ill_defined_behaviour_callbacks`** - By default, a warning
758+
is emitted when `behaviour_info(callbacks)` in the behaviour module
759+
returns a badly formed list of functions. Use this option to turn
760+
off this kind of warning.
761+
762+
- **`nowarn_ill_defined_optional_callbacks`** - By default, a warning
763+
is emitted when `behaviour_info(optional_callbacks)` in the
764+
behaviour module returns a badly formed list of functions. Use this
765+
option to turn off this kind of warning.
766+
739767
Other kinds of warnings are _opportunistic warnings_. They are generated when
740768
the compiler happens to notice potential issues during optimization and code
741769
generation.

lib/stdlib/src/erl_lint.erl

Lines changed: 46 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -821,6 +821,31 @@ start(File, Opts) ->
821821
true, Opts)},
822822
{update_literal,
823823
bool_option(warn_update_literal, nowarn_update_literal,
824+
true, Opts)},
825+
%% Behaviour warnings.
826+
{conflicting_behaviours,
827+
bool_option(warn_conflicting_behaviours,
828+
nowarn_conflicting_behaviours,
829+
true, Opts)},
830+
{undefined_behaviour_func,
831+
bool_option(warn_undefined_behaviour_func,
832+
nowarn_undefined_behaviour_func,
833+
true, Opts)},
834+
{undefined_behaviour,
835+
bool_option(warn_undefined_behaviour,
836+
nowarn_undefined_behaviour,
837+
true, Opts)},
838+
{undefined_behaviour_callbacks,
839+
bool_option(warn_undefined_behaviour_callbacks,
840+
nowarn_undefined_behaviour_callbacks,
841+
true, Opts)},
842+
{ill_defined_behaviour_callbacks,
843+
bool_option(warn_ill_defined_behaviour_callbacks,
844+
nowarn_ill_defined_behaviour_callbacks,
845+
true, Opts)},
846+
{ill_defined_optional_callbacks,
847+
bool_option(warn_ill_defined_optional_callbacks,
848+
nowarn_ill_defined_optional_callbacks,
824849
true, Opts)}
825850
],
826851
Enabled1 = [Category || {Category,true} <- Enabled0],
@@ -1256,10 +1281,21 @@ all_behaviour_callbacks([{Anno,B}|Bs], Acc, St0) ->
12561281
all_behaviour_callbacks(Bs, [{{Anno,B},Bfs0,OBfs0}|Acc], St);
12571282
all_behaviour_callbacks([], Acc, St) -> {reverse(Acc),St}.
12581283

1284+
add_behaviour_warning(Anno, Warning, St) when is_tuple(Warning) ->
1285+
Tag = element(1, Warning),
1286+
case is_warn_enabled(Tag, St) of
1287+
true ->
1288+
add_warning(Anno, Warning, St);
1289+
false ->
1290+
St
1291+
end.
1292+
12591293
behaviour_callbacks(Anno, B, St0) ->
12601294
try B:behaviour_info(callbacks) of
12611295
undefined ->
1262-
St1 = add_warning(Anno, {undefined_behaviour_callbacks, B}, St0),
1296+
St1 = add_behaviour_warning(Anno,
1297+
{undefined_behaviour_callbacks, B},
1298+
St0),
12631299
{[], [], St1};
12641300
Funcs ->
12651301
case is_fa_list(Funcs) of
@@ -1275,22 +1311,22 @@ behaviour_callbacks(Anno, B, St0) ->
12751311
{Funcs, OptFuncs, St0};
12761312
false ->
12771313
W = {ill_defined_optional_callbacks, B},
1278-
St1 = add_warning(Anno, W, St0),
1314+
St1 = add_behaviour_warning(Anno, W, St0),
12791315
{Funcs, [], St1}
12801316
end
12811317
catch
12821318
_:_ ->
12831319
{Funcs, [], St0}
12841320
end;
12851321
false ->
1286-
St1 = add_warning(Anno,
1287-
{ill_defined_behaviour_callbacks, B},
1288-
St0),
1322+
St1 = add_behaviour_warning(Anno,
1323+
{ill_defined_behaviour_callbacks, B},
1324+
St0),
12891325
{[], [], St1}
12901326
end
12911327
catch
12921328
_:_ ->
1293-
St1 = add_warning(Anno, {undefined_behaviour, B}, St0),
1329+
St1 = add_behaviour_warning(Anno, {undefined_behaviour, B}, St0),
12941330
St2 = check_module_name(B, Anno, St1),
12951331
{[], [], St2}
12961332
end.
@@ -1334,7 +1370,7 @@ behaviour_missing_callbacks([{{Anno,B},Bfs0,OBfs}|T], St0) ->
13341370
case is_fa(F) of
13351371
true ->
13361372
M = {undefined_behaviour_func,F,B},
1337-
add_warning(Anno, M, S0);
1373+
add_behaviour_warning(Anno, M, S0);
13381374
false ->
13391375
S0 % ill_defined_behaviour_callbacks
13401376
end
@@ -1358,7 +1394,9 @@ behaviour_add_conflicts([{Cb,[{FirstAnno,FirstB}|Cs]}|T], St0) ->
13581394
behaviour_add_conflicts([], St) -> St.
13591395

13601396
behaviour_add_conflict([{Anno,B}|Cs], Cb, FirstL, FirstB, St0) ->
1361-
St = add_warning(Anno, {conflicting_behaviours,Cb,B,FirstL,FirstB}, St0),
1397+
St = add_behaviour_warning(Anno,
1398+
{conflicting_behaviours,Cb,B,FirstL,FirstB},
1399+
St0),
13621400
behaviour_add_conflict(Cs, Cb, FirstL, FirstB, St);
13631401
behaviour_add_conflict([], _, _, _, St) -> St.
13641402

lib/stdlib/test/erl_lint_SUITE.erl

Lines changed: 48 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -3471,6 +3471,11 @@ behaviour_basic(Config) when is_list(Config) ->
34713471
{warnings,[{{1,22},erl_lint,{undefined_behaviour_func,{start,2},application}}]}}
34723472
],
34733473
[] = run(Config, Ts),
3474+
3475+
Subst = #{behaviour1 => [nowarn_undefined_behaviour_func],
3476+
behaviour2 => [nowarn_undefined_behaviour_func],
3477+
behaviour4 => [nowarn_undefined_behaviour_func]},
3478+
[] = run(Config, rewrite(Ts, Subst)),
34743479
ok.
34753480

34763481
%% Basic tests with multiple behaviours.
@@ -3568,12 +3573,21 @@ behaviour_multiple(Config) when is_list(Config) ->
35683573
{conflicting_behaviours,{init,1},supervisor,{1,22},gen_server}}]}}
35693574
],
35703575
[] = run(Config, Ts),
3576+
3577+
Subst = #{behaviour3 => [nowarn_undefined_behaviour_func,
3578+
nowarn_conflicting_behaviours],
3579+
american_behavior3 => [nowarn_undefined_behaviour_func,
3580+
nowarn_conflicting_behaviours],
3581+
behaviour4 => [nowarn_conflicting_behaviours]},
3582+
[] = run(Config, rewrite(Ts, Subst)),
3583+
35713584
ok.
35723585

35733586
%% OTP-11861. behaviour_info() and -callback.
35743587
otp_11861(Conf) when is_list(Conf) ->
35753588
CallbackFiles = [callback1, callback2, callback3,
3576-
bad_behaviour1, bad_behaviour2],
3589+
bad_behaviour1, bad_behaviour2,
3590+
bad_behaviour3],
35773591
lists:foreach(fun(M) ->
35783592
F = filename:join(?datadir, M),
35793593
Opts = [{outdir,?privdir}, return],
@@ -3754,9 +3768,28 @@ otp_11861(Conf) when is_list(Conf) ->
37543768
f1(_) -> ok.
37553769
">>,
37563770
[],
3757-
[]}
3771+
[]},
3772+
3773+
{otp_11861_19,
3774+
<<"
3775+
-export([good/1]).
3776+
-behaviour(bad_behaviour3).
3777+
good(_) -> ok.
3778+
">>,
3779+
[],
3780+
{warnings,[{{3,16},erl_lint,{ill_defined_optional_callbacks,bad_behaviour3}}]}}
37583781
],
37593782
[] = run(Conf, Ts),
3783+
3784+
Subst = #{otp_11861_1 => [nowarn_conflicting_behaviours],
3785+
otp_11861_11 => [nowarn_ill_defined_behaviour_callbacks],
3786+
otp_11861_12 => [nowarn_undefined_behaviour],
3787+
otp_11861_13 => [nowarn_undefined_behaviour],
3788+
otp_11861_17 => [nowarn_undefined_behaviour_callbacks],
3789+
otp_11861_19 => [nowarn_ill_defined_optional_callbacks]
3790+
},
3791+
[] = run(Conf, rewrite(Ts, Subst)),
3792+
37603793
true = code:set_path(CodePath),
37613794
ok.
37623795

@@ -5455,6 +5488,19 @@ messages_with_jaro_suggestions(Config) ->
54555488
%%% Common utilities.
54565489
%%%
54575490

5491+
rewrite([{Name,Code,[],{warnings,_}}=H|T], Subst) ->
5492+
case Subst of
5493+
#{Name := Opts} ->
5494+
io:format("~s: testing with options ~p\n", [Name,Opts]),
5495+
[{Name,Code,Opts,[]}|rewrite(T, Subst)];
5496+
#{} ->
5497+
[H|rewrite(T, Subst)]
5498+
end;
5499+
rewrite([H|T], Subst) ->
5500+
[H|rewrite(T, Subst)];
5501+
rewrite([], _Subst) ->
5502+
[].
5503+
54585504
format_error(E) ->
54595505
lists:flatten(erl_lint:format_error(E)).
54605506

lib/stdlib/test/erl_lint_SUITE_data/bad_behaviour1.erl

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,4 +3,6 @@
33
-export([behaviour_info/1]).
44

55
behaviour_info(callbacks) ->
6-
[{a,1,bad}].
6+
[{a,1,bad}];
7+
behaviour_info(optional_callbacks) ->
8+
[{b,1,bad}].
Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,7 @@
1+
-module(bad_behaviour3).
2+
-export([behaviour_info/1]).
3+
4+
behaviour_info(callbacks) ->
5+
[{good,1}];
6+
behaviour_info(optional_callbacks) ->
7+
[{b,1,bad}].

0 commit comments

Comments
 (0)