mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-04 04:57:23 +01:00
* Fix bug ID #31559: methods of generic classes
git-svn-id: trunk@35616 -
This commit is contained in:
parent
b517ab7906
commit
90f3ec2e3b
@ -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;
|
||||
|
||||
@ -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.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user