compiler: allow generic classes to derive from generic classes and generic interfaces

  - change id_type to single_type in readImplementedInterfacesAndProtocols to allow use of interface specializations inside class parent block
  - change single_type boolean arguments to set, add stoParseClassParent option to that set
  - move parse_generic variable assignment from parse_object_members to outer routine to setup it before parsing class parents
  - return paticular generic in generate_specialization instead of undefineddef to pass class/interface checks inside parent class block
  - add test for delphi mode
  - modify tw11431 to be syntatically correct

git-svn-id: trunk@16706 -

.gitattributes

@@ -9418,6 +9418,7 @@ tests/test/tgeneric25.pp svneol=native#text/pascal
 tests/test/tgeneric26.pp svneol=native#text/pascal
 tests/test/tgeneric27.pp svneol=native#text/pascal
 tests/test/tgeneric28.pp svneol=native#text/pascal
+tests/test/tgeneric29.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

@@ -306,7 +306,8 @@ implementation
       begin
         while try_to_consume(_COMMA) do
           begin
-             id_type(hdef,false);
+             { use single_type instead of id_type for specialize support }
+             single_type(hdef,[stoAllowTypeDef,stoParseClassParent]);
              if (hdef.typ<>objectdef) then
                begin
                   if intf then
@@ -442,7 +443,7 @@ implementation
           begin
             consume(_LKLAMMER);
             { use single_type instead of id_type for specialize support }
-            single_type(hdef,false,false);
+            single_type(hdef,[stoAllowTypeDef, stoParseClassParent]);
             if (not assigned(hdef)) or
                (hdef.typ<>objectdef) then
               begin
@@ -662,8 +663,7 @@ implementation
       var
         pd : tprocdef;
         has_destructor,
-        oldparse_only,
-        old_parse_generic: boolean;
+        oldparse_only: boolean;
         object_member_blocktype : tblock_type;
         fields_allowed, is_classdef, classfields: boolean;
         vdoptions: tvar_dec_options;
@@ -673,9 +673,6 @@ implementation
            (token=_SEMICOLON) then
           exit;
 
-        old_parse_generic:=parse_generic;
-
-        parse_generic:=(df_generic in current_structdef.defoptions);
         { in "publishable" classes the default access type is published }
         if (oo_can_have_published in current_structdef.objectoptions) then
           current_structdef.symtable.currentvisibility:=vis_published
@@ -1016,9 +1013,6 @@ implementation
               consume(_ID); { Give a ident expected message, like tp7 }
           end;
         until false;
-
-        { restore }
-        parse_generic:=old_parse_generic;
       end;
 
 
@@ -1027,10 +1021,12 @@ implementation
         old_current_structdef: tabstractrecorddef;
         old_current_genericdef,
         old_current_specializedef: tstoreddef;
+        old_parse_generic: boolean;
       begin
         old_current_structdef:=current_structdef;
         old_current_genericdef:=current_genericdef;
         old_current_specializedef:=current_specializedef;
+        old_parse_generic:=parse_generic;
 
         current_structdef:=nil;
         current_genericdef:=nil;
@@ -1129,14 +1125,16 @@ implementation
             if not(objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory]) then
               parse_object_options;
 
+            symtablestack.push(current_structdef.symtable);
+            insert_generic_parameter_types(current_structdef,genericdef,genericlist);
+            parse_generic:=(df_generic in current_structdef.defoptions);
+
             { parse list of parent classes }
             parse_parent_classes;
 
             { parse optional GUID for interfaces }
             parse_guid;
 
-            symtablestack.push(current_structdef.symtable);
-            insert_generic_parameter_types(current_structdef,genericdef,genericlist);
             { parse and insert object members }
             parse_object_members;
             symtablestack.pop(current_structdef.symtable);
@@ -1171,6 +1169,7 @@ implementation
         current_structdef:=old_current_structdef;
         current_genericdef:=old_current_genericdef;
         current_specializedef:=old_current_specializedef;
+        parse_generic:=old_parse_generic;
       end;
 
 end.

compiler/pdecsub.pas

@@ -593,7 +593,7 @@ implementation
               begin
                 block_type:=bt_var_type;
                 consume(_COLON);
-                single_type(pv.returndef,false,false);
+                single_type(pv.returndef,[]);
                 block_type:=bt_var;
               end;
              hdef:=pv;
@@ -641,7 +641,7 @@ implementation
                 else
                  begin
                    { define field type }
-                   single_type(arrayelementdef,false,false);
+                   single_type(arrayelementdef,[]);
                    tarraydef(hdef).elementdef:=arrayelementdef;
                  end;
               end
@@ -655,7 +655,7 @@ implementation
                 else
                   begin
                     block_type:=bt_var_type;
-                    single_type(hdef,false,false);
+                    single_type(hdef,[]);
                     block_type:=bt_var;
                   end;
 
