Added support for partial specialization. This should fix a few problems with generics, the tests for which will be added in the next days after I've verified them.

For partial specialization only the declaration is reparsed, but not method bodies.

The way generic parameters are passed around inside the compiler is changed: instead of creating new type symbols we keep a (name,def) pair so that the code in insert_generic_parameter_types can decide whether it needs to add a type symbol (for new undefined defs) or not (for real types and undefined defs that were passed on from the parent generic). This required the tfpobjectlist type of the genericlist variables/parameters to be changed to tfphashobjectlist.

For correctly parsing Delphi specializations as parameters in functions of records (or objects) the relationship between the def and its typesym must already be established during the parsing. For this the checks for forcing a "type is not completely defined" message needed to be adjusted to correctly handle nested types as well. This should as a sideeffect also allow the usage of nested constants, etc like was fixed for classes some months ago.

ToDo: 
  - if a generic is specialized with only fully defined types then we could generate the in the unit where it's used. This is not yet done.
  - currently we don't specialize generics that are currently parsed; maybe this could be improved in the future for better type compatibility checks
  - check whether the pausing of token recording for partial specializations works correct in context of hint modifiers

pgenutil.pas:
  * parse_generic_parameters: return a tfphashobjectlist instead of a tfpobjectlist (requires a few type adjustments in various other declarations)
  * maybe_insert_generic_rename_symbol, insert_generic_parameter_types: change genericlist from tfpobjectlist to tfphashobjectlist
  * parse_generic_specialization_types_internal: use is_generic instead of checking for df_generic
  * generate_specialization:
      + add a nested function to disable the requirement to check for method bodies
      * use the "simple" parameter parsing only for error recovery
      * instead of already creating a new type symbol for a parameter we use the found symbol's name and its def and maybe create it later on (therefor the type of tfpobjectlist was changed to tfphashobjectlist)
      * a partial specialization is specialized into the symtable of the def it is specialized in instead of one of the two global symtables
      * for now we handle partial specializations of generics we are currently parsing like before
      * don't continue recording generic tokens while we do a partial specialization
      * use the new unset_forwarddef function on the newly created defs
  * insert_generic_parameter_types: only create a new type symbol if the found type symbol does not yet have an owner (thus was freshly created for this generic declaration)

pdecobj.pas, object_dec:
  * change type of genericlist from tfpobjectlist to tfphashobjectlist
  * set the type sym for all object types that can be generic or inside a generic (needed for correctly parsing Delphi style generic declarations)

pdecsub.pas, parse_proc_head:
  * consume_generic_interface: always generate the specialization name as now all generics are "specialized" inside a generic
  * the assumption that the def index numbers are the same is no longer true as the genericdef might contain the defs of partial specializations which are not generated for full specializations

pdecvar.pas, read_record_fields:
  * we also need to check nested types whether they contain a not yet completely parsed record or object

ptype.pas:
  * read_named_type: 
      * change genericlist from tfpobjectlist to tfphashobjectlist
      * pass the typesymbol along to record_dec
  * resolve_forward_types: use is_generic instead of checking for df_generic
  * single_type: 
      * use is_generic instead of checking for df_generic
      * no need to check generic parameters
  * parse_record_members:
      + add parameter for the record's type symbol
      * setup the typesym <=> def relationship
  + record_dec: add parameter for the type symbol and pass it to parse_record_members
  * read_named_type, expr_type: use is_generic instead of checking for df_generic
  * array_dec & procvar_dec: change genericlist from tfpobjectlist to tfphashobjectlist

symdef.pas, tstoreddef:
  * improve the checks used in is_generic and is_specialization to really only work on true generics and true (and partial) specializations respectively
  * don't search the type parameters in the symtable, but store them in the PPU and load them from there
  - remove fillgenericparas method (including the calls in the descendants tarraydef, tprocvardef, tobjectdef and trecorddef)

defcmp.pas, compare_defs_ext:
  * handle partial specializations: specializations with only undefineddefs are compatible to generic defs

pdecl.pas, types_dec:
  * switch generictypelist from tfpobjectlist to tfphashobjectlist

ppu.pas:
  * increase PPU version

+ added tests that ensure that "not completely defined" checks for records (and objects) still work correctly

git-svn-id: trunk@27861 -

.gitattributes

@@ -9604,6 +9604,13 @@ tests/tbf/tb0236.pp svneol=native#text/pascal
 tests/tbf/tb0237.pp svneol=native#text/pascal
 tests/tbf/tb0238.pp svneol=native#text/pascal
 tests/tbf/tb0239.pp svneol=native#text/pascal
+tests/tbf/tb0240.pp svneol=native#text/pascal
+tests/tbf/tb0241.pp svneol=native#text/pascal
+tests/tbf/tb0242.pp svneol=native#text/pascal
+tests/tbf/tb0243.pp svneol=native#text/pascal
+tests/tbf/tb0244.pp svneol=native#text/pascal
+tests/tbf/tb0245.pp svneol=native#text/pascal
+tests/tbf/tb0246.pp svneol=native#text/pascal
 tests/tbf/ub0115.pp svneol=native#text/plain
 tests/tbf/ub0149.pp svneol=native#text/plain
 tests/tbf/ub0158a.pp svneol=native#text/plain

