compiler: implement generics for records based on generic objects implementation + 1 test

git-svn-id: trunk@16670 -

.gitattributes

@@ -9412,6 +9412,7 @@ tests/test/tgeneric20.pp svneol=native#text/pascal
 tests/test/tgeneric21.pp svneol=native#text/pascal
 tests/test/tgeneric22.pp svneol=native#text/pascal
 tests/test/tgeneric23.pp svneol=native#text/pascal
+tests/test/tgeneric24.pp svneol=native#text/pascal
 tests/test/tgeneric3.pp svneol=native#text/plain
 tests/test/tgeneric4.pp svneol=native#text/plain
 tests/test/tgeneric5.pp svneol=native#text/plain

compiler/pdecobj.pas

@@ -37,6 +37,7 @@ interface
     function constructor_head:tprocdef;
     function destructor_head:tprocdef;
     procedure struct_property_dec(is_classproperty:boolean);
+    procedure insert_generic_parameter_types(genericdef:tstoreddef;genericlist:TFPObjectList);
 
 implementation
 
@@ -591,7 +592,7 @@ implementation
         pd : tprocdef;
         has_destructor,
         oldparse_only,
-        old_parse_generic : boolean;
+        old_parse_generic: boolean;
         object_member_blocktype : tblock_type;
         fields_allowed, is_classdef, classfields: boolean;
         vdoptions: tvar_dec_options;

compiler/pdecsub.pas

@@ -1152,9 +1152,9 @@ implementation
                 old_current_specializedef:=current_specializedef;
                 current_structdef:=pd.struct;
                 if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
-                  current_genericdef:=tobjectdef(current_structdef);
+                  current_genericdef:=current_structdef;
                 if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
-                  current_specializedef:=tobjectdef(current_structdef);
+                  current_specializedef:=current_structdef;
               end;
             { Add parameter symtable }
             if pd.parast.symtabletype<>staticsymtable then
@@ -1207,9 +1207,9 @@ implementation
                 old_current_specializedef:=current_specializedef;
                 current_structdef:=pd.struct;
                 if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
-                  current_genericdef:=tobjectdef(current_structdef);
+                  current_genericdef:=current_structdef;
                 if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
-                  current_specializedef:=tobjectdef(current_structdef);
+                  current_specializedef:=current_structdef;
               end;
             single_type(pd.returndef,false,false);
 

compiler/psub.pas

@@ -1401,9 +1401,9 @@ implementation
          current_procinfo:=self;
          current_structdef:=procdef.struct;
          if assigned(current_structdef) and (df_generic in current_structdef.defoptions) then
-           current_genericdef:=tobjectdef(current_structdef);
+           current_genericdef:=current_structdef;
          if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
-           current_specializedef:=tobjectdef(current_structdef);
+           current_specializedef:=current_structdef;
 
          { calculate the lexical level }
          if procdef.parast.symtablelevel>maxnesting then

compiler/ptype.pas

@@ -835,12 +835,21 @@ implementation
       end;
 
     { reads a record declaration }
-    function record_dec(const n:tidstring):tdef;
+    function record_dec(const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList):tdef;
       var
-         old_current_structdef : tabstractrecorddef;
+         old_current_structdef,
-         recst : trecordsymtable;
+         old_current_genericdef,
+         old_current_specializedef: tabstractrecorddef;
+         old_parse_generic: boolean;
+         recst: trecordsymtable;
       begin
          old_current_structdef:=current_structdef;
+         old_current_genericdef:=current_genericdef;
+         old_current_specializedef:=current_specializedef;
+         old_parse_generic:=parse_generic;
+
+         current_genericdef:=nil;
+         current_specializedef:=nil;
          { create recdef }
          recst:=trecordsymtable.create(n,current_settings.packrecords);
          current_structdef:=trecorddef.create(n,recst);
@@ -849,6 +858,16 @@ implementation
          symtablestack.push(recst);
          { parse record }
          consume(_RECORD);
+
+         { usage of specialized type inside its generic template }
+         if assigned(genericdef) then
+           current_specializedef:=current_structdef
+         { reject declaration of generic class inside generic class }
+         else if assigned(genericlist) then
+           current_genericdef:=current_structdef;
+
+         insert_generic_parameter_types(genericdef,genericlist);
+         parse_generic:=(df_generic in current_structdef.defoptions);
          if m_advanced_records in current_settings.modeswitches then
            parse_record_members
          else
@@ -862,7 +881,11 @@ implementation
          symtablestack.pop(recst);
          if trecorddef(current_structdef).is_packed and is_managed_type(current_structdef) then
            Message(type_e_no_packed_inittable);
+         { restore old state }
+         parse_generic:=old_parse_generic;
          current_structdef:=old_current_structdef;
+         current_genericdef:=old_current_genericdef;
+         current_specializedef:=old_current_specializedef;
       end;
 
 
@@ -1279,7 +1302,7 @@ implementation
               end;
             _RECORD:
               begin
-                def:=record_dec(name);
+                def:=record_dec(name,genericdef,genericlist);
               end;
             _PACKED,
             _BITPACKED:
@@ -1314,7 +1337,7 @@ implementation
                           def:=object_dec(odt_object,name,genericdef,genericlist,nil);
                         end;
                       else
-                        def:=record_dec(name);
+                        def:=record_dec(name,genericdef,genericlist);
                     end;
                     current_settings.packrecords:=oldpackrecords;
                   end;

tests/test/tgeneric24.pp

@@ -0,0 +1,19 @@
+program project1;
+
+{$mode objfpc}{$H+}
+{$apptype console}
+
+type
+  generic TFoo<T> = record
+    F: T;
+  end;
+var
+  FooInt: specialize TFoo<Integer>;
+  FooStr: specialize TFoo<String>;
+begin
+  FooInt.F := 1;
+  WriteLn(FooInt.F);
+  FooStr.F := 'test';
+  WriteLn(FooStr.F);
+end.
+