* patch by Aleksa Todorovic which adds the ability to reference current generic class. Each reference to current generic class is "translated" to appropriate specialization of that generic class. There are two tests as part of the patch to test that it works. The patch, also, rejects declaring generic inside another generic. 0010479 is easy to implement with this patch applied, resolves #11777

git-svn-id: trunk@16423 -

.gitattributes

@@ -9279,6 +9279,8 @@ tests/test/tgeneric18.pp svneol=native#text/pascal
 tests/test/tgeneric19.pp svneol=native#text/pascal
 tests/test/tgeneric2.pp svneol=native#text/plain
 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/tgeneric3.pp svneol=native#text/plain
 tests/test/tgeneric4.pp svneol=native#text/plain
 tests/test/tgeneric5.pp svneol=native#text/plain

compiler/fmodule.pas

@@ -579,6 +579,8 @@ implementation
               begin
                 current_procinfo:=nil;
                 current_objectdef:=nil;
+                current_genericdef:=nil;
+                current_specializedef:=nil;
               end;
             { release procinfo tree }
             while assigned(procinfo) do
@@ -659,6 +661,8 @@ implementation
               begin
                 current_procinfo:=nil;
                 current_objectdef:=nil;
+                current_genericdef:=nil;
+                current_specializedef:=nil;
               end;
             { release procinfo tree }
             while assigned(procinfo) do

compiler/msg/errore.msg

@@ -1336,6 +1336,11 @@ parser_e_no_procvarnested_const=03296_E_Typed constants of the type 'procedure i
 % procedural variable contains a reference to a nested procedure/function.
 % Therefore such typed constants can only be initialized with global
 % functions/procedures since these do not require a parent frame pointer.
+parser_f_no_generic_inside_generic=03297_F_Declaration of generic class inside another generic class is not allowed
+% At the moment, scanner supports recording of only one token buffer at the time
+% (guarded by internal error 200511173 in tscannerfile.startrecordtokens).
+% Since generics are implemented by recording tokens, it is not possible to
+% have declaration of generic class inside another generic class.
 % \end{description}
 #
 # Type Checking

compiler/msgidx.inc

@@ -385,6 +385,7 @@ const
   parser_e_objc_enumerator_2_0=03294;
   parser_e_objc_missing_enumeration_defs=03295;
   parser_e_no_procvarnested_const=03296;
+  parser_f_no_generic_inside_generic=03297;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -870,9 +871,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 57808;
+  MsgTxtSize = 57889;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,88,297,97,82,54,111,22,202,63,
+    24,88,298,97,82,54,111,22,202,63,
     49,20,1,1,1,1,1,1,1,1
   );

compiler/parser.pas

@@ -65,6 +65,8 @@ implementation
          current_asmdata:=nil;
          current_procinfo:=nil;
          current_objectdef:=nil;
+         current_genericdef:=nil;
+         current_specializedef:=nil;
 
          loaded_units:=TLinkedList.Create;
 
@@ -137,6 +139,8 @@ implementation
          current_procinfo:=nil;
          current_asmdata:=nil;
          current_objectdef:=nil;
+         current_genericdef:=nil;
+         current_specializedef:=nil;
 
          { unload units }
          if assigned(loaded_units) then

compiler/pdecl.pas

@@ -443,6 +443,9 @@ implementation
            { Generic type declaration? }
            if isgeneric then
              begin
+               if assigned(current_genericdef) then
+                 Message(parser_f_no_generic_inside_generic);
+
                consume(_LSHARPBRACKET);
                generictypelist:=parse_generic_parameters;
                consume(_RSHARPBRACKET);

compiler/pdecobj.pas

@@ -945,10 +945,16 @@ implementation
     function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tobjectdef;
       var
         old_current_objectdef : tobjectdef;
+        old_current_genericdef : tobjectdef;
+        old_current_specializedef : tobjectdef;
       begin
         old_current_objectdef:=current_objectdef;
+        old_current_genericdef:=current_genericdef;
+        old_current_specializedef:=current_specializedef;
 
         current_objectdef:=nil;
