diff options
Diffstat (limited to 'lib/dialyzer/src/dialyzer_contracts.erl')
| -rw-r--r-- | lib/dialyzer/src/dialyzer_contracts.erl | 492 |
1 files changed, 492 insertions, 0 deletions
diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl new file mode 100644 index 0000000000..e2680bb03d --- /dev/null +++ b/lib/dialyzer/src/dialyzer_contracts.erl @@ -0,0 +1,492 @@ +%% -*- erlang-indent-level: 2 -*- +%%----------------------------------------------------------------------- +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% +%% The contents of this file are subject to the Erlang Public License, +%% Version 1.1, (the "License"); you may not use this file except in +%% compliance with the License. You should have received a copy of the +%% Erlang Public License along with this software. If not, it can be +%% retrieved online at http://www.erlang.org/. +%% +%% Software distributed under the License is distributed on an "AS IS" +%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See +%% the License for the specific language governing rights and limitations +%% under the License. +%% +%% %CopyrightEnd% +%% + +-module(dialyzer_contracts). + +-export([check_contract/2, + check_contracts/3, + contracts_without_fun/3, + contract_to_string/1, + get_invalid_contract_warnings/3, + get_contract_args/1, + get_contract_return/1, + get_contract_return/2, + %% get_contract_signature/1, + is_overloaded/1, + process_contract_remote_types/1, + store_tmp_contract/5]). + +%%----------------------------------------------------------------------- + +-include("dialyzer.hrl"). + +%%----------------------------------------------------------------------- +%% Types used in other parts of the system below +%%----------------------------------------------------------------------- + +-type file_contract() :: {file_line(), #contract{}}. + +-type plt_contracts() :: [{mfa(), #contract{}}]. % actually, an orddict() + +%%----------------------------------------------------------------------- +%% Internal record for contracts whose components have not been processed +%% to expand records and/or remote types that they might contain. +%%----------------------------------------------------------------------- + +-type tmp_contract_fun() :: fun((dict()) -> contract_pair()). + +-record(tmp_contract, {contract_funs = [] :: [tmp_contract_fun()], + forms = [] :: [{_, _}]}). + +%%----------------------------------------------------------------------- + +%%-define(DEBUG, true). + +-ifdef(DEBUG). +-define(debug(X__, Y__), io:format(X__, Y__)). +-else. +-define(debug(X__, Y__), ok). +-endif. + +%%----------------------------------------------------------------------- + +-spec get_contract_return(#contract{}) -> erl_types:erl_type(). + +get_contract_return(#contract{contracts = Cs, args = GenArgs}) -> + process_contracts(Cs, GenArgs). + +-spec get_contract_return(#contract{}, [erl_types:erl_type()]) -> erl_types:erl_type(). + +get_contract_return(#contract{contracts = Cs}, Args) -> + process_contracts(Cs, Args). + +-spec get_contract_args(#contract{}) -> [erl_types:erl_type()]. + +get_contract_args(#contract{args = Args}) -> + Args. + +-spec get_contract_signature(#contract{}) -> erl_types:erl_type(). + +get_contract_signature(#contract{contracts = Cs, args = GeneralDomain}) -> + Range = process_contracts(Cs, GeneralDomain), + erl_types:t_fun(GeneralDomain, Range). + +-spec is_overloaded(#contract{}) -> boolean(). + +is_overloaded(#contract{contracts = Cs}) -> + case Cs of + [_] -> true; + [_,_|_] -> false + end. + +-spec contract_to_string(#contract{}) -> string(). + +contract_to_string(#contract{forms = Forms}) -> + contract_to_string_1(Forms). + +contract_to_string_1([{Contract, []}]) -> + strip_fun(erl_types:t_form_to_string(Contract)); +contract_to_string_1([{Contract, []}|Rest]) -> + strip_fun(erl_types:t_form_to_string(Contract)) ++ "\n ; " + ++ contract_to_string_1(Rest); +contract_to_string_1([{Contract, Constraints}]) -> + strip_fun(erl_types:t_form_to_string(Contract)) ++ " when " + ++ constraints_to_string(Constraints); +contract_to_string_1([{Contract, Constraints}|Rest]) -> + strip_fun(erl_types:t_form_to_string(Contract)) ++ " when " + ++ constraints_to_string(Constraints) ++ ";" ++ + contract_to_string_1(Rest). + +strip_fun("fun(" ++ String) -> + butlast(String). + +butlast([]) -> []; +butlast([_]) -> []; +butlast([H|T]) -> [H|butlast(T)]. + +constraints_to_string([]) -> + ""; +constraints_to_string([{type, _, constraint, [{atom, _, What}, Types]}]) -> + atom_to_list(What) ++ "(" ++ + sequence([erl_types:t_form_to_string(T) || T <- Types], ",") ++ ")"; +constraints_to_string([{type, _, constraint, [{atom, _, What}, Types]}|Rest]) -> + atom_to_list(What) ++ "(" ++ + sequence([erl_types:t_form_to_string(T) || T <- Types], ",") + ++ "), " ++ constraints_to_string(Rest). + +sequence([], _Delimiter) -> ""; +sequence([H], _Delimiter) -> H; +sequence([H|T], Delimiter) -> H ++ Delimiter ++ sequence(T, Delimiter). + +-spec process_contract_remote_types(dialyzer_codeserver:codeserver()) -> + dialyzer_codeserver:codeserver(). + +process_contract_remote_types(CodeServer) -> + TmpContractDict = dialyzer_codeserver:get_temp_contracts(CodeServer), + RecordDict = dialyzer_codeserver:get_records(CodeServer), + ContractFun = + fun({_M, _F, _A}, {File, #tmp_contract{contract_funs = CFuns, forms = Forms}}) -> + NewCs = [CFun(RecordDict) || CFun <- CFuns], + Args = general_domain(NewCs), + {File, #contract{contracts = NewCs, args = Args, forms = Forms}} + end, + ModuleFun = + fun(_ModuleName, ContractDict) -> + dict:map(ContractFun, ContractDict) + end, + NewContractDict = dict:map(ModuleFun, TmpContractDict), + dialyzer_codeserver:finalize_contracts(NewContractDict, CodeServer). + +-spec check_contracts([{mfa(), file_contract()}], + dialyzer_callgraph:callgraph(), dict()) -> plt_contracts(). + +check_contracts(Contracts, Callgraph, FunTypes) -> + FoldFun = + fun(Label, Type, NewContracts) -> + {ok, {M,F,A} = MFA} = dialyzer_callgraph:lookup_name(Label, Callgraph), + case orddict:find(MFA, Contracts) of + {ok, {_FileLine, Contract}} -> + case check_contract(Contract, Type) of + ok -> + case erl_bif_types:is_known(M, F, A) of + true -> + %% Disregard the contracts since + %% this is a known function. + NewContracts; + false -> + [{MFA, Contract}|NewContracts] + end; + {error, _Error} -> NewContracts + end; + error -> NewContracts + end + end, + dict:fold(FoldFun, [], FunTypes). + +%% Checks all components of a contract +-spec check_contract(#contract{}, erl_types:erl_type()) -> 'ok' | {'error', term()}. + +check_contract(#contract{contracts = Contracts}, SuccType) -> + try + Contracts1 = [{Contract, insert_constraints(Constraints, dict:new())} + || {Contract, Constraints} <- Contracts], + Contracts2 = [erl_types:t_subst(Contract, Dict) + || {Contract, Dict} <- Contracts1], + GenDomains = [erl_types:t_fun_args(C) || C <- Contracts2], + case check_domains(GenDomains) of + error -> + {error, {overlapping_contract, []}}; + ok -> + InfList = [erl_types:t_inf(Contract, SuccType, opaque) + || Contract <- Contracts2], + check_contract_inf_list(InfList, SuccType) + end + catch throw:{error, _} = Error -> Error + end. + +check_domains([_]) -> ok; +check_domains([Dom|Doms]) -> + Fun = fun(D) -> + erl_types:any_none_or_unit(erl_types:t_inf_lists(Dom, D, opaque)) + end, + case lists:all(Fun, Doms) of + true -> check_domains(Doms); + false -> error + end. + +%% Allow a contract if one of the overloaded contracts is possible. +%% We used to be more strict, e.g., all overloaded contracts had to be +%% possible. +check_contract_inf_list([FunType|Left], SuccType) -> + FunArgs = erl_types:t_fun_args(FunType), + case lists:any(fun erl_types:t_is_none_or_unit/1, FunArgs) of + true -> check_contract_inf_list(Left, SuccType); + false -> + STRange = erl_types:t_fun_range(SuccType), + case erl_types:t_is_none_or_unit(STRange) of + true -> ok; + false -> + Range = erl_types:t_fun_range(FunType), + case erl_types:t_is_none(erl_types:t_inf(STRange, Range, opaque)) of + true -> check_contract_inf_list(Left, SuccType); + false -> ok + end + end + end; +check_contract_inf_list([], _SuccType) -> + {error, invalid_contract}. + +%% This is the heart of the "range function" +-spec process_contracts([contract_pair()], [erl_types:erl_type()]) -> erl_types:erl_type(). + +process_contracts(OverContracts, Args) -> + process_contracts(OverContracts, Args, erl_types:t_none()). + +process_contracts([OverContract|Left], Args, AccRange) -> + NewAccRange = + case process_contract(OverContract, Args) of + error -> AccRange; + {ok, Range} -> erl_types:t_sup(AccRange, Range) + end, + process_contracts(Left, Args, NewAccRange); +process_contracts([], _Args, AccRange) -> + AccRange. + +-spec process_contract(contract_pair(), [erl_types:erl_type()]) -> 'error' | {'ok', erl_types:erl_type()}. + +process_contract({Contract, Constraints}, CallTypes0) -> + CallTypesFun = erl_types:t_fun(CallTypes0, erl_types:t_any()), + ContArgsFun = erl_types:t_fun(erl_types:t_fun_args(Contract), + erl_types:t_any()), + ?debug("Instance: Contract: ~s\n Arguments: ~s\n", + [erl_types:t_to_string(ContArgsFun), + erl_types:t_to_string(CallTypesFun)]), + case solve_constraints(ContArgsFun, CallTypesFun, Constraints) of + {ok, VarDict} -> + {ok, erl_types:t_subst(erl_types:t_fun_range(Contract), VarDict)}; + error -> error + end. + +solve_constraints(Contract, Call, Constraints) -> + %% First make sure the call follows the constraints + CDict = insert_constraints(Constraints, dict:new()), + Contract1 = erl_types:t_subst(Contract, CDict), + %% Just a safe over-approximation. + %% TODO: Find the types for type variables properly + ContrArgs = erl_types:t_fun_args(Contract1), + CallArgs = erl_types:t_fun_args(Call), + InfList = erl_types:t_inf_lists(ContrArgs, CallArgs), + case erl_types:any_none_or_unit(InfList) of + true -> error; + false -> {ok, CDict} + end. + %%Inf = erl_types:t_inf(Contract1, Call), + %% Then unify with the constrained call type. + %% ?debug("Call: ~s\n", [erl_types:t_to_string(Call)]), + %% ?debug("Contract: ~s\n", [erl_types:t_to_string(Contract)]), + %% ?debug("Contract1: ~s\n", [erl_types:t_to_string(Contract1)]), + %% ?debug("Inf: ~s\n", [erl_types:t_to_string(Inf)]), + %% erl_types:t_assign_variables_to_subtype(Contract, Inf). + +%% Checks the contracts for functions that are not implemented +-spec contracts_without_fun(dict(), [_], dialyzer_callgraph:callgraph()) -> [dial_warning()]. + +contracts_without_fun(Contracts, AllFuns0, Callgraph) -> + AllFuns1 = [{dialyzer_callgraph:lookup_name(Label, Callgraph), Arity} + || {Label, Arity} <- AllFuns0], + AllFuns2 = [{M, F, A} || {{ok, {M, F, _}}, A} <- AllFuns1], + AllContractMFAs = dict:fetch_keys(Contracts), + ErrorContractMFAs = AllContractMFAs -- AllFuns2, + [warn_spec_missing_fun(MFA, Contracts) || MFA <- ErrorContractMFAs]. + +warn_spec_missing_fun({M, F, A} = MFA, Contracts) -> + {FileLine, _Contract} = dict:fetch(MFA, Contracts), + {?WARN_CONTRACT_SYNTAX, FileLine, {spec_missing_fun, [M, F, A]}}. + +%% This treats the "when" constraints. It will be extended, we hope. +insert_constraints([{subtype, Type1, Type2}|Left], Dict) -> + case erl_types:t_is_var(Type1) of + true -> + Name = erl_types:t_var_name(Type1), + Dict1 = case dict:find(Name, Dict) of + error -> + dict:store(Name, Type2, Dict); + {ok, VarType} -> + dict:store(Name, erl_types:t_inf(VarType, Type2), Dict) + end, + insert_constraints(Left, Dict1); + false -> + %% A lot of things should change to add supertypes + throw({error, io_lib:format("First argument of is_subtype constraint " + "must be a type variable\n", [])}) + end; +insert_constraints([], Dict) -> Dict. + +-spec store_tmp_contract(mfa(), file_line(), [_], dict(), dict()) -> dict(). + +store_tmp_contract(MFA, FileLine, TypeSpec, SpecDict, RecordsDict) -> + %% io:format("contract from form: ~p\n", [TypeSpec]), + TmpContract = contract_from_form(TypeSpec, RecordsDict), + %% io:format("contract: ~p\n", [Contract]), + dict:store(MFA, {FileLine, TmpContract}, SpecDict). + +contract_from_form(Forms, RecDict) -> + {CFuns, Forms1} = contract_from_form(Forms, RecDict, [], []), + #tmp_contract{contract_funs = CFuns, forms = Forms1}. + +contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], RecDict, + TypeAcc, FormAcc) -> + TypeFun = + fun(AllRecords) -> + Type = erl_types:t_from_form(Form, RecDict), + NewType = erl_types:t_solve_remote(Type, AllRecords), + {NewType, []} + end, + NewTypeAcc = [TypeFun | TypeAcc], + NewFormAcc = [{Form, []} | FormAcc], + contract_from_form(Left, RecDict, NewTypeAcc, NewFormAcc); +contract_from_form([{type, _L1, bounded_fun, + [{type, _L2, 'fun', [_, _]} = Form, Constr]}| Left], + RecDict, TypeAcc, FormAcc) -> + TypeFun = + fun(AllRecords) -> + Constr1 = [constraint_from_form(C, RecDict, AllRecords) || C <- Constr], + VarDict = insert_constraints(Constr1, dict:new()), + Type = erl_types:t_from_form(Form, RecDict, VarDict), + NewType = erl_types:t_solve_remote(Type, AllRecords), + {NewType, Constr1} + end, + NewTypeAcc = [TypeFun | TypeAcc], + NewFormAcc = [{Form, Constr} | FormAcc], + contract_from_form(Left, RecDict, NewTypeAcc, NewFormAcc); +contract_from_form([], _RecDict, TypeAcc, FormAcc) -> + {lists:reverse(TypeAcc), lists:reverse(FormAcc)}. + +constraint_from_form({type, _, constraint, [{atom, _, is_subtype}, + [Type1, Type2]]}, RecDict, AllRecords) -> + T1 = erl_types:t_from_form(Type1, RecDict), + T2 = erl_types:t_from_form(Type2, RecDict), + T3 = erl_types:t_solve_remote(T1, AllRecords), + T4 = erl_types:t_solve_remote(T2, AllRecords), + {subtype, T3, T4}; +constraint_from_form({type, _, constraint, [{atom,_,Name}, List]}, _RecDict, _) -> + N = length(List), + throw({error, io_lib:format("Unsupported type guard ~w/~w\n", [Name, N])}). + +%% Gets the most general domain of a list of domains of all +%% the overloaded contracts + +general_domain(List) -> + general_domain(List, erl_types:t_none()). + +general_domain([{Sig, Constraints}|Left], AccSig) -> + Dict = insert_constraints(Constraints, dict:new()), + Sig1 = erl_types:t_subst(Sig, Dict), + general_domain(Left, erl_types:t_sup(AccSig, Sig1)); +general_domain([], AccSig) -> + %% Get rid of all variables in the domain. + AccSig1 = erl_types:subst_all_vars_to_any(AccSig), + erl_types:t_fun_args(AccSig1). + +-spec get_invalid_contract_warnings([module()], dialyzer_codeserver:codeserver(), dialyzer_plt:plt()) -> [dial_warning()]. + +get_invalid_contract_warnings(Modules, CodeServer, Plt) -> + get_invalid_contract_warnings_modules(Modules, CodeServer, Plt, []). + +get_invalid_contract_warnings_modules([Mod|Mods], CodeServer, Plt, Acc) -> + Contracts1 = dialyzer_codeserver:lookup_mod_contracts(Mod, CodeServer), + Contracts2 = dict:to_list(Contracts1), + Records = dialyzer_codeserver:lookup_mod_records(Mod, CodeServer), + NewAcc = get_invalid_contract_warnings_funs(Contracts2, Plt, Records, Acc), + get_invalid_contract_warnings_modules(Mods, CodeServer, Plt, NewAcc); +get_invalid_contract_warnings_modules([], _CodeServer, _Plt, Acc) -> + Acc. + +get_invalid_contract_warnings_funs([{MFA, {FileLine, Contract}}|Left], + Plt, RecDict, Acc) -> + case dialyzer_plt:lookup(Plt, MFA) of + none -> + %% This must be a contract for a non-available function. Just accept it. + get_invalid_contract_warnings_funs(Left, Plt, RecDict, Acc); + {value, {Ret, Args}} -> + Sig = erl_types:t_fun(Args, Ret), + NewAcc = + case check_contract(Contract, Sig) of + {error, invalid_contract} -> + [invalid_contract_warning(MFA, FileLine, Sig, RecDict)|Acc]; + {error, Msg} -> + [{?WARN_CONTRACT_SYNTAX, FileLine, Msg}|Acc]; + ok -> + {M, F, A} = MFA, + CSig0 = get_contract_signature(Contract), + CSig = erl_types:subst_all_vars_to_any(CSig0), + case erl_bif_types:is_known(M, F, A) of + true -> + %% This is strictly for contracts of functions also in + %% erl_bif_types + BifArgs = erl_bif_types:arg_types(M, F, A), + BifRet = erl_bif_types:type(M, F, A), + BifSig = erl_types:t_fun(BifArgs, BifRet), + case check_contract(Contract, BifSig) of + {error, _} -> + [invalid_contract_warning(MFA, FileLine, BifSig, RecDict) + |Acc]; + ok -> + picky_contract_check(CSig, BifSig, MFA, FileLine, + Contract, RecDict, Acc) + end; + false -> + picky_contract_check(CSig, Sig, MFA, FileLine, Contract, + RecDict, Acc) + end + end, + get_invalid_contract_warnings_funs(Left, Plt, RecDict, NewAcc) + end; +get_invalid_contract_warnings_funs([], _Plt, _RecDict, Acc) -> + Acc. + +invalid_contract_warning({M, F, A}, FileLine, Type, RecDict) -> + {?WARN_CONTRACT_TYPES, FileLine, + {invalid_contract, [M, F, A, dialyzer_utils:format_sig(Type, RecDict)]}}. + +picky_contract_check(CSig0, Sig0, MFA, FileLine, Contract, RecDict, Acc) -> + CSig = erl_types:t_abstract_records(CSig0, RecDict), + Sig = erl_types:t_abstract_records(Sig0, RecDict), + case erl_types:t_is_equal(CSig, Sig) of + true -> Acc; + false -> + case (erl_types:t_is_none(erl_types:t_fun_range(Sig)) andalso + erl_types:t_is_unit(erl_types:t_fun_range(CSig))) of + true -> Acc; + false -> + case extra_contract_warning(MFA, FileLine, Contract, + CSig, Sig, RecDict) of + no_warning -> Acc; + {warning, Warning} -> [Warning|Acc] + end + end + end. + +extra_contract_warning({M, F, A}, FileLine, Contract, CSig, Sig, RecDict) -> + SigString = lists:flatten(dialyzer_utils:format_sig(Sig, RecDict)), + ContractString0 = lists:flatten(dialyzer_utils:format_sig(CSig, RecDict)), + case SigString =:= ContractString0 of + true -> + %% The only difference is in record fields containing 'undefined' or not. + no_warning; + false -> + ContractString = contract_to_string(Contract), + {Tag, Msg} = + case erl_types:t_is_subtype(CSig, Sig) of + true -> + {?WARN_CONTRACT_SUBTYPE, + {contract_subtype, [M, F, A, ContractString, SigString]}}; + false -> + case erl_types:t_is_subtype(Sig, CSig) of + true -> + {?WARN_CONTRACT_SUPERTYPE, + {contract_supertype, [M, F, A, ContractString, SigString]}}; + false -> + {?WARN_CONTRACT_NOT_EQUAL, + {contract_diff, [M, F, A, ContractString, SigString]}} + end + end, + {warning, {Tag, FileLine, Msg}} + end. |