From e4691d14078de0419c6b644566e45aa696aa122e Mon Sep 17 00:00:00 2001 From: Hans Bolinder Date: Thu, 4 Jun 2015 13:50:20 +0200 Subject: dialyzer: Fix a bug in the expansion of forms The check that a modified type of a field is a subtype of the declared type has been moved outside of the expansion of forms to avoid loops. --- lib/hipe/cerl/erl_types.erl | 113 ++++++++++++++++++++++++++++++++++---------- 1 file changed, 87 insertions(+), 26 deletions(-) (limited to 'lib/hipe/cerl') diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index 14335cf635..e7823a596a 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -82,6 +82,8 @@ t_from_form/4, t_from_form/5, t_from_form_without_remote/2, + t_check_record_fields/4, + t_check_record_fields/5, t_from_range/2, t_from_range_unsafe/2, t_from_term/1, @@ -747,7 +749,8 @@ t_opaque_from_records(RecDict) -> end end, RecDict), OpaqueTypeDict = - dict:map(fun({opaque, Name, _Arity}, {{Module, _Form, ArgNames}, _Type}) -> + dict:map(fun({opaque, Name, _Arity}, + {{Module, _FileLine, _Form, ArgNames}, _Type}) -> %% Args = args_to_types(ArgNames), %% List = lists:zip(ArgNames, Args), %% TmpVarDict = dict:from_list(List), @@ -4189,7 +4192,7 @@ builtin_type(Name, Type, TypeNames, ET, M, MR, V, D, L) -> case dict:find(M, MR) of {ok, R} -> case lookup_type(Name, 0, R) of - {_, {{_M, _F, _A}, _T}} -> + {_, {{_M, _FL, _F, _A}, _T}} -> type_from_form(Name, [], TypeNames, ET, M, MR, V, D, L); error -> {Type, L} @@ -4203,7 +4206,7 @@ type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L) -> {ArgTypes, L1} = list_from_form(Args, TypeNames, ET, M, MR, V, D, L), {ok, R} = dict:find(M, MR), case lookup_type(Name, ArgsLen, R) of - {type, {{Module, Form, ArgNames}, _Type}} -> + {type, {{Module, _FileName, Form, ArgNames}, _Type}} -> TypeName = {type, Module, Name, ArgsLen}, case can_unfold_more(TypeName, TypeNames) of true -> @@ -4213,7 +4216,7 @@ type_from_form(Name, Args, TypeNames, ET, M, MR, V, D, L) -> false -> {t_any(), L1} end; - {opaque, {{Module, Form, ArgNames}, Type}} -> + {opaque, {{Module, _FileName, Form, ArgNames}, Type}} -> TypeName = {opaque, Module, Name, ArgsLen}, {Rep, L2} = case can_unfold_more(TypeName, TypeNames) of @@ -4251,7 +4254,7 @@ remote_from_form(RemMod, Name, Args, TypeNames, ET, M, MR, V, D, L) -> case sets:is_element(MFA, ET) of true -> case lookup_type(Name, ArgsLen, RemDict) of - {type, {{_Mod, Form, ArgNames}, _Type}} -> + {type, {{_Mod, _FileLine, Form, ArgNames}, _Type}} -> RemType = {type, RemMod, Name, ArgsLen}, case can_unfold_more(RemType, TypeNames) of true -> @@ -4263,7 +4266,7 @@ remote_from_form(RemMod, Name, Args, TypeNames, ET, M, MR, V, D, L) -> false -> {t_any(), L1} end; - {opaque, {{Mod, Form, ArgNames}, Type}} -> + {opaque, {{Mod, _FileLine, Form, ArgNames}, Type}} -> RemType = {opaque, RemMod, Name, ArgsLen}, List = lists:zip(ArgNames, ArgTypes), TmpVarDict = dict:from_list(List), @@ -4358,34 +4361,24 @@ build_field_dict(FieldTypes, TypeNames, ET, M, MR, V, D, L) -> build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left], TypeNames, ET, M, MR, V, D, L, Acc) -> {T, L1} = t_from_form(Type, TypeNames, ET, M, MR, V, D, L - 1), - %% The cached record field type (DeclType) in - %% get_mod_record_types()), was created with a similar call as TT. - %% Using T for the subtype test does not work since any() is not - %% always a subset of the field type. - TT = t_from_form(Type, ET, M, MR, V), - NewAcc = [{Name, Type, T, TT}|Acc], + NewAcc = [{Name, Type, T}|Acc], {Dict, L2} = build_field_dict(Left, TypeNames, ET, M, MR, V, D, L1, NewAcc), {Dict, L2}; build_field_dict([], _TypeNames, _ET, _M, _MR, _V, _D, L, Acc) -> {lists:keysort(1, Acc), L}. -get_mod_record_types([{FieldName, _Abstr, DeclType}|Left1], - [{FieldName, TypeForm, ModType, ModTypeTest}|Left2], +get_mod_record_types([{FieldName, _Abstr, _DeclType}|Left1], + [{FieldName, TypeForm, ModType}|Left2], Acc) -> - ModTypeNoVars = subst_all_vars_to_any(ModTypeTest), - case t_is_subtype(ModTypeNoVars, DeclType) of - false -> {error, FieldName}; - true -> get_mod_record_types(Left1, Left2, - [{FieldName, TypeForm, ModType}|Acc]) - end; + get_mod_record_types(Left1, Left2, [{FieldName, TypeForm, ModType}|Acc]); get_mod_record_types([{FieldName1, _Abstr, _DeclType} = DT|Left1], - [{FieldName2, _FormType, _ModType, _TT}|_] = List2, + [{FieldName2, _FormType, _ModType}|_] = List2, Acc) when FieldName1 < FieldName2 -> get_mod_record_types(Left1, List2, [DT|Acc]); get_mod_record_types(Left1, [], Acc) -> {ok, lists:keysort(1, Left1++Acc)}; -get_mod_record_types(_, [{FieldName2, _FormType, _ModType, _TT}|_], _Acc) -> +get_mod_record_types(_, [{FieldName2, _FormType, _ModType}|_], _Acc) -> {error, FieldName2}. %% It is important to create a limited version of the record type @@ -4406,6 +4399,74 @@ list_from_form([H|Tail], TypeNames, ET, M, MR, V, D, L) -> {T1, L2} = list_from_form(Tail, TypeNames, ET, M, MR, V, D, L1), {[H1|T1], L2}. +-spec t_check_record_fields(parse_form(), sets:set(mfa()), module(), + mod_records()) -> ok. + +t_check_record_fields(Form, ExpTypes, Module, RecDict) -> + t_check_record_fields(Form, ExpTypes, Module, RecDict, dict:new()). + +-spec t_check_record_fields(parse_form(), sets:set(mfa()), module(), + mod_records(), var_table()) -> ok. + +%% If there is something wrong with parse_form() +%% throw({error, io_lib:chars()} is called. + +t_check_record_fields({var, _L, _}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({ann_type, _L, [_Var, Type]}, ET, M, MR, V) -> + t_check_record_fields(Type, ET, M, MR, V); +t_check_record_fields({paren_type, _L, [Type]}, ET, M, MR, V) -> + t_check_record_fields(Type, ET, M, MR, V); +t_check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]}, + ET, M, MR, V) -> + list_check_record_fields(Args, ET, M, MR, V); +t_check_record_fields({atom, _L, _}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({integer, _L, _}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({op, _L, _Op, _Arg}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({type, _L, tuple, any}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({type, _L, map, any}, _ET, _M, _MR, _V) -> ok; +t_check_record_fields({type, _L, binary, [_Base, _Unit]}, _ET, _M, _MR, _V) -> + ok; +t_check_record_fields({type, _L, 'fun', [{type, _, any}, Range]}, + ET, M, MR, V) -> + t_check_record_fields(Range, ET, M, MR, V); +t_check_record_fields({type, _L, range, [_From, _To]}, _ET, _M, _MR, _V) -> + ok; +t_check_record_fields({type, _L, record, [Name|Fields]}, ET, M, MR, V) -> + check_record(Name, Fields, ET, M, MR, V); +t_check_record_fields({type, _L, _, Args}, ET, M, MR, V) -> + list_check_record_fields(Args, ET, M, MR, V); +t_check_record_fields({user_type, _L, _Name, Args}, ET, M, MR, V) -> + list_check_record_fields(Args, ET, M, MR, V). + +check_record({atom, _, Name}, ModFields, ET, M, MR, V) -> + {ok, R} = dict:find(M, MR), + {ok, DeclFields} = lookup_record(Name, R), + case check_fields(ModFields, DeclFields, ET, M, MR, V) of + {error, FieldName} -> + throw({error, io_lib:format("Illegal declaration of #~w{~w}\n", + [Name, FieldName])}); + ok -> ok + end. + +check_fields([{type, _, field_type, [{atom, _, Name}, Abstr]}|Left], + DeclFields, ET, M, MR, V) -> + Type = t_from_form(Abstr, ET, M, MR, V), + {Name, _, DeclType} = lists:keyfind(Name, 1, DeclFields), + TypeNoVars = subst_all_vars_to_any(Type), + case t_is_subtype(TypeNoVars, DeclType) of + false -> {error, Name}; + true -> check_fields(Left, DeclFields, ET, M, MR, V) + end; +check_fields([], _Decl, _ET, _M, _MR, _V) -> + ok. + +list_check_record_fields([], _ET, _M, _MR, _V) -> + ok; +list_check_record_fields([H|Tail], ET, M, MR, V) -> + ok = t_check_record_fields(H, ET, M, MR, V), + list_check_record_fields(Tail, ET, M, MR, V). + -spec t_var_names([erl_type()]) -> [atom()]. t_var_names([{var, _, Name}|L]) when L =/= '_' -> @@ -4556,9 +4617,9 @@ is_erl_type(_) -> false. lookup_record(Tag, RecDict) when is_atom(Tag) -> case dict:find({record, Tag}, RecDict) of - {ok, [{_Arity, Fields}]} -> + {ok, {_FileLine, [{_Arity, Fields}]}} -> {ok, Fields}; - {ok, List} when is_list(List) -> + {ok, {_FileLine, List}} when is_list(List) -> %% This will have to do, since we do not know which record we %% are looking for. error; @@ -4571,8 +4632,8 @@ lookup_record(Tag, RecDict) when is_atom(Tag) -> lookup_record(Tag, Arity, RecDict) when is_atom(Tag) -> case dict:find({record, Tag}, RecDict) of - {ok, [{Arity, Fields}]} -> {ok, Fields}; - {ok, OrdDict} -> orddict:find(Arity, OrdDict); + {ok, {_FileLine, [{Arity, Fields}]}} -> {ok, Fields}; + {ok, {_FileLine, OrdDict}} -> orddict:find(Arity, OrdDict); error -> error end. -- cgit v1.2.3