Browse Source

* Fix bug ID #31559: methods of generic classes

git-svn-id: trunk@35616 -
michael 8 years ago
parent
commit
90f3ec2e3b
2 changed files with 41 additions and 2 deletions
  1. 20 2
      packages/fcl-passrc/src/pparser.pp
  2. 21 0
      packages/fcl-passrc/tests/tcgenerics.pp

+ 20 - 2
packages/fcl-passrc/src/pparser.pp

@@ -4552,15 +4552,33 @@ end;
 function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType: TProcType;AVisibility : TPasMemberVisibility = VisDefault): TPasProcedure;
 function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType: TProcType;AVisibility : TPasMemberVisibility = VisDefault): TPasProcedure;
 
 
   function ExpectProcName: string;
   function ExpectProcName: string;
+
+  Var
+    L : TFPList;
+    I : Integer;
+
   begin
   begin
     Result:=ExpectIdentifier;
     Result:=ExpectIdentifier;
     //writeln('ExpectProcName ',Parent.Classname);
     //writeln('ExpectProcName ',Parent.Classname);
     if Parent is TImplementationSection then
     if Parent is TImplementationSection then
     begin
     begin
       NextToken;
       NextToken;
-      While CurToken=tkDot do
+      While CurToken in [tkDot,tkLessThan] do
         begin
         begin
-        Result:=Result+'.'+ExpectIdentifier;
+        if CurToken=tkDot then
+          Result:=Result+'.'+ExpectIdentifier
+        else
+          begin // <> can be ignored, we read the list but discard its content
+          UnGetToken;
+          L:=TFPList.Create;
+          Try
+            ReadGenericArguments(L,Parent);
+          finally
+            For I:=0 to L.Count-1 do
+              TPasElement(L[i]).Release;
+            L.Free;
+          end;
+          end;
         NextToken;
         NextToken;
         end;
         end;
       UngetToken;
       UngetToken;

+ 21 - 0
packages/fcl-passrc/tests/tcgenerics.pp

@@ -17,6 +17,7 @@ Type
     Procedure TestSpecializationDelphi;
     Procedure TestSpecializationDelphi;
     Procedure TestDeclarationDelphi;
     Procedure TestDeclarationDelphi;
     Procedure TestDeclarationDelphiSpecialize;
     Procedure TestDeclarationDelphiSpecialize;
+    Procedure TestMethodImplementation;
   end;
   end;
 
 
 implementation
 implementation
@@ -71,6 +72,7 @@ begin
   AssertEquals('have generic definition',1,Declarations.Classes.Count);
   AssertEquals('have generic definition',1,Declarations.Classes.Count);
   AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
   AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
   T:=TPasClassType(Declarations.Classes[0]);
   T:=TPasClassType(Declarations.Classes[0]);
+  AssertEquals('Name is correct','TSomeClass',T.Name);
   AssertNotNull('have generic templates',T.GenericTemplateTypes);
   AssertNotNull('have generic templates',T.GenericTemplateTypes);
   AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
   AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
   AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
   AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
@@ -78,6 +80,25 @@ begin
 
 
 end;
 end;
 
 
+procedure TTestGenerics.TestMethodImplementation;
+begin
+  With source do
+    begin
+    Add('unit afile;');
+    Add('{$MODE DELPHI}');
+    Add('interface');
+    Add('type');
+    Add('  TTest<T> =  object');
+    Add('    procedure foo(v:T);');
+    Add('  end;');
+    Add('implementation');
+    Add('procedure TTest<T>.foo;');
+    Add('begin');
+    Add('end;');
+    end;
+  ParseModule;
+end;
+
 initialization
 initialization
   RegisterTest(TTestGenerics);
   RegisterTest(TTestGenerics);
 end.
 end.