compiler/defcmp.pas

@@ -213,6 +213,7 @@ implementation
       var
          subeq,eq : tequaltype;
          hd1,hd2 : tdef;
+         def_generic : tstoreddef;
          hct : tconverttype;
          hobjdef : tobjectdef;
          hpd : tprocdef;
@@ -324,6 +325,42 @@ implementation
                  exit;
                end;
            end;
+         { handling of partial specializations }
+         if (
+               (df_generic in def_to.defoptions) and
+               (df_specialization in def_from.defoptions) and
+               (tstoreddef(def_from).genericdef=def_to)
+             ) or (
+               (df_generic in def_from.defoptions) and
+               (df_specialization in def_to.defoptions) and
+               (tstoreddef(def_to).genericdef=def_from)
+             ) then
+           begin
+             if tstoreddef(def_from).genericdef=def_to then
+               def_generic:=tstoreddef(def_to)
+             else
+               def_generic:=tstoreddef(def_from);
+             if not assigned(def_generic.genericparas) then
+               internalerror(2014052306);
+             diff:=false;
+             for i:=0 to def_generic.genericparas.count-1 do
+               begin
+                 symfrom:=tsym(def_generic.genericparas[i]);
+                 if symfrom.typ<>typesym then
+                   internalerror(2014052307);
+                 if ttypesym(symfrom).typedef.typ<>undefineddef then
+                   diff:=true;
+                 if diff then
+                   break;
+               end;
+             if not diff then
+               begin
+                 doconv:=tc_equal;
+                 { the definitions are not exactly the same, but only equal }
+                 compare_defs_ext:=te_equal;
+                 exit;
+               end;
+           end;
 
          { we walk the wanted (def_to) types and check then the def_from
            types if there is a conversion possible }

compiler/pdecl.pas

@@ -438,7 +438,7 @@ implementation
          isgeneric,
          isunique,
          istyperenaming : boolean;
-         generictypelist : TFPObjectList;
+         generictypelist : tfphashobjectlist;
          generictokenbuf : tdynamicarray;
          vmtbuilder : TVMTBuilder;
          p:tnode;

compiler/pdecobj.pas

@@ -30,7 +30,7 @@ interface
       globtype,symconst,symtype,symdef;
 
     { parses a object declaration }
