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.

2 files changed, 102 insertions, 41 deletions

diff --git a/lib/dialyzer/src/dialyzer_contracts.erl b/lib/dialyzer/src/dialyzer_contracts.erl
index 4a1ba9c539..914a4c6d8f 100644
--- a/lib/dialyzer/src/dialyzer_contracts.erl
+++ b/lib/dialyzer/src/dialyzer_contracts.erl
@@ -409,7 +409,7 @@ contract_from_form([{type, _, 'fun', [_, _]} = Form | Left], Module, RecDict,
     fun(ExpTypes, AllRecords) ->
 	NewType =
 	  try
-            erl_types:t_from_form(Form, ExpTypes, Module, AllRecords)
+            from_form_with_check(Form, ExpTypes, Module, AllRecords)
 	  catch
 	    throw:{error, Msg} ->
 	      {File, Line} = FileLine,
@@ -430,8 +430,8 @@ contract_from_form([{type, _L1, bounded_fun,
     fun(ExpTypes, AllRecords) ->
 	{Constr1, VarDict} =
 	  process_constraints(Constr, Module, RecDict, ExpTypes, AllRecords),
-        NewType = erl_types:t_from_form(Form, ExpTypes, Module, AllRecords,
-                                        VarDict),
+        NewType = from_form_with_check(Form, ExpTypes, Module, AllRecords,
+                                       VarDict),
         NewTypeNoVars = erl_types:subst_all_vars_to_any(NewType),
 	{NewTypeNoVars, Constr1}
     end,
@@ -454,7 +454,7 @@ initialize_constraints([], _Module, _RecDict, _ExpTypes, _AllRecords, Acc) ->
 initialize_constraints([Constr|Rest], Module, RecDict, ExpTypes, AllRecords, Acc) ->
   case Constr of
     {type, _, constraint, [{atom, _, is_subtype}, [Type1, Type2]]} ->
-      T1 = final_form(Type1, Module, ExpTypes, AllRecords, dict:new()),
+      T1 = final_form(Type1, ExpTypes, Module, AllRecords, dict:new()),
       Entry = {T1, Type2},
       initialize_constraints(Rest, Module, RecDict, ExpTypes, AllRecords, [Entry|Acc]);
     {type, _, constraint, [{atom,_,Name}, List]} ->
@@ -483,7 +483,16 @@ constraints_fixpoint(OldVarDict, Module, Constrs, RecDict, ExpTypes, AllRecords)
       constraints_fixpoint(NewVarDict, Module, Constrs, RecDict, ExpTypes, AllRecords)
   end.
 
-final_form(Form, Module, ExpTypes, AllRecords, VarDict) ->
+final_form(Form, ExpTypes, Module, AllRecords, VarDict) ->
+  from_form_with_check(Form, ExpTypes, Module, AllRecords, VarDict).
+
+from_form_with_check(Form, ExpTypes, Module, AllRecords) ->
+  erl_types:t_check_record_fields(Form, ExpTypes, Module, AllRecords),
+  erl_types:t_from_form(Form, ExpTypes, Module, AllRecords).
+
+from_form_with_check(Form, ExpTypes, Module, AllRecords, VarDict) ->
+  erl_types:t_check_record_fields(Form, ExpTypes, Module, AllRecords,
+                                  VarDict),
   erl_types:t_from_form(Form, ExpTypes, Module, AllRecords, VarDict).
 
 constraints_to_dict(Constrs, Module, RecDict, ExpTypes, AllRecords, VarDict) ->
@@ -495,7 +504,7 @@ constraints_to_subs([], _Module, _RecDict, _ExpTypes, _AllRecords, _VarDict, Acc
   Acc;
 constraints_to_subs([C|Rest], Module, RecDict, ExpTypes, AllRecords, VarDict, Acc) ->
   {T1, Form2} = C,
-  T2 = final_form(Form2, Module, ExpTypes, AllRecords, VarDict),
+  T2 = final_form(Form2, ExpTypes, Module, AllRecords, VarDict),
   NewAcc = [{subtype, T1, T2}|Acc],
   constraints_to_subs(Rest, Module, RecDict, ExpTypes, AllRecords, VarDict, NewAcc).
 
diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl
index e29fc3ba8b..592549825e 100644
--- a/lib/dialyzer/src/dialyzer_utils.erl
+++ b/lib/dialyzer/src/dialyzer_utils.erl
@@ -64,15 +64,15 @@ print_types(RecDict) ->
 print_types1([], _) ->
   ok;
 print_types1([{type, _Name, _NArgs} = Key|T], RecDict) ->
-  {ok, {{_Mod, _Form, _Args}, Type}} = dict:find(Key, RecDict),
+  {ok, {{_Mod, _FileLine, _Form, _Args}, Type}} = dict:find(Key, RecDict),
   io:format("\n~w: ~w\n", [Key, Type]),
   print_types1(T, RecDict);
 print_types1([{opaque, _Name, _NArgs} = Key|T], RecDict) ->
-  {ok, {{_Mod, _Form, _Args}, Type}} = dict:find(Key, RecDict),
+  {ok, {{_Mod, _FileLine, _Form, _Args}, Type}} = dict:find(Key, RecDict),
   io:format("\n~w: ~w\n", [Key, Type]),
   print_types1(T, RecDict);
 print_types1([{record, _Name} = Key|T], RecDict) ->
-  {ok, [{_Arity, _Fields} = AF]} = dict:find(Key, RecDict),
+  {ok, {_FileLine, [{_Arity, _Fields} = AF]}} = dict:find(Key, RecDict),
   io:format("~w: ~w\n\n", [Key, AF]),
   print_types1(T, RecDict).
 -define(debug(D_), print_types(D_)).
@@ -203,42 +203,50 @@ get_record_and_type_info(AbstractCode) ->
 	{'ok', dict:dict()} | {'error', string()}.
 
 get_record_and_type_info(AbstractCode, Module, RecDict) ->
-  get_record_and_type_info(AbstractCode, Module, [], RecDict).
+  get_record_and_type_info(AbstractCode, Module, [], RecDict, "nofile").
 
-get_record_and_type_info([{attribute, _, record, {Name, Fields0}}|Left],
-			 Module, Records, RecDict) ->
+get_record_and_type_info([{attribute, A, record, {Name, Fields0}}|Left],
+			 Module, Records, RecDict, File) ->
   {ok, Fields} = get_record_fields(Fields0, RecDict),
   Arity = length(Fields),
-  NewRecDict = dict:store({record, Name}, [{Arity, Fields}], RecDict),
-  get_record_and_type_info(Left, Module, [{record, Name}|Records], NewRecDict);
-get_record_and_type_info([{attribute, _, type, {{record, Name}, Fields0, []}}
-			  |Left], Module, Records, RecDict) ->
+  FN = {File, erl_anno:line(A)},
+  NewRecDict = dict:store({record, Name}, {FN, [{Arity,Fields}]}, RecDict),
+  get_record_and_type_info(Left, Module, [{record, Name}|Records],
+                           NewRecDict, File);
+get_record_and_type_info([{attribute, A, type, {{record, Name}, Fields0, []}}
+			  |Left], Module, Records, RecDict, File) ->
   %% This overrides the original record declaration.
   {ok, Fields} = get_record_fields(Fields0, RecDict),
   Arity = length(Fields),
-  NewRecDict = dict:store({record, Name}, [{Arity, Fields}], RecDict),
-  get_record_and_type_info(Left, Module, Records, NewRecDict);
-get_record_and_type_info([{attribute, _, Attr, {Name, TypeForm}}|Left],
-			 Module, Records, RecDict) when Attr =:= 'type';
-                                                        Attr =:= 'opaque' ->
-  try add_new_type(Attr, Name, TypeForm, [], Module, RecDict) of
+  FN = {File, erl_anno:line(A)},
+  NewRecDict = dict:store({record, Name}, {FN, [{Arity, Fields}]}, RecDict),
+  get_record_and_type_info(Left, Module, Records, NewRecDict, File);
+get_record_and_type_info([{attribute, A, Attr, {Name, TypeForm}}|Left],
+			 Module, Records, RecDict, File)
+               when Attr =:= 'type'; Attr =:= 'opaque' ->
+  FN = {File, erl_anno:line(A)},
+  try add_new_type(Attr, Name, TypeForm, [], Module, FN, RecDict) of
     NewRecDict ->
-      get_record_and_type_info(Left, Module, Records, NewRecDict)
+      get_record_and_type_info(Left, Module, Records, NewRecDict, File)
   catch
     throw:{error, _} = Error -> Error
   end;
-get_record_and_type_info([{attribute, _, Attr, {Name, TypeForm, Args}}|Left],
-			 Module, Records, RecDict) when Attr =:= 'type';
-                                                        Attr =:= 'opaque' ->
-  try add_new_type(Attr, Name, TypeForm, Args, Module, RecDict) of
+get_record_and_type_info([{attribute, A, Attr, {Name, TypeForm, Args}}|Left],
+			 Module, Records, RecDict, File)
+               when Attr =:= 'type'; Attr =:= 'opaque' ->
+  FN = {File, erl_anno:line(A)},
+  try add_new_type(Attr, Name, TypeForm, Args, Module, FN, RecDict) of
     NewRecDict ->
-      get_record_and_type_info(Left, Module, Records, NewRecDict)
+      get_record_and_type_info(Left, Module, Records, NewRecDict, File)
   catch
     throw:{error, _} = Error -> Error
   end;
-get_record_and_type_info([_Other|Left], Module, Records, RecDict) ->
-  get_record_and_type_info(Left, Module, Records, RecDict);
-get_record_and_type_info([], _Module, Records, RecDict) ->
+get_record_and_type_info([{attribute, _, file, {IncludeFile, _}}|Left],
+                         Module, Records, RecDict, _File) ->
+  get_record_and_type_info(Left, Module, Records, RecDict, IncludeFile);
+get_record_and_type_info([_Other|Left], Module, Records, RecDict, File) ->
+  get_record_and_type_info(Left, Module, Records, RecDict, File);
+get_record_and_type_info([], _Module, Records, RecDict, _File) ->
   case
     check_type_of_record_fields(lists:reverse(Records), RecDict)
   of
@@ -248,7 +256,8 @@ get_record_and_type_info([], _Module, Records, RecDict) ->
       {error, flat_format("  Error while parsing #~w{}: ~s\n", [Name, Error])}
   end.
 
-add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, RecDict) ->
+add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, FN,
+             RecDict) ->
   Arity = length(ArgForms),
   case erl_types:type_is_defined(TypeOrOpaque, Name, Arity, RecDict) of
     true ->
@@ -258,7 +267,7 @@ add_new_type(TypeOrOpaque, Name, TypeForm, ArgForms, Module, RecDict) ->
       try erl_types:t_var_names(ArgForms) of
         ArgNames ->
 	  dict:store({TypeOrOpaque, Name, Arity},
-                     {{Module, TypeForm, ArgNames},
+                     {{Module, FN, TypeForm, ArgNames},
                       erl_types:t_any()}, RecDict)
       catch
         _:_ ->
@@ -280,10 +289,12 @@ get_record_fields([{typed_record_field, OrdRecField, TypeForm}|Left],
     end,
   get_record_fields(Left, RecDict, [{Name, TypeForm}|Acc]);
 get_record_fields([{record_field, _Line, Name}|Left], RecDict, Acc) ->
-  NewAcc = [{erl_parse:normalise(Name), {var, -1, '_'}}|Acc],
+  A = erl_anno:set_generated(true, erl_anno:new(1)),
+  NewAcc = [{erl_parse:normalise(Name), {var, A, '_'}}|Acc],
   get_record_fields(Left, RecDict, NewAcc);
 get_record_fields([{record_field, _Line, Name, _Init}|Left], RecDict, Acc) ->
-  NewAcc = [{erl_parse:normalise(Name), {var, -1, '_'}}|Acc],
+  A = erl_anno:set_generated(true, erl_anno:new(1)),
+  NewAcc = [{erl_parse:normalise(Name), {var, A, '_'}}|Acc],
   get_record_fields(Left, RecDict, NewAcc);
 get_record_fields([], _RecDict, Acc) ->
   lists:reverse(Acc).
@@ -293,7 +304,7 @@ get_record_fields([], _RecDict, Acc) ->
 check_type_of_record_fields([], _RecDict) ->
   ok;
 check_type_of_record_fields([RecKey|Recs], RecDict) ->
-  {ok, [{_Arity, Fields}]} = dict:find(RecKey, RecDict),
+  {ok, {_FileLine, [{_Arity, Fields}]}} = dict:find(RecKey, RecDict),
   try
     [erl_types:t_from_form_without_remote(FieldTypeForm, RecDict)
      || {_FieldName, FieldTypeForm, _} <- Fields]
@@ -327,9 +338,10 @@ process_record_remote_types(CServer) ->
                                                 TempRecords)}
                          || {Name, Field, _} <- Fields]
                     end,
-                  orddict:map(FieldFun, Value);
+                  {FileLine, Fields} = Value,
+                  {FileLine, orddict:map(FieldFun, Fields)};
                 {opaque, _, _} ->
-                  {{_Module, Form, _ArgNames}=F, _Type} = Value,
+                  {{_Module, _FileLine, Form, _ArgNames}=F, _Type} = Value,
                   Type = erl_types:t_from_form(Form, TempExpTypes, Module,
                                                TempRecords),
                   {F, Type};
@@ -340,13 +352,53 @@ process_record_remote_types(CServer) ->
     end,
   try dict:map(ModuleFun, TempRecords) of
     NewRecords ->
+      ok = check_record_fields(NewRecords, TempExpTypes),
       CServer1 = dialyzer_codeserver:finalize_records(NewRecords, CServer),
       dialyzer_codeserver:finalize_exported_types(TempExpTypes, CServer1)
   catch
-    throw:{error, _RecName, _Error} = Error->
+    throw:{error, _RecName, _Error} = Error ->
       Error
   end.
 
+check_record_fields(Records, TempExpTypes) ->
+  CheckFun =
+    fun({Module, Element}) ->
+        CheckForm = fun(F) ->
+                      erl_types:t_check_record_fields(F, TempExpTypes,
+                                                      Module, Records)
+                  end,
+        ElemFun =
+          fun({Key, Value}) ->
+              case Key of
+                {record, _Name} ->
+                  FieldFun =
+                    fun({_Arity, Fields}) ->
+                        _ = [ok = CheckForm(Field) || {_, Field, _} <- Fields],
+                        ok
+                    end,
+                  {FileLine, Fields} = Value,
+                  Fun = fun() -> lists:foreach(FieldFun, Fields) end,
+                  msg_with_position(Fun, FileLine);
+                {_OpaqueOrType, _Name, _} ->
+                  {{_Module, FileLine, Form, _ArgNames}, _Type} = Value,
+                  Fun = fun() -> ok = CheckForm(Form) end,
+                  msg_with_position(Fun, FileLine)
+              end
+          end,
+        lists:foreach(ElemFun, dict:to_list(Element))
+    end,
+  lists:foreach(CheckFun, dict:to_list(Records)).
+
+msg_with_position(Fun, FileLine) ->
+  try Fun()
+  catch
+    throw:{error, Msg} ->
+      {File, Line} = FileLine,
+      BaseName = filename:basename(File),
+      NewMsg = io_lib:format("~s:~p: ~s", [BaseName, Line, Msg]),
+      throw({error, NewMsg})
+  end.
+
 -spec merge_records(dict:dict(), dict:dict()) -> dict:dict().
 
 merge_records(NewRecords, OldRecords) ->
@@ -385,11 +437,11 @@ get_optional_callbacks(Abs) ->
 %%  - Constraint is of the form {subtype, T1, T2} where T1 and T2
 %%    are erl_types:erl_type()
 
-get_spec_info([{attribute, Attr, Contract, {Id, TypeSpec}}|Left],
+get_spec_info([{attribute, Anno, Contract, {Id, TypeSpec}}|Left],
 	      SpecDict, CallbackDict, RecordsDict, ModName, OptCb, File)
   when ((Contract =:= 'spec') or (Contract =:= 'callback')),
        is_list(TypeSpec) ->
-  Ln = erl_anno:line(Attr),
+  Ln = erl_anno:line(Anno),
   MFA = case Id of
 	  {_, _, _} = T -> T;
 	  {F, A} -> {ModName, F, A}