* Fix bug ID #31559: methods of generic classes

git-svn-id: trunk@35616 -
This commit is contained in:
michael 2017-03-18 08:53:06 +00:00
parent b517ab7906
commit 90f3ec2e3b
2 changed files with 41 additions and 2 deletions

View File

@ -4552,15 +4552,33 @@ end;
function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType: TProcType;AVisibility : TPasMemberVisibility = VisDefault): TPasProcedure;
function ExpectProcName: string;
Var
L : TFPList;
I : Integer;
begin
Result:=ExpectIdentifier;
//writeln('ExpectProcName ',Parent.Classname);
if Parent is TImplementationSection then
begin
NextToken;
While CurToken=tkDot do
While CurToken in [tkDot,tkLessThan] do
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;
end;
UngetToken;

View File

@ -17,6 +17,7 @@ Type
Procedure TestSpecializationDelphi;
Procedure TestDeclarationDelphi;
Procedure TestDeclarationDelphiSpecialize;
Procedure TestMethodImplementation;
end;
implementation
@ -71,6 +72,7 @@ begin
AssertEquals('have generic definition',1,Declarations.Classes.Count);
AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
T:=TPasClassType(Declarations.Classes[0]);
AssertEquals('Name is correct','TSomeClass',T.Name);
AssertNotNull('have generic templates',T.GenericTemplateTypes);
AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
@ -78,6 +80,25 @@ begin
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
RegisterTest(TTestGenerics);
end.