-    function object_dec(objecttype:tobjecttyp;const n:tidstring;objsym:tsym;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
+    function object_dec(objecttype:tobjecttyp;const n:tidstring;objsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
 
     { parses a (class) method declaration }
     function method_dec(astruct: tabstractrecorddef; is_classdef: boolean): tprocdef;
@@ -1293,7 +1293,7 @@ implementation
       end;
 
 
-    function object_dec(objecttype:tobjecttyp;const n:tidstring;objsym:tsym;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
+    function object_dec(objecttype:tobjecttyp;const n:tidstring;objsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
       var
         old_current_structdef: tabstractrecorddef;
         old_current_genericdef,
@@ -1482,10 +1482,12 @@ implementation
             parse_guid;
 
             { classes can handle links to themself not only inside type blocks
-              but in const blocks too. to make this possible we need to set
-              their symbols to real defs instead of errordef }
+              but in const blocks too. Additionally this is needed to parse parameters that are
+              specializations of the currently parsed type in basically everything except C++ and
+              ObjC classes. To make this possible we need to set their symbols to real defs instead
+              of errordef }
 
-            if assigned(objsym) and (objecttype in [odt_class,odt_javaclass,odt_interfacejava]) then
+            if assigned(objsym) and not (objecttype in [odt_cppclass,odt_objccategory,odt_objcclass,odt_objcprotocol]) then
               begin
                 olddef:=ttypesym(objsym).typedef;
                 ttypesym(objsym).typedef:=current_structdef;

compiler/pdecsub.pas

@@ -547,6 +547,9 @@ implementation
         srsym : tsym;
         checkstack : psymtablestackitem;
         procstartfilepos : tfileposinfo;
+        i,
+        index : longint;
+        found,
         searchagain : boolean;
         st,
         genericst: TSymtable;
@@ -729,8 +732,7 @@ implementation
               begin
                 str(genparalist.count,gencount);
                 genname:=sp+'$'+gencount;
-                if not parse_generic then
-                  genname:=generate_generic_name(genname,specializename);
+                genname:=generate_generic_name(genname,specializename);
                 ugenname:=upper(genname);
 
                 srsym:=search_object_name(ugenname,false);
@@ -990,9 +992,34 @@ implementation
                 genericst:=pd.struct.genericdef.GetSymtable(gs_record);
                 if not assigned(genericst) then
                   internalerror(200512114);
-                { We are parsing the same objectdef, the def index numbers
-                  are the same }
-                pd.genericdef:=tstoreddef(genericst.DefList[pd.owner.DefList.IndexOf(pd)]);
+
+                { when searching for the correct procdef to use as genericdef we need to ignore
+                  everything except procdefs so that we can find the correct indices }
+                index:=0;
+                found:=false;
+                for i:=0 to pd.owner.deflist.count-1 do
+                  begin
+                    if tdef(pd.owner.deflist[i]).typ<>procdef then
+                      continue;
+                    if pd.owner.deflist[i]=pd then
+                      begin
+                        found:=true;
+                        break;
+                      end;
+                    inc(index);
+                  end;
+                if not found then
+                  internalerror(2014052301);
+
+                for i:=0 to genericst.deflist.count-1 do
+                  begin
+                    if tdef(genericst.deflist[i]).typ<>procdef then
+                      continue;
+                    if index=0 then
+                      pd.genericdef:=tstoreddef(genericst.deflist[i]);
+                    dec(index);
+                  end;
+
                 if not assigned(pd.genericdef) or
                    (pd.genericdef.typ<>procdef) then
                   internalerror(200512115);

compiler/pdecvar.pas

@@ -1582,6 +1582,7 @@ implementation
          usedalign,
          maxalignment,startvarrecalign,
          maxpadalign, startpadalign: shortint;
+         stowner : tdef;
          pt : tnode;
          fieldvs   : tfieldvarsym;
          hstaticvs : tstaticvarsym;
@@ -1653,29 +1654,34 @@ implementation
              { allow only static fields reference to struct where they are declared }
              if not (vd_class in options) then
                begin
-                 if hdef.typ=arraydef then
+                 stowner:=tdef(recst.defowner);
+                 while assigned(stowner) and (stowner.typ in [objectdef,recorddef]) do
                    begin
-                     tmpdef:=hdef;
-                     while (tmpdef.typ=arraydef) do
+                     if hdef.typ=arraydef then
                        begin
-                         { dynamic arrays are allowed }
-                         if ado_IsDynamicArray in tarraydef(tmpdef).arrayoptions then
+                         tmpdef:=hdef;
+                         while (tmpdef.typ=arraydef) do
                            begin
-                             tmpdef:=nil;
-                             break;
+                             { dynamic arrays are allowed }
+                             if ado_IsDynamicArray in tarraydef(tmpdef).arrayoptions then
+                               begin
+                                 tmpdef:=nil;
+                                 break;
+                               end;
+                             tmpdef:=tarraydef(tmpdef).elementdef;
                            end;
-                         tmpdef:=tarraydef(tmpdef).elementdef;
+                       end
+                     else
+                       tmpdef:=hdef;
+                     if assigned(tmpdef) and
+                         (is_object(tmpdef) or is_record(tmpdef)) and
+                         is_owned_by(tabstractrecorddef(stowner),tabstractrecorddef(tmpdef)) then
+                       begin
+                         Message1(type_e_type_is_not_completly_defined, tabstractrecorddef(tmpdef).RttiName);
+                         { for error recovery or compiler will crash later }
+                         hdef:=generrordef;
                        end;
-                   end
-                 else
-                   tmpdef:=hdef;
-                 if assigned(tmpdef) and
-                     (is_object(tmpdef) or is_record(tmpdef)) and
-                     is_owned_by(tabstractrecorddef(recst.defowner),tabstractrecorddef(tmpdef)) then
-                   begin
-                     Message1(type_e_type_is_not_completly_defined, tabstractrecorddef(tmpdef).RttiName);
-                     { for error recovery or compiler will crash later }
-                     hdef:=generrordef;
+                     stowner:=tdef(stowner.owner.defowner);
                    end;
                end;
 

compiler/pgenutil.pas

@@ -36,10 +36,10 @@ uses
 
     procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string;parsedpos:tfileposinfo);
     procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string);
-    function parse_generic_parameters(allowconstraints:boolean):TFPObjectList;
+    function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
     function parse_generic_specialization_types(genericdeflist:tfpobjectlist;poslist:tfplist;out prettyname,specializename:ansistring):boolean;
-    procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList);
-    procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfpobjectlist);
+    procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist);
+    procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist);
     function generate_generic_name(const name:tidstring;specializename:ansistring):tidstring;
     procedure split_generic_name(const name:tidstring;out nongeneric:string;out count:longint);
     function resolve_generic_dummysym(const name:tidstring):tsym;
@@ -63,7 +63,7 @@ uses
   { global }
   globals,tokens,verbose,finput,
   { symtable }
-  symconst,symsym,symtable,defcmp,
+  symconst,symsym,symtable,defcmp,procinfo,
   { modules }
   fmodule,
   { pass 1 }
@@ -306,7 +306,11 @@ uses
             typeparam:=factor(false,true);
             if typeparam.nodetype=typen then
               begin
-                if df_generic in typeparam.resultdef.defoptions then
+                if tstoreddef(typeparam.resultdef).is_generic and
+                    (
+                      not parse_generic or
+                      not defs_belong_to_same_generic(typeparam.resultdef,current_genericdef)
+                    ) then
                   Message(parser_e_no_generics_as_params);
                 if assigned(poslist) then
                   begin
@@ -357,6 +361,25 @@ uses
 
 
     procedure generate_specialization(var tt:tdef;parse_class_parent:boolean;_prettyname:string;parsedtype:tdef;symname:string;parsedpos:tfileposinfo);