+        current_genericdef:=nil;
+        current_specializedef:=nil;
 
         { objects and class types can't be declared local }
         if not(symtablestack.top.symtabletype in [globalsymtable,staticsymtable,objectsymtable]) and
@@ -1002,6 +1008,13 @@ implementation
               end;
           end;
 
+        { usage of specialized type inside its generic template }
+        if assigned(genericdef) then
+          current_specializedef:=current_objectdef
+        { reject declaration of generic class inside generic class }
+        else if assigned(genericlist) then
+          current_genericdef:=current_objectdef;
+
         { set published flag in $M+ mode, it can also be inherited and will
           be added when the parent class set with tobjectdef.set_parent (PFV) }
         if (cs_generate_rtti in current_settings.localswitches) and
@@ -1068,6 +1081,8 @@ implementation
 
         { restore old state }
         current_objectdef:=old_current_objectdef;
+        current_genericdef:=old_current_genericdef;
+        current_specializedef:=old_current_specializedef;
       end;
 
 end.

compiler/pdecsub.pas

@@ -735,7 +735,9 @@ implementation
         popclass : boolean;
         ImplIntf : TImplementedInterface;
         old_parse_generic : boolean;
-        old_current_objectdef: tobjectdef;
+        old_current_objectdef,
+        old_current_genericdef,
+        old_current_specializedef : tobjectdef;
       begin
         { Save the position where this procedure really starts }
         procstartfilepos:=current_tokenpos;
@@ -1003,7 +1005,13 @@ implementation
               begin
                 symtablestack.push(pd._class.symtable);
                 old_current_objectdef:=current_objectdef;
+                old_current_genericdef:=current_genericdef;
+                old_current_specializedef:=current_specializedef;
                 current_objectdef:=pd._class;
+                if assigned(current_objectdef) and (df_generic in current_objectdef.defoptions) then
+                  current_genericdef:=current_objectdef;
+                if assigned(current_objectdef) and (df_specialization in current_objectdef.defoptions) then
+                  current_specializedef:=current_objectdef;
                 popclass:=true;
               end;
             { Add parameter symtable }
@@ -1015,6 +1023,8 @@ implementation
             if popclass then
             begin
               current_objectdef:=old_current_objectdef;
+              current_genericdef:=old_current_genericdef;
+              current_specializedef:=old_current_specializedef;
               symtablestack.pop(pd._class.symtable);
             end;
           end;
@@ -1030,7 +1040,9 @@ implementation
         locationstr: string;
         old_parse_generic,
         popclass: boolean;
-        old_current_objectdef: tobjectdef;
+        old_current_objectdef,
+        old_current_genericdef,
+        old_current_specializedef: tobjectdef;
       begin
         locationstr:='';
         pd:=nil;
@@ -1057,7 +1069,13 @@ implementation
                              popclass:=true;
                              parse_generic:=(df_generic in pd._class.defoptions);
                              old_current_objectdef:=current_objectdef;
+                             old_current_genericdef:=current_genericdef;
+                             old_current_specializedef:=current_specializedef;
                              current_objectdef:=pd._class;
+                             if assigned(current_objectdef) and (df_generic in current_objectdef.defoptions) then
+                               current_genericdef:=current_objectdef;
+                             if assigned(current_objectdef) and (df_specialization in current_objectdef.defoptions) then
+                               current_specializedef:=current_objectdef;
                            end;
                          single_type(pd.returndef,false,false);
 
@@ -1067,6 +1085,8 @@ implementation
                          if popclass then
                            begin
                              current_objectdef:=old_current_objectdef;
+                             current_genericdef:=old_current_genericdef;
+                             current_specializedef:=old_current_specializedef;
                              symtablestack.pop(pd._class.symtable);
                            end;
                          dec(testcurobject);

compiler/psub.pas

@@ -806,7 +806,9 @@ implementation
         old_current_procinfo : tprocinfo;
         oldmaxfpuregisters : longint;
         oldfilepos : tfileposinfo;
-        old_current_objectdef : tobjectdef;
+        old_current_objectdef,
+        old_current_genericdef,
+        old_current_specializedef : tobjectdef;
         templist : TAsmList;
         headertai : tai;
         i : integer;
@@ -1400,14 +1402,22 @@ implementation
          old_current_procinfo : tprocinfo;
          old_block_type : tblock_type;
          st : TSymtable;
-         old_current_objectdef : tobjectdef;
+         old_current_objectdef,
+         old_current_genericdef,
+         old_current_specializedef : tobjectdef;
       begin
          old_current_procinfo:=current_procinfo;
          old_block_type:=block_type;
          old_current_objectdef:=current_objectdef;
+         old_current_genericdef:=current_genericdef;
+         old_current_specializedef:=current_specializedef;
 
          current_procinfo:=self;
          current_objectdef:=procdef._class;
+         if assigned(current_objectdef) and (df_generic in current_objectdef.defoptions) then
+           current_genericdef:=current_objectdef;
+         if assigned(current_objectdef) and (df_specialization in current_objectdef.defoptions) then
+           current_specializedef:=current_objectdef;
 
          { calculate the lexical level }
          if procdef.parast.symtablelevel>maxnesting then
@@ -1514,6 +1524,8 @@ implementation
     {$endif state_tracking}
 
          current_objectdef:=old_current_objectdef;
+         current_genericdef:=old_current_genericdef;
+         current_specializedef:=old_current_specializedef;
          current_procinfo:=old_current_procinfo;
 
          { Restore old state }
@@ -1657,7 +1669,9 @@ implementation
 
       var
         old_current_procinfo : tprocinfo;
-        old_current_objectdef : tobjectdef;
+        old_current_objectdef,
+        old_current_genericdef,
+        old_current_specializedef : tobjectdef;
         pdflags    : tpdflags;
         pd,firstpd : tprocdef;
         s          : string;
@@ -1665,11 +1679,15 @@ implementation
          { save old state }
          old_current_procinfo:=current_procinfo;
          old_current_objectdef:=current_objectdef;
+         old_current_genericdef:=current_genericdef;
+         old_current_specializedef:=current_specializedef;
 
          { reset current_procinfo.procdef to nil to be sure that nothing is writing
            to another procdef }
          current_procinfo:=nil;
          current_objectdef:=nil;
+         current_genericdef:=nil;
+         current_specializedef:=nil;
 
          { parse procedure declaration }
          pd:=parse_proc_dec(isclassmethod, old_current_objectdef);
@@ -1798,6 +1816,8 @@ implementation
            end;
 
          current_objectdef:=old_current_objectdef;
+         current_genericdef:=old_current_genericdef;
+         current_specializedef:=old_current_specializedef;
          current_procinfo:=old_current_procinfo;
       end;
 

compiler/ptype.pas

@@ -492,7 +492,15 @@ implementation
           generate_specialization(def)
         else
           begin
-            if (df_generic in def.defoptions)  then
+            if assigned(current_specializedef) and (def=current_specializedef.genericdef) then
+              begin
+                def:=current_specializedef
+              end
+            else if (def=current_genericdef) then
+              begin
+                def:=current_genericdef
+              end
+            else if (df_generic in def.defoptions) then
               begin
                 Message(parser_e_no_generics_as_types);
                 def:=generrordef;
@@ -633,7 +641,15 @@ implementation
                      generate_specialization(def)
                    else
                      begin
-                       if (df_generic in def.defoptions)  then
+                       if assigned(current_specializedef) and (def=current_specializedef.genericdef) then
+                         begin
+                           def:=current_specializedef
+                         end
+                       else if (def=current_genericdef) then
+                         begin
+                           def:=current_genericdef
+                         end
+                       else if (df_generic in def.defoptions) then
                          begin
                            Message(parser_e_no_generics_as_types);
                            def:=generrordef;

compiler/symdef.pas

@@ -632,6 +632,8 @@ interface
 
     var
        current_objectdef : tobjectdef;  { used for private functions check !! }
+       current_genericdef : tobjectdef; { used to reject declaration of generic class inside generic class }
+       current_specializedef : tobjectdef; { used to implement usage of generic class in itself }
 
     { default types }
        generrordef,              { error in definition }

tests/test/tgeneric21.pp

@@ -0,0 +1,12 @@
+{ %fail }
+{$mode objfpc}{$H+}
+
+type
+  generic TOuter<T> = class(TObject)
+  public type
+    generic TInner<U> = class(TObject)
+    end;
+  end;
+
+begin
+end.

tests/test/tgeneric22.pp

@@ -0,0 +1,66 @@
+{$mode objfpc}{$H+}
+
+type
+  generic TGListItem<T> = class(TObject)
+  public var
+    FValue: T;
+    FNext: TGListItem;
+    procedure SetValue(Value: T);
+    function GetValue: T;
+    procedure Assign(Source: TGListItem);
+    function Merge(Other: TGListItem): TGListItem;
+  end;
+
+procedure TGListItem.SetValue(Value: T);
+begin
+  FValue := Value;
+end;
+
+function TGListItem.GetValue: T;
+begin
+  Result := FValue;
+end;
+
+procedure TGListItem.Assign(Source: TGListItem);
+begin
+  FNext := Source;
+end;
+
+function TGListItem.Merge(Other: TGListItem): TGListItem;
+var
+  Temp: TGListItem;
+begin
+  Temp := TGListItem.Create;
+  Temp.SetValue(FNext.GetValue + Other.FNext.GetValue);
+  Result := Temp;
+end;
+
+type
+  TIntListItem = specialize TGListItem<Integer>;
+
+var
+  A, A2, B, B2: TIntListItem;
+begin
+  A := TIntListItem.Create;
+  A2 := TIntListItem.Create;
+  A.Assign(A2);
+  if A.FNext <> A2 then
+    halt(1);
+
+  B := TIntListItem.Create;
+  B2 := TIntListItem.Create;
+  B.Assign(B2);
+  if B.FNext <> B2 then
+    halt(1);
+  
+  A2.SetValue(5);
+  if A2.GetValue <> 5 then
+    halt(1);
+  
+  B2.SetValue(7);
+  if B2.GetValue <> 7 then
+    halt(1);
+  
+  if A.Merge(B).GetValue <> 12 then
+    halt(1);
+end.