aboutsummaryrefslogtreecommitdiffstats
path: root/lib/dialyzer/src/dialyzer_behaviours.erl
diff options
context:
space:
mode:
Diffstat (limited to 'lib/dialyzer/src/dialyzer_behaviours.erl')
-rw-r--r--lib/dialyzer/src/dialyzer_behaviours.erl291
1 files changed, 106 insertions, 185 deletions
diff --git a/lib/dialyzer/src/dialyzer_behaviours.erl b/lib/dialyzer/src/dialyzer_behaviours.erl
index 47ce9ba6eb..b478af01df 100644
--- a/lib/dialyzer/src/dialyzer_behaviours.erl
+++ b/lib/dialyzer/src/dialyzer_behaviours.erl
@@ -30,7 +30,7 @@
-module(dialyzer_behaviours).
--export([check_callbacks/4, get_behaviours/2, get_behaviour_apis/1,
+-export([check_callbacks/4, get_behaviour_apis/1,
translate_behaviour_api_call/5, translatable_behaviours/1,
translate_callgraph/3]).
@@ -51,12 +51,6 @@
%%--------------------------------------------------------------------
--spec get_behaviours([module()], dialyzer_codeserver:codeserver()) ->
- {[behaviour()], [behaviour()]}.
-
-get_behaviours(Modules, Codeserver) ->
- get_behaviours(Modules, Codeserver, [], []).
-
-spec check_callbacks(module(), [{cerl:cerl(), cerl:cerl()}],
dialyzer_plt:plt(),
dialyzer_codeserver:codeserver()) -> [dial_warning()].
@@ -69,12 +63,115 @@ check_callbacks(Module, Attrs, Plt, Codeserver) ->
MFA = {Module,module_info,0},
{_Var,Code} = dialyzer_codeserver:lookup_mfa_code(MFA, Codeserver),
File = get_file(cerl:get_ann(Code)),
- State = #state{plt = Plt, codeserver = Codeserver, filename = File,
- behlines = BehLines},
+ State = #state{plt = Plt, filename = File, behlines = BehLines,
+ codeserver = Codeserver},
Warnings = get_warnings(Module, Behaviours, State),
[add_tag_file_line(Module, W, State) || W <- Warnings]
end.
+%%--------------------------------------------------------------------
+
+get_behaviours(Attrs) ->
+ BehaviourListsAndLine = [{cerl:concrete(L2), hd(cerl:get_ann(L2))} ||
+ {L1, L2} <- Attrs, cerl:is_literal(L1),
+ cerl:is_literal(L2), cerl:concrete(L1) =:= 'behaviour'],
+ Behaviours = lists:append([Behs || {Behs,_} <- BehaviourListsAndLine]),
+ BehLines = [{B,L} || {L1,L} <- BehaviourListsAndLine, B <- L1],
+ {Behaviours, BehLines}.
+
+get_warnings(Module, Behaviours, State) ->
+ get_warnings(Module, Behaviours, State, []).
+
+get_warnings(_, [], _, Acc) ->
+ Acc;
+get_warnings(Module, [Behaviour|Rest], State, Acc) ->
+ NewAcc = check_behaviour(Module, Behaviour, State, Acc),
+ get_warnings(Module, Rest, State, NewAcc).
+
+check_behaviour(Module, Behaviour, #state{plt = Plt}, Acc) ->
+ case dialyzer_plt:lookup_callbacks(Plt, Behaviour) of
+ [] -> [{callback_info_missing, [Behaviour]}|Acc];
+ Callbacks -> check_all_callbacks(Module, Behaviour, Callbacks, Plt, Acc)
+ end.
+
+check_all_callbacks(_Module, _Behaviour, [], _Plt, Acc) ->
+ Acc;
+check_all_callbacks(Module, Behaviour, [Cb|Rest], Plt, Acc) ->
+ {{Behaviour, Function, Arity},
+ {{_BehFile, _BehLine}, Callback}} = Cb,
+ CbMFA = {Module, Function, Arity},
+ CbReturnType = dialyzer_contracts:get_contract_return(Callback),
+ CbArgTypes = dialyzer_contracts:get_contract_args(Callback),
+ Acc0 = Acc,
+ Acc1 =
+ case dialyzer_plt:lookup(Plt, CbMFA) of
+ 'none' -> [{callback_missing, [Behaviour, Function, Arity]}|Acc0];
+ {'value', RetArgTypes} ->
+ Acc00 = Acc0,
+ {ReturnType, ArgTypes} = RetArgTypes,
+ Acc01 =
+ case erl_types:t_is_none(erl_types:t_inf(ReturnType, CbReturnType)) of
+ false -> Acc00;
+ true ->
+ [{callback_type_mismatch,[Behaviour, Function,
+ Arity, ReturnType]}|Acc00]
+ end,
+ Acc02 =
+ case erl_types:any_none(
+ erl_types:t_inf_lists(ArgTypes, CbArgTypes)) of
+ false -> Acc01;
+ true ->
+ find_mismatching_args(ArgTypes, CbArgTypes, Behaviour,
+ Function, Arity, 1, Acc01)
+ end,
+ Acc02
+ end,
+ Acc2 =
+ case dialyzer_plt:lookup_contract(Plt, CbMFA) of
+ 'none' -> Acc1;
+ {value, _Contract} ->
+ %% TODO: Check spec for discrepancies
+ Acc1
+ end,
+ NewAcc = Acc2,
+ check_all_callbacks(Module, Behaviour, Rest, Plt, NewAcc).
+
+find_mismatching_args([], [], _Behaviour, _Function, _Arity, _N, Acc) ->
+ Acc;
+find_mismatching_args([Type|Rest], [CbType|CbRest], Behaviour,
+ Function, Arity, N, Acc) ->
+ case erl_types:t_is_none(erl_types:t_inf(Type, CbType)) of
+ false ->
+ find_mismatching_args(Rest, CbRest, Behaviour, Function, Arity, N+1, Acc);
+ true ->
+ NewAcc =
+ [{callback_arg_type_mismatch,
+ [Behaviour, Function, Arity, N, Type]}|Acc],
+ find_mismatching_args(Rest, CbRest, Behaviour, Function, Arity, N+1, NewAcc)
+ end.
+
+add_tag_file_line(_Module, {Tag, [B|_R]} = Warn, State)
+ when Tag =:= callback_missing;
+ Tag =:= callback_info_missing ->
+ {B, Line} = lists:keyfind(B, 1, State#state.behlines),
+ {?WARN_BEHAVIOUR, {State#state.filename, Line}, Warn};
+add_tag_file_line(Module, {_Tag, [_B, Fun, Arity|_R]} = Warn, State) ->
+ {_A, FunCode} =
+ dialyzer_codeserver:lookup_mfa_code({Module, Fun, Arity},
+ State#state.codeserver),
+ Anns = cerl:get_ann(FunCode),
+ FileLine = {get_file(Anns), get_line(Anns)},
+ {?WARN_BEHAVIOUR, FileLine, Warn}.
+
+get_line([Line|_]) when is_integer(Line) -> Line;
+get_line([_|Tail]) -> get_line(Tail);
+get_line([]) -> -1.
+
+get_file([{file, File}|_]) -> File;
+get_file([_|Tail]) -> get_file(Tail).
+
+%%-----------------------------------------------------------------------------
+
-spec translatable_behaviours(cerl:c_module()) -> behaviour_api_dict().
translatable_behaviours(Tree) ->
@@ -133,182 +230,6 @@ translate_callgraph([{Behaviour,_}|Behaviours], Module, Callgraph) ->
translate_callgraph([], _Module, Callgraph) ->
Callgraph.
-%%--------------------------------------------------------------------
-
-get_behaviours(Attrs) ->
- BehaviourListsAndLine = [{cerl:concrete(L2), hd(cerl:get_ann(L2))} ||
- {L1, L2} <- Attrs, cerl:is_literal(L1),
- cerl:is_literal(L2), cerl:concrete(L1) =:= 'behaviour'],
- Behaviours = lists:append([Behs || {Behs,_} <- BehaviourListsAndLine]),
- BehLines = [{B,L} || {L1,L} <- BehaviourListsAndLine, B <- L1],
- {Behaviours, BehLines}.
-
-get_warnings(Module, Behaviours, State) ->
- get_warnings(Module, Behaviours, State, []).
-
-get_warnings(_, [], _, Acc) ->
- Acc;
-get_warnings(Module, [Behaviour|Rest], State, Acc) ->
- Warnings = check_behaviour(Module, Behaviour, State),
- get_warnings(Module, Rest, State, Warnings ++ Acc).
-
-check_behaviour(Module, Behaviour, State) ->
- try
- Callbacks = Behaviour:behaviour_info(callbacks),
- Fun = fun({_,_,_}) -> true;
- (_) -> false
- end,
- case lists:any(Fun, Callbacks) of
- true -> check_all_callbacks(Module, Behaviour, Callbacks, State);
- false -> []
- end
- catch
- _:_ -> []
- end.
-
-check_all_callbacks(Module, Behaviour, Callbacks, State) ->
- check_all_callbacks(Module, Behaviour, Callbacks, State, []).
-
-check_all_callbacks(_Module, _Behaviour, [], _State, Acc) ->
- Acc;
-check_all_callbacks(Module, Behaviour, [{Fun, Arity, Spec}|Rest],
- #state{codeserver = CServer} = State, Acc) ->
- Records = dialyzer_codeserver:get_records(CServer),
- ExpTypes = dialyzer_codeserver:get_exported_types(CServer),
- case parse_spec(Spec, ExpTypes, Records) of
- {ok, Fun, Type} ->
- RetType = erl_types:t_fun_range(Type),
- ArgTypes = erl_types:t_fun_args(Type),
- Warns = check_callback(Module, Behaviour, Fun, Arity, RetType,
- ArgTypes, State#state.plt);
- Else ->
- Warns = [{invalid_spec, [Behaviour, Fun, Arity, reason_spec_error(Else)]}]
- end,
- check_all_callbacks(Module, Behaviour, Rest, State, Warns ++ Acc);
-check_all_callbacks(Module, Behaviour, [{Fun, Arity}|Rest], State, Acc) ->
- Warns = {spec_missing, [Behaviour, Fun, Arity]},
- check_all_callbacks(Module, Behaviour, Rest, State, [Warns|Acc]).
-
-parse_spec(String, ExpTypes, Records) ->
- case erl_scan:string(String) of
- {ok, Tokens, _} ->
- case erl_parse:parse(Tokens) of
- {ok, Form} ->
- case Form of
- {attribute, _, 'spec', {{Fun, _}, [TypeForm|_Constraint]}} ->
- MaybeRemoteType = erl_types:t_from_form(TypeForm),
- try
- Type = erl_types:t_solve_remote(MaybeRemoteType, ExpTypes,
- Records),
- {ok, Fun, Type}
- catch
- throw:{error,Msg} -> {spec_remote_error, Msg}
- end;
- _Other -> not_a_spec
- end;
- {error, {Line, _, Msg}} -> {spec_parser_error, Line, Msg}
- end;
- _Other ->
- lexer_error
- end.
-
-reason_spec_error({spec_remote_error, Msg}) ->
- io_lib:format("Remote type solver error: ~s. Make sure the behaviour source is included in the analysis or the plt",[Msg]);
-reason_spec_error(not_a_spec) ->
- "This is not a spec";
-reason_spec_error({spec_parser_error, Line, Msg}) ->
- io_lib:format("~s line of the spec: ~s", [ordinal(Line),Msg]);
-reason_spec_error(lexer_error) ->
- "Lexical error".
-
-ordinal(1) -> "1st";
-ordinal(2) -> "2nd";
-ordinal(3) -> "3rd";
-ordinal(N) when is_integer(N) -> io_lib:format("~wth",[N]).
-
-check_callback(Module, Behaviour, Fun, Arity, XRetType, XArgTypes, Plt) ->
- LookupType = dialyzer_plt:lookup(Plt, {Module, Fun, Arity}),
- case LookupType of
- {value, {Type,Args}} ->
- Warn1 = case unifiable(Type, XRetType) of
- [] -> [];
- Offenders ->
- [{callback_type_mismatch,
- [Behaviour, Fun, Arity, erl_types:t_sup(Offenders)]}]
- end,
- ZipArgs = lists:zip3(lists:seq(1, Arity), Args, XArgTypes),
- Warn2 = [{callback_arg_type_mismatch,
- [Behaviour, Fun, Arity, N,
- erl_types:t_sup(Offenders)]} ||
- {Offenders, N} <- [check_callback_1(V) || V <- ZipArgs],
- Offenders =/= []],
- Warn1 ++ Warn2;
- _ -> [{callback_missing, [Behaviour, Fun, Arity]}]
- end.
-
-check_callback_1({N, T1, T2}) ->
- {unifiable(T1, T2), N}.
-
-unifiable(Type1, Type2) ->
- List1 = erl_types:t_elements(Type1),
- List2 = erl_types:t_elements(Type2),
- [T || T <- List1,
- lists:all(fun(T1) ->
- erl_types:t_is_none(erl_types:t_inf(T, T1, opaque))
- end, List2)].
-
-add_tag_file_line(_Module, {Tag, [B|_R]} = Warn, State)
- when Tag =:= spec_missing;
- Tag =:= invalid_spec;
- Tag =:= callback_missing ->
- {B, Line} = lists:keyfind(B, 1, State#state.behlines),
- {?WARN_BEHAVIOUR, {State#state.filename, Line}, Warn};
-add_tag_file_line(Module, {_Tag, [_B, Fun, Arity|_R]} = Warn, State) ->
- {_A, FunCode} =
- dialyzer_codeserver:lookup_mfa_code({Module, Fun, Arity},
- State#state.codeserver),
- Anns = cerl:get_ann(FunCode),
- FileLine = {get_file(Anns), get_line(Anns)},
- {?WARN_BEHAVIOUR, FileLine, Warn}.
-
-get_line([Line|_]) when is_integer(Line) -> Line;
-get_line([_|Tail]) -> get_line(Tail);
-get_line([]) -> -1.
-
-get_file([{file, File}|_]) -> File;
-get_file([_|Tail]) -> get_file(Tail).
-
-%%-----------------------------------------------------------------------------
-
-get_behaviours([], _Codeserver, KnownAcc, UnknownAcc) ->
- {KnownAcc, UnknownAcc};
-get_behaviours([M|Rest], Codeserver, KnownAcc, UnknownAcc) ->
- Tree = dialyzer_codeserver:lookup_mod_code(M, Codeserver),
- Attrs = cerl:module_attrs(Tree),
- {Behaviours, _BehLines} = get_behaviours(Attrs),
- {Known, Unknown} = call_behaviours(Behaviours),
- get_behaviours(Rest, Codeserver, Known ++ KnownAcc, Unknown ++ UnknownAcc).
-
-call_behaviours(Behaviours) ->
- call_behaviours(Behaviours, [], []).
-call_behaviours([], KnownAcc, UnknownAcc) ->
- {lists:reverse(KnownAcc), lists:reverse(UnknownAcc)};
-call_behaviours([Behaviour|Rest], KnownAcc, UnknownAcc) ->
- try
- Callbacks = Behaviour:behaviour_info(callbacks),
- Fun = fun({_,_,_}) -> true;
- (_) -> false
- end,
- case lists:any(Fun, Callbacks) of
- false -> call_behaviours(Rest, KnownAcc, [Behaviour | UnknownAcc]);
- true -> call_behaviours(Rest, [Behaviour | KnownAcc], UnknownAcc)
- end
- catch
- _:_ -> call_behaviours(Rest, KnownAcc, [Behaviour | UnknownAcc])
- end.
-
-%------------------------------------------------------------------------------
-
get_behaviour_apis([], Acc) ->
Acc;
get_behaviour_apis([Behaviour | Rest], Acc) ->
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-14 22:33:21 +0000