+
+        procedure unset_forwarddef(def: tdef);
+          var
+            st : TSymtable;
+            i : longint;
+          begin
+            case def.typ of
+              procdef:
+                tprocdef(def).forwarddef:=false;
+              objectdef,
+              recorddef:
+                begin
+                  st:=def.getsymtable(gs_record);
+                  for i:=0 to st.deflist.count-1 do
+                    unset_forwarddef(tdef(st.deflist[i]));
+                end;
+            end;
+          end;
+
       var
         st  : TSymtable;
         srsym : tsym;
@@ -371,7 +394,7 @@ uses
         genericdef,def : tstoreddef;
         generictype : ttypesym;
         genericdeflist : TFPObjectList;
-        generictypelist : TFPObjectList;
+        generictypelist : tfphashobjectlist;
         prettyname,specializename : ansistring;
         ufinalspecializename,
         countstr,genname,ugenname,finalspecializename : string;
@@ -387,6 +410,7 @@ uses
         hmodule : tmodule;
         oldcurrent_filepos : tfileposinfo;
         poslist : tfplist;
+        recordbuf: tdynamicarray;
       begin
         { retrieve generic def that we are going to replace }
         genericdef:=tstoreddef(tt);
@@ -405,7 +429,7 @@ uses
 
         { Only parse the parameters for recovery or
           for recording in genericbuf }
-        if parse_generic or errorrecovery then
+        if errorrecovery then
           begin
             first:=assigned(parsedtype);
             if not first and not try_to_consume(_LT) then
@@ -619,7 +643,7 @@ uses
             internalerror(200511182);
         end;
 
-        generictypelist:=tfpobjectlist.create(false);
+        generictypelist:=tfphashobjectlist.create(false);
 
         { build the list containing the types for the generic params }
         if not assigned(genericdef.genericparas) then
@@ -631,8 +655,7 @@ uses
             srsym:=tsym(genericdef.genericparas[i]);
             if not (sp_generic_para in srsym.symoptions) then
               internalerror(2013092602);
-            generictype:=ctypesym.create(srsym.realname,tdef(genericdeflist[i]));
-            generictypelist.add(generictype);
+            generictypelist.add(srsym.realname,tdef(genericdeflist[i]).typesym);
           end;
 
         { Special case if we are referencing the current defined object }
@@ -641,10 +664,37 @@ uses
           tt:=current_structdef;
 
         { decide in which symtable to put the specialization }
-        if current_module.is_unit and current_module.in_interface then
-          specializest:=current_module.globalsymtable
+        if parse_generic then
+          begin
+            if not assigned(current_genericdef) then
+              internalerror(2014050901);
+            if assigned(current_procinfo) and (df_generic in current_procinfo.procdef.defoptions) then
+              { if we are parsing the definition of a method we specialize into
+                the local symtable of it }
+              specializest:=current_procinfo.procdef.getsymtable(gs_local)
+            else
+              { we specialize the partial specialization into the symtable of the currently parsed
+                generic }
+              case current_genericdef.typ of
+                procvardef,
+                procdef:
+                  specializest:=current_genericdef.getsymtable(gs_local);
+                objectdef,
+                recorddef:
+                  specializest:=current_genericdef.getsymtable(gs_record);
+                arraydef:
+                  specializest:=tarraydef(current_genericdef).symtable;
+                else
+                  internalerror(2014050902);
+              end;
+          end
         else
-          specializest:=current_module.localsymtable;
+          if current_module.is_unit and current_module.in_interface then
+            specializest:=current_module.globalsymtable
+          else
+            specializest:=current_module.localsymtable;
+        if not assigned(specializest) then
+          internalerror(2014050910);
 
         { Can we reuse an already specialized type? }
 
@@ -665,6 +715,24 @@ uses
             until not assigned(def) or not (df_specialization in def.defoptions);
           end;
 
+        { if the genericdef is the def we are currently parsing (or one of its parents) then we can
+          not use it for specializing as the tokenbuffer is not yet set (and we aren't done with
+          parsing anyway), so for now we treat those still as generic defs without doing a partial
+          specialization }
+        if not assigned(tt) then
+          begin
+            def:=current_genericdef;
+            while assigned(def) and (def.typ in [recorddef,objectdef]) do
+              begin
+                if def=genericdef then
+                  begin
+                    tt:=def;
+                    break;
+                  end;
+                def:=tstoreddef(def.owner.defowner);
+              end;
+          end;
+
         { now check whether there is a specialization somewhere else }
         if not assigned(tt) then
           begin
@@ -748,6 +816,13 @@ uses
                 { use the index the module got from the current compilation process }
                 current_filepos.moduleindex:=hmodule.unit_index;
                 current_tokenpos:=current_filepos;
+                if parse_generic then
+                  begin
+                    recordbuf:=current_scanner.recordtokenbuf;
+                    current_scanner.recordtokenbuf:=nil;
+                  end
+                else
+                  recordbuf:=nil;
                 current_scanner.startreplaytokens(genericdef.generictokenbuf);
                 read_named_type(tt,srsym,genericdef,generictypelist,false,false);
                 current_filepos:=oldcurrent_filepos;
