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.

1 files changed, 87 insertions, 35 deletions

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}