paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 13:29:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Parse type constraints in generics

Browse Source 
git-svn-id: trunk@40939 -
This commit is contained in:
michael 2019-01-20 16:45:31 +00:00
parent 94d7a02fae
commit 6e704b6a4f
3 changed files with 36 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
packages/fcl-passrc/src/pastree.pp
View File

@ -730,7 +730,10 @@ type
Function IsAdvancedRecord : Boolean; Function IsAdvancedRecord : Boolean;
end; end;
TPasGenericTemplateType = Class(TPasType); TPasGenericTemplateType = Class(TPasType)
Public
TypeConstraint : String;
end;
TPasObjKind = ( TPasObjKind = (
okObject, okClass, okInterface, okObject, okClass, okInterface,

13
packages/fcl-passrc/src/pparser.pp
View File

@ -3992,16 +3992,23 @@ procedure TPasParser.ReadGenericArguments(List: TFPList; Parent: TPasElement);
Var Var
N : String; N : String;
T : TPasGenericTemplateType;
begin begin
ExpectToken(tkLessThan); ExpectToken(tkLessThan);
repeat repeat
N:=ExpectIdentifier; N:=ExpectIdentifier;
List.Add(CreateElement(TPasGenericTemplateType,N,Parent)); T:=TPasGenericTemplateType(CreateElement(TPasGenericTemplateType,N,Parent));
List.Add(T);
NextToken; NextToken;
if not (CurToken in [tkComma, tkGreaterThan]) then if Curtoken = tkColon then
begin
T.TypeConstraint:=ExpectIdentifier;
NextToken;
end;
if not (CurToken in [tkComma,tkGreaterThan]) then
ParseExc(nParserExpectToken2Error,SParserExpectToken2Error, ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
[TokenInfos[tkComma], TokenInfos[tkGreaterThan]]); [TokenInfos[tkComma], TokenInfos[tkColon], TokenInfos[tkGreaterThan]]);
until CurToken = tkGreaterThan; until CurToken = tkGreaterThan;
end; end;

22
packages/fcl-passrc/tests/tcgenerics.pp
View File

@ -12,11 +12,13 @@ Type
{ TTestGenerics } { TTestGenerics }
TTestGenerics = Class(TBaseTestTypeParser) TTestGenerics = Class(TBaseTestTypeParser)
private
Published Published
Procedure TestObjectGenerics; Procedure TestObjectGenerics;
Procedure TestRecordGenerics; Procedure TestRecordGenerics;
Procedure TestArrayGenerics; Procedure TestArrayGenerics;
Procedure TestSpecializationDelphi; Procedure TestSpecializationDelphi;
procedure TestDeclarationConstraint;
Procedure TestDeclarationDelphi; Procedure TestDeclarationDelphi;
Procedure TestDeclarationDelphiSpecialize; Procedure TestDeclarationDelphiSpecialize;
Procedure TestMethodImplementation; Procedure TestMethodImplementation;
@ -84,6 +86,26 @@ begin
AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent); AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
end; end;
procedure TTestGenerics.TestDeclarationConstraint;
Var
T : TPasClassType;
begin
Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
Source.Add('Type');
Source.Add(' TSomeClass<T: T2> = Class(TObject)');
Source.Add(' b : T;');
Source.Add('end;');
ParseDeclarations;
AssertNotNull('have generic definition',Declarations.Classes);
AssertEquals('have generic definition',1,Declarations.Classes.Count);
AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
T:=TPasClassType(Declarations.Classes[0]);
AssertNotNull('have generic templates',T.GenericTemplateTypes);
AssertEquals('1 template types',1,T.GenericTemplateTypes.Count);
AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
AssertEquals('Type constraint is recorded','T2',TPasGenericTemplateType(T.GenericTemplateTypes[0]).TypeConstraint);
end;
procedure TTestGenerics.TestDeclarationDelphiSpecialize; procedure TTestGenerics.TestDeclarationDelphiSpecialize;
Var Var
T : TPasClassType; T : TPasClassType;