@@ -802,6 +877,13 @@ uses
                 { Consume the semicolon if it is also recorded }
                 try_to_consume(_SEMICOLON);
 
+                if assigned(recordbuf) then
+                  begin
+                    if assigned(current_scanner.recordtokenbuf) then
+                      internalerror(2014050909);
+                    current_scanner.recordtokenbuf:=recordbuf;
+                  end;
+
                 block_type:=old_block_type;
                 if parse_class_parent then
                   begin
@@ -827,6 +909,10 @@ uses
                 { using changeowner the def is automatically added to the new
                   symtable }
                 tdef(item).ChangeOwner(specializest);
+                { for partial specializations we implicitely declare any methods as having their
+                  implementations although we'll not specialize them in reality }
+                if parse_generic then
+                  unset_forwarddef(tdef(item));
               end;
 
             { if a generic was declared during the specialization we need to
@@ -858,7 +944,7 @@ uses
       end;
 
 
-    function parse_generic_parameters(allowconstraints:boolean):TFPObjectList;
+    function parse_generic_parameters(allowconstraints:boolean):tfphashobjectlist;
       var
         generictype : ttypesym;
         i,firstidx : longint;
@@ -870,7 +956,7 @@ uses
         constraintdata : tgenericconstraintdata;
         old_block_type : tblock_type;
       begin
-        result:=TFPObjectList.Create(false);
+        result:=tfphashobjectlist.create(false);
         firstidx:=0;
         old_block_type:=block_type;
         block_type:=bt_type;
@@ -879,7 +965,7 @@ uses
             begin
               generictype:=ctypesym.create(orgpattern,cundefinedtype);
               include(generictype.symoptions,sp_generic_para);
-              result.add(generictype);
+              result.add(orgpattern,generictype);
             end;
           consume(_ID);
           if try_to_consume(_COLON) then
@@ -1021,11 +1107,11 @@ uses
       end;
 
 
-    procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:TFPObjectList);
+    procedure insert_generic_parameter_types(def:tstoreddef;genericdef:tstoreddef;genericlist:tfphashobjectlist);
       var
-        i: longint;
-        generictype: ttypesym;
-        st: tsymtable;
+        i : longint;
+        generictype,sym : ttypesym;
+        st : tsymtable;
       begin
         def.genericdef:=genericdef;
         if not assigned(genericlist) then
@@ -1050,13 +1136,22 @@ uses
         for i:=0 to genericlist.count-1 do
           begin
             generictype:=ttypesym(genericlist[i]);
-            st.insert(generictype);
-            include(generictype.symoptions,sp_generic_para);
-            def.genericparas.add(generictype.name,generictype);
+            if assigned(generictype.owner) then
+              begin
+                sym:=ctypesym.create(genericlist.nameofindex(i),generictype.typedef);
+                st.insert(sym);
+                include(sym.symoptions,sp_generic_para);
+              end
+            else
+              begin
+                st.insert(generictype);
+                include(generictype.symoptions,sp_generic_para);
+              end;
+            def.genericparas.add(genericlist.nameofindex(i),generictype);
           end;
        end;
 
-    procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfpobjectlist);
+    procedure maybe_insert_generic_rename_symbol(const name:tidstring;genericlist:tfphashobjectlist);
       var
         gensym : ttypesym;
       begin

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 169;
+  CurrentPPUVersion = 170;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/ptype.pas

@@ -44,7 +44,7 @@ interface
     procedure single_type(var def:tdef;options:TSingleTypeOptions);
 
     { reads any type declaration, where the resulting type will get name as type identifier }
-    procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean;hadtypetoken:boolean);
+    procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist;parseprocvardir:boolean;hadtypetoken:boolean);
 
     { reads any type declaration }
     procedure read_anon_type(var def : tdef;parseprocvardir:boolean);
@@ -170,7 +170,7 @@ implementation
                                 { or an unspecialized generic symbol, which is
                                   the case for generics defined in non-Delphi
                                   modes }
-                                (df_generic in ttypesym(srsym).typedef.defoptions) and
+                                tstoreddef(ttypesym(srsym).typedef).is_generic and
                                 not parse_generic
                               )
                             ) then
@@ -499,18 +499,25 @@ implementation
               begin
                 def:=t2
               end
-            else if (df_generic in def.defoptions) and
+            else if tstoreddef(def).is_generic and
                 not
                   (
                     parse_generic and
-                    (current_genericdef.typ in [recorddef,objectdef]) and
                     (
-                      { if both defs belong to the same generic (e.g. both are
-                        subtypes) then we must allow the usage }
-                      defs_belong_to_same_generic(def,current_genericdef) or
-                      { this is needed to correctly resolve "type Foo=SomeGeneric<T>"
-                        declarations inside a generic }
-                      sym_is_owned_by(srsym,tabstractrecorddef(current_genericdef).symtable)
+                      { if this is a generic parameter than it has already been checked that this is
+                        a valid usage of a generic }
+                      (sp_generic_para in srsym.symoptions) or
+                      (
+                        (current_genericdef.typ in [recorddef,objectdef]) and
+                        (
+                          { if both defs belong to the same generic (e.g. both are
+                            subtypes) then we must allow the usage }
+                          defs_belong_to_same_generic(def,current_genericdef) or
+                          { this is needed to correctly resolve "type Foo=SomeGeneric<T>"
+                            declarations inside a generic }
+                          sym_is_owned_by(srsym,tabstractrecorddef(current_genericdef).symtable)
+                        )
+                      )
                     )
                   )
                 then