@@ -1211,7 +1211,7 @@ implementation
                 if assigned(current_structdef) and (df_specialization in current_structdef.defoptions) then
                   current_specializedef:=current_structdef;
               end;
-            single_type(pd.returndef,false,false);
+            single_type(pd.returndef,[]);
 
             if is_dispinterface(pd.struct) and not is_automatable(pd.returndef) then
               Message1(type_e_not_automatable,pd.returndef.typename);

compiler/pdecvar.pas

@@ -384,11 +384,11 @@ implementation
                         { define range and type of range }
                         hdef:=tarraydef.create(0,-1,s32inttype);
                         { define field type }
-                        single_type(arraytype,false,false);
+                        single_type(arraytype,[]);
                         tarraydef(hdef).elementdef:=arraytype;
                       end
                     else
-                      single_type(hdef,false,false);
+                      single_type(hdef,[]);
                   end
                 else
                   hdef:=cformaltype;
@@ -417,7 +417,7 @@ implementation
          if (token=_COLON) or (paranr>0) or (astruct=nil) then
            begin
               consume(_COLON);
-              single_type(p.propdef,false,false);
+              single_type(p.propdef,[]);
 
               if is_dispinterface(astruct) and not is_automatable(p.propdef) then
                 Message1(type_e_not_automatable,p.propdef.typename);
@@ -728,7 +728,7 @@ implementation
          { Parse possible "implements" keyword }
          if not is_record(astruct) and try_to_consume(_IMPLEMENTS) then
            begin
-             single_type(def,false,false);
+             single_type(def,[]);
 
              if not(is_interface(def)) then
                message(parser_e_class_implements_must_be_interface);

compiler/ptype.pas

@@ -29,13 +29,17 @@ interface
        globtype,cclasses,
        symtype,symdef,symbase;
 
+    type
+      TSingleTypeOption=(stoIsForwardDef,stoAllowTypeDef,stoParseClassParent);
+      TSingleTypeOptions=set of TSingleTypeOption;
+
     procedure resolve_forward_types;
 
     { reads a type identifier }
     procedure id_type(var def : tdef;isforwarddef:boolean);
 
     { reads a string, file type or a type identifier }
-    procedure single_type(var def:tdef;isforwarddef,allowtypedef:boolean);
+    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 name : TIDString;genericdef:tstoreddef;genericlist:TFPObjectList;parseprocvardir:boolean);
@@ -136,7 +140,7 @@ implementation
       end;
 
 
-    procedure generate_specialization(var tt:tdef);
+    procedure generate_specialization(var tt:tdef;parse_class_parent:boolean);
       var
         st  : TSymtable;
         srsym : tsym;
@@ -177,6 +181,8 @@ implementation
               of generic and specialization might not be equally sized which
               is later assumed }
             tt:=tundefineddef.create;
+            if parse_class_parent then
+              tt:=genericdef;
             onlyparsepara:=true;
           end;
 
@@ -438,7 +444,7 @@ implementation
       end;
 
 
-    procedure single_type(var def:tdef;isforwarddef,allowtypedef:boolean);
+    procedure single_type(var def:tdef;options:TSingleTypeOptions);
        var
          t2 : tdef;
          dospecialize,
@@ -449,17 +455,17 @@ implementation
            again:=false;
              case token of
                _STRING:
-                 string_dec(def,allowtypedef);
+                 string_dec(def,stoAllowTypeDef in options);
 
                _FILE:
                  begin
                     consume(_FILE);
                     if (token=_OF) then
                       begin
-                         if not(allowtypedef) then
+                         if not(stoAllowTypeDef in options) then
                            Message(parser_e_no_local_para_def);
                          consume(_OF);
-                         single_type(t2,false,false);
+                         single_type(t2,[]);
                          if is_managed_type(t2) then
                            Message(parser_e_no_refcounted_typed_file);
                          def:=tfiledef.createtyped(t2);
@@ -472,7 +478,7 @@ implementation
                  begin
                    if try_to_consume(_SPECIALIZE) then
                      begin
-                       if not(allowtypedef) then
+                       if not(stoAllowTypeDef in options) then
                          begin
                            Message(parser_e_no_local_para_def);
 
@@ -489,7 +495,7 @@ implementation
                      end
                    else
                      begin
-                       id_type(def,isforwarddef);
+                       id_type(def,stoIsForwardDef in options);
                        { handle types inside classes, e.g. TNode.TLongint }
                        while (token=_POINT) do
                          begin
@@ -502,7 +508,7 @@ implementation
                               begin
                                 symtablestack.push(tabstractrecorddef(def).symtable);
                                 consume(_POINT);
-                                id_type(t2,isforwarddef);
+                                id_type(t2,stoIsForwardDef in options);
                                 symtablestack.pop(tabstractrecorddef(def).symtable);
                                 def:=t2;
                               end