@@ -558,7 +565,7 @@ implementation
       end;
 
 
-    procedure parse_record_members;
+    procedure parse_record_members(recsym:tsym);
 
       function IsAnonOrLocal: Boolean;
         begin
@@ -566,6 +573,29 @@ implementation
                   not(symtablestack.stack^.next^.symtable.symtabletype in [globalsymtable,staticsymtable,objectsymtable,recordsymtable]);
         end;
 
+      var
+        olddef : tdef;
+
+      procedure set_typesym;
+        begin
+          if not assigned(recsym) then
+            exit;
+          if ttypesym(recsym).typedef=current_structdef then
+            exit;
+          ttypesym(recsym).typedef:=current_structdef;
+          current_structdef.typesym:=recsym;
+        end;
+
+      procedure reset_typesym;
+        begin
+          if not assigned(recsym) then
+            exit;
+          if ttypesym(recsym).typedef<>current_structdef then
+            exit;
+          ttypesym(recsym).typedef:=olddef;
+          current_structdef.typesym:=nil;
+        end;
+
       var
         pd : tprocdef;
         oldparse_only: boolean;
@@ -577,6 +607,14 @@ implementation
         if (token=_SEMICOLON) then
           Exit;
 
+        { the correct typesym<->def relationship is needed for example when
+          parsing parameters that are specializations of the record or when
+          using nested constants and such }
+        if assigned(recsym) then
+          olddef:=ttypesym(recsym).typedef
+        else
+          olddef:=nil;
+        set_typesym;
         current_structdef.symtable.currentvisibility:=vis_public;
         fields_allowed:=true;
         is_classdef:=false;
@@ -806,10 +844,11 @@ implementation
               consume(_ID); { Give a ident expected message, like tp7 }
           end;
         until false;
+        reset_typesym;
       end;
 
     { reads a record declaration }
-    function record_dec(const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList):tdef;
+    function record_dec(const n:tidstring;recsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist):tdef;
       var
          old_current_structdef: tabstractrecorddef;
          old_current_genericdef,
@@ -874,7 +913,7 @@ implementation
 
          if m_advanced_records in current_settings.modeswitches then
            begin
-             parse_record_members;
+             parse_record_members(recsym);
            end
          else
            begin
@@ -907,7 +946,7 @@ implementation
 
 
     { reads a type definition and returns a pointer to it }
-    procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean;hadtypetoken:boolean);
+    procedure read_named_type(var def:tdef;const newsym:tsym;genericdef:tstoreddef;genericlist:tfphashobjectlist;parseprocvardir:boolean;hadtypetoken:boolean);
       var
         pt : tnode;
         tt2 : tdef;
@@ -1051,7 +1090,7 @@ implementation
                          begin
                            def:=current_genericdef
                          end
-                       else if (df_generic in def.defoptions) and
+                       else if tstoreddef(def).is_generic and
                            { TODO : check once nested generics are allowed }
                            not
                              (
@@ -1146,7 +1185,7 @@ implementation
         end;
 
 
-      procedure array_dec(is_packed:boolean;genericdef:tstoreddef;genericlist:TFPObjectList);
+      procedure array_dec(is_packed:boolean;genericdef:tstoreddef;genericlist:tfphashobjectlist);
         var
           lowval,
           highval   : TConstExprInt;
@@ -1353,7 +1392,7 @@ implementation
         end;
 
 
-        function procvar_dec(genericdef:tstoreddef;genericlist:TFPObjectList):tdef;
+        function procvar_dec(genericdef:tstoreddef;genericlist:tfphashobjectlist):tdef;
           var
             is_func:boolean;
             pd:tabstractprocdef;
@@ -1603,7 +1642,7 @@ implementation
                     def:=object_dec(odt_helper,name,newsym,genericdef,genericlist,nil,ht_record);
                   end
                 else
-                  def:=record_dec(name,genericdef,genericlist);
+                  def:=record_dec(name,newsym,genericdef,genericlist);
               end;
             _PACKED,
             _BITPACKED:
@@ -1639,7 +1678,7 @@ implementation
                         end;
                       else begin
                         consume(_RECORD);
-                        def:=record_dec(name,genericdef,genericlist);
+                        def:=record_dec(name,newsym,genericdef,genericlist);
                       end;
                     end;
                     current_settings.packrecords:=oldpackrecords;

compiler/symdef.pas

@@ -68,7 +68,6 @@ interface
           procedure writeentry(ppufile: tcompilerppufile; ibnr: byte);
        protected
           typesymderef  : tderef;
-          procedure fillgenericparas(symtable:tsymtable);
           procedure ppuwrite_platform(ppufile:tcompilerppufile);virtual;
           procedure ppuload_platform(ppufile:tcompilerppufile);virtual;
        public
@@ -83,6 +82,7 @@ interface
             generic parameters; the symbols are not owned by this list
             Note: this list is allocated on demand! }
           genericparas    : tfphashobjectlist;
+          genericparaderefs : tfplist;
           { contains additional data if this def is a generic constraint
             Note: this class is allocated on demand! }
           genconstraintdata : tgenericconstraintdata;
@@ -1616,28 +1616,6 @@ implementation
       end;
 
 
-    procedure tstoreddef.fillgenericparas(symtable: tsymtable);
-      var
-        sym : tsym;
-        i : longint;
-      begin
-        if not assigned(symtable) then
-          internalerror(2012091201);
-        if [df_generic,df_specialization]*defoptions=[] then
-          exit;
-        for i:=0 to symtable.symlist.count-1 do
-          begin
-            sym:=tsym(symtable.symlist[i]);
-            if sp_generic_para in sym.symoptions then
-              begin
-                if not assigned(genericparas) then
-                  genericparas:=tfphashobjectlist.create(false);
-                genericparas.Add(sym.name,sym);
-              end;
-          end;
-      end;
-
-
     procedure tstoreddef.ppuwrite_platform(ppufile: tcompilerppufile);
       begin
         { by default: do nothing }
@@ -1687,6 +1665,8 @@ implementation
 
 
     destructor tstoreddef.destroy;
+      var
+        i : longint;
       begin
         { Direct calls are not allowed, use symtable.deletedef() }
         if assigned(owner) then
@@ -1697,6 +1677,10 @@ implementation
             generictokenbuf:=nil;
           end;
         genericparas.free;
+        if assigned(genericparaderefs) then
+          for i:=0 to genericparaderefs.count-1 do
+            dispose(pderef(genericparaderefs[i]));
+        genericparaderefs.free;
         genconstraintdata.free;
         stringdispose(_fullownerhierarchyname);
         inherited destroy;
@@ -1705,8 +1689,9 @@ implementation
 
     constructor tstoreddef.ppuload(dt:tdeftyp;ppufile:tcompilerppufile);
       var
-        sizeleft,i : longint;
+        sizeleft,i,cnt : longint;
         buf  : array[0..255] of byte;
+        symderef : pderef;
       begin
          inherited create(dt);
          DefId:=ppufile.getlongint;
@@ -1723,6 +1708,22 @@ implementation
              genconstraintdata:=tgenericconstraintdata.create;
              genconstraintdata.ppuload(ppufile);
            end;
+         if [df_generic,df_specialization]*defoptions<>[] then
+           begin
+             cnt:=ppufile.getlongint;
+             if cnt>0 then
+               begin
+                 genericparas:=tfphashobjectlist.create(false);
+                 genericparaderefs:=tfplist.create;
+                 for i:=0 to cnt-1 do
+                   begin
+                     genericparas.add(ppufile.getstring,nil);
+                     New(symderef);
+                     ppufile.getderef(symderef^);
+                     genericparaderefs.add(symderef);
+                   end;
+               end;
+           end;
          if df_generic in defoptions then
            begin
              sizeleft:=ppufile.getlongint;
@@ -1851,6 +1852,22 @@ implementation
         ppufile.putsmallset(defstates);
         if df_genconstraint in defoptions then
           genconstraintdata.ppuwrite(ppufile);
+        if [df_generic,df_specialization]*defoptions<>[] then
+          begin
+            if not assigned(genericparas) then
+              ppufile.putlongint(0)
+            else
+              begin
+                if not assigned(genericparaderefs) then
+                  internalerror(2014052305);
+                ppufile.putlongint(genericparas.count);
+                for i:=0 to genericparas.count-1 do
+                  begin
+                    ppufile.putstring(genericparas.nameofindex(i));
+                    ppufile.putderef(pderef(genericparaderefs[i])^);
+                  end;
+              end;
+          end;
         if df_generic in defoptions then
           begin
             if assigned(generictokenbuf) then
@@ -1879,11 +1896,27 @@ implementation
 
 
     procedure tstoreddef.buildderef;
+      var
+        i : longint;
+        sym : tsym;
+        symderef : pderef;
       begin
         typesymderef.build(typesym);
         genericdefderef.build(genericdef);
         if assigned(genconstraintdata) then
           genconstraintdata.buildderef;
+        if assigned(genericparas) then
+          begin
+            if not assigned(genericparaderefs) then
+              genericparaderefs:=tfplist.create;
+            for i:=0 to genericparas.count-1 do
+              begin
+                sym:=tsym(genericparas.items[i]);
+                new(symderef);
+                symderef^.build(sym);
+                genericparaderefs.add(symderef);
+              end;
+          end;
       end;
 
 
@@ -1893,12 +1926,30 @@ implementation
 
 
     procedure tstoreddef.deref;