@@ -519,8 +525,10 @@ implementation
                  end;
             end;
         until not again;
+        if (stoAllowTypeDef in options)and(m_delphi in current_settings.modeswitches) then
+          dospecialize:=token=_LSHARPBRACKET;
         if dospecialize then
-          generate_specialization(def)
+          generate_specialization(def,stoParseClassParent in options)
         else
           begin
             if assigned(current_specializedef) and (def=current_specializedef.genericdef) then
@@ -990,7 +998,7 @@ implementation
                    if (m_delphi in current_settings.modeswitches) then
                      dospecialize:=token=_LSHARPBRACKET;
                    if dospecialize then
-                     generate_specialization(def)
+                     generate_specialization(def,false)
                    else
                      begin
                        if assigned(current_specializedef) and (def=current_specializedef.genericdef) then
@@ -1236,7 +1244,8 @@ implementation
            current_genericdef:=old_current_genericdef;
            current_specializedef:=old_current_specializedef;
         end;
-
+      const
+        SingleTypeOptionsInTypeBlock:array[Boolean] of TSingleTypeOptions = ([],[stoIsForwardDef]);
       var
         p  : tnode;
         hdef : tdef;
@@ -1254,7 +1263,7 @@ implementation
          case token of
             _STRING,_FILE:
               begin
-                single_type(def,false,true);
+                single_type(def,[stoAllowTypeDef]);
               end;
            _LKLAMMER:
               begin
@@ -1362,7 +1371,7 @@ implementation
            _CARET:
               begin
                 consume(_CARET);
-                single_type(tt2,(block_type=bt_type),false);
+                single_type(tt2,SingleTypeOptionsInTypeBlock[block_type=bt_type]);
                 def:=tpointerdef.create(tt2);
                 if tt2.typ=forwarddef then
                   current_module.checkforwarddefs.add(def);
@@ -1383,7 +1392,7 @@ implementation
                 else if token=_SET then
                   set_dec
                 else if token=_FILE then
-                  single_type(def,false,true)
+                  single_type(def,[stoAllowTypeDef])
                 else
                   begin
                     oldpackrecords:=current_settings.packrecords;
@@ -1429,7 +1438,7 @@ implementation
                    ) then
                   begin
                     consume(_OF);
-                    single_type(hdef,(block_type=bt_type),false);
+                    single_type(hdef,SingleTypeOptionsInTypeBlock[block_type=bt_type]);
                     if is_class(hdef) or
                        is_objcclass(hdef) then
                       def:=tclassrefdef.create(hdef)
@@ -1502,7 +1511,7 @@ implementation
                 if is_func then
                  begin
                    consume(_COLON);
-                   single_type(pd.returndef,false,false);
+                   single_type(pd.returndef,[]);
                  end;
                 if try_to_consume(_OF) then
                   begin
@@ -1536,7 +1545,7 @@ implementation
               if (token=_KLAMMERAFFE) and (m_iso in current_settings.modeswitches) then
                 begin
                   consume(_KLAMMERAFFE);
-                  single_type(tt2,(block_type=bt_type),false);
+                  single_type(tt2,SingleTypeOptionsInTypeBlock[block_type=bt_type]);
                   def:=tpointerdef.create(tt2);
                   if tt2.typ=forwarddef then
                     current_module.checkforwarddefs.add(def);

tests/test/tgeneric29.pp

@@ -0,0 +1,39 @@
+program tgeneric29;
+
+{$mode delphi}
+
+type
+  IGenericInterface<T> = interface
+    function DoSomething(Arg: T): T;
+  end;
+
+  TGenericClass<T> = class(TInterfacedObject, IGenericInterface<T>)
+    F: T;
+    type
+      Intf = IGenericInterface<Integer>;
+    function DoSomething(Arg: T): T;
+    function Test(Arg: Intf): Intf;
+  end;
+
+  TGenericRecord<T> = record
+    F: T;
+  end;
+
+  TGenericArray<T> = array of T;
+
+function TGenericClass{<T>}.DoSomething(Arg: T): T;
+begin
+  Result := Arg;
+end;
+
+function TGenericClass{<T>}.Test(Arg: Intf): Intf;
+begin
+  Result := Arg;
+end;
+
+var
+  ClassSpecialize: TGenericClass<Integer>;
+  RecordSpecialize: TGenericRecord<Integer>;
+  ArraySpecialize: TGenericArray<Integer>;
+begin
+end.

tests/webtbs/tw11431.pp

@@ -10,7 +10,7 @@ type
   generic IGenericCollection<_T> = interface
   end;
 
-  generic CGenericCollection<_T> = class( IGenericCollection)
+  generic CGenericCollection<_T> = class(TInterfacedObject, specialize IGenericCollection<_T>)
   end;
 
 implementation