+      var
+        symderef : pderef;
+        i : longint;
       begin
         typesym:=ttypesym(typesymderef.resolve);
         if df_specialization in defoptions then
           genericdef:=tstoreddef(genericdefderef.resolve);
         if assigned(genconstraintdata) then
           genconstraintdata.deref;
+        if assigned(genericparas) then
+          begin
+            if not assigned(genericparaderefs) then
+              internalerror(2014052302);
+            if genericparas.count<>genericparaderefs.count then
+              internalerror(2014052303);
+            for i:=0 to genericparaderefs.count-1 do
+              begin
+                symderef:=pderef(genericparaderefs[i]);
+                genericparas.items[i]:=symderef^.resolve;
+                dispose(symderef);
+              end;
+            genericparaderefs.free;
+            genericparaderefs:=nil;
+          end;
       end;
 
 
@@ -2013,18 +2064,49 @@ implementation
 
 
    function tstoreddef.is_generic: boolean;
+     var
+       sym: tsym;
+       i: longint;
      begin
        result:=assigned(genericparas) and
                  (genericparas.count>0) and
                  (df_generic in defoptions);
+       if result then
+         { if any of the type parameters does *not* belong to as (meaning it was passed
+           in from outside) then we aren't a generic, but a specialization }
+         for i:=0 to genericparas.count-1 do
+           begin
+             sym:=tsym(genericparas[i]);
+             if sym.typ<>symconst.typesym then
+               internalerror(2014050903);
+             if sym.owner.defowner<>self then
+               exit(false);
+           end;
      end;
 
 
    function tstoreddef.is_specialization: boolean;
+     var
+       i : longint;
+       sym : tsym;
      begin
        result:=assigned(genericparas) and
                  (genericparas.count>0) and
                  (df_specialization in defoptions);
+       if result then
+         begin
+           { if at least one of the generic parameters is not owned by us (meaning it was
+             passed in from outside) then we have a specialization, otherwise we have a generic }
+           for i:=0 to genericparas.count-1 do
+             begin
+               sym:=tsym(genericparas[i]);
+               if sym.typ<>symconst.typesym then
+                 internalerror(2014050904);
+               if sym.owner.defowner=self then
+                 exit(true);
+             end;
+           result:=false;
+         end;
      end;
 
 
@@ -3350,7 +3432,6 @@ implementation
         tarraysymtable(symtable).deref;
         _elementdef:=tdef(_elementdefderef.resolve);
         rangedef:=tdef(rangedefderef.resolve);
-        fillgenericparas(symtable);
       end;
 
 
@@ -3932,8 +4013,6 @@ implementation
          else
            tstoredsymtable(symtable).deref;
 
-         fillgenericparas(symtable);
-
          { assign TGUID? load only from system unit }
          if not(assigned(rec_tguid)) and
             (upper(typename)='TGUID') and
@@ -4159,7 +4238,6 @@ implementation
          tparasymtable(parast).deref;
          { recalculated parameters }
          calcparas;
-         fillgenericparas(parast);
       end;
 
 
@@ -6022,7 +6100,6 @@ implementation
            end
          else
            tstoredsymtable(symtable).deref;
-         fillgenericparas(symtable);
          if objecttype=odt_helper then
            extendeddef:=tdef(extendeddefderef.resolve);
          for i:=0 to vmtentries.count-1 do

tests/tbf/tb0240.pp

@@ -0,0 +1,12 @@
+{ %FAIL }
+
+program tb240;
+
+type
+  TTest = record
+    f: TTest;
+  end;
+
+begin
+
+end.

tests/tbf/tb0241.pp

@@ -0,0 +1,12 @@
+{ %FAIL }
+
+program tb241;
+
+type
+  TTest = record
+    f: array[0..1] of TTest;
+  end;
+
+begin
+
+end.

tests/tbf/tb0242.pp

@@ -0,0 +1,12 @@
+{ %FAIL }
+
+program tb242;
+
+type
+  TTest = record
+    f: array[0..1] of array[0..1] of TTest;
+  end;
+
+begin
+
+end.

tests/tbf/tb0243.pp

@@ -0,0 +1,14 @@
+{ %FAIL }
+
+program tb243;
+
+type
+  TTest = record
+    f: record
+      f: TTest;
+    end;
+  end;
+
+begin
+
+end.

tests/tbf/tb0244.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tb244;
+
+{$modeswitch advancedrecords}
+
+type
+  TTest = record
+  type
+    TTestSub = record
+      f: TTest;
+    end;
+  end;
+
+begin
+
+end.

tests/tbf/tb0245.pp

@@ -0,0 +1,17 @@
+{ %FAIL }
+
+program tb245;
+
+{$modeswitch advancedrecords}
+
+type
+  TTest = record
+  type
+    TTestSub = record
+      f: array[0..1] of TTest;
+    end;
+  end;
+
+begin
+
+end.

tests/tbf/tb0246.pp

@@ -0,0 +1,20 @@
+{ %FAIL }
+
+program tb246;
+
+{$modeswitch advancedrecords}
+
+type
+  TTest = record
+  type
+    TTestSub = record
+    type 
+      TTestSub2 = record
+        f: TTest;
+      end;
+    end;
+  end;
+
+begin
+
+end.