paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 18:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix bug #31483

Browse Source 
git-svn-id: trunk@35612 -
This commit is contained in:
michael 2017-03-17 18:30:12 +00:00
parent 5bbf299c22
commit 4f24dfb71a
3 changed files with 102 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -612,6 +612,7 @@ type
Modifiers: TStringList;
Interfaces : TFPList; // list of TPasElement
GenericTemplateTypes: TFPList; // list of TPasGenericTemplateType
Procedure SetGenericTemplates(AList : TFPList);
Function FindMember(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
Function FindMemberInAncestors(MemberClass : TPTreeElement; Const MemberName : String) : TPasElement;
Function IsPacked : Boolean;
@ -2333,6 +2334,21 @@ begin
ForEachChildCall(aMethodCall,Arg,TPasElement(GenericTemplateTypes[i]),false);
end;
procedure TPasClassType.SetGenericTemplates(AList: TFPList);
Var
I : Integer;
begin
ObjKind:=okGeneric;
For I:=0 to AList.Count-1 do
begin
TPasElement(AList[i]).Parent:=Self;
GenericTemplateTypes.Add(AList[i]);
end;
ObjKind:=okGeneric;
end;
function TPasClassType.FindMember(MemberClass: TPTreeElement; const MemberName: String): TPasElement;
Var

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

@ -331,7 +331,7 @@ type
// Type declarations
function ParseComplexType(Parent : TPasElement = Nil): TPasType;
function ParseTypeDecl(Parent: TPasElement): TPasType;
function ParseType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName : String = ''; Full : Boolean = False): TPasType;
function ParseType(Parent: TPasElement; const NamePos: TPasSourcePos; const TypeName: String = ''; Full: Boolean = false; GenericArgs: TFPList = nil): TPasType;
function ParseProcedureType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; const PT: TProcType): TPasProcedureType;
function ParseStringType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String): TPasAliasType;
function ParseSimpleType(Parent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; IsFull : Boolean = False): TPasType;
@ -343,7 +343,7 @@ type
function ParseEnumType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName: String): TPasEnumType;
function ParseSetType(Parent: TPasElement; Const NamePos: TPasSourcePos; const TypeName: String; AIsPacked : Boolean = False): TPasSetType;
function ParseSpecializeType(Parent: TPasElement; Const TypeName: String): TPasClassType;
Function ParseClassDecl(Parent: TPasElement; Const NamePos: TPasSourcePos; Const AClassName: String; AObjKind: TPasObjKind; PackMode : TPackMode= pmNone): TPasType;
Function ParseClassDecl(Parent: TPasElement; Const NamePos: TPasSourcePos; Const AClassName: String; AObjKind: TPasObjKind; PackMode : TPackMode= pmNone; GenericArgs: TFPList = nil): TPasType;
Function ParseProperty(Parent : TPasElement; Const AName : String; AVisibility : TPasMemberVisibility; IsClassField: boolean) : TPasProperty;
function ParseRangeType(AParent: TPasElement; Const NamePos: TPasSourcePos; Const TypeName: String; Full: Boolean = True): TPasRangeType;
procedure ParseExportDecl(Parent: TPasElement; List: TFPList);
@ -1259,7 +1259,7 @@ begin
end;
function TPasParser.ParseType(Parent: TPasElement;
const NamePos: TPasSourcePos; const TypeName: String; Full: Boolean
const NamePos: TPasSourcePos; const TypeName: String = ''; Full: Boolean = false; GenericArgs : TFPList = Nil
): TPasType;
Const
@ -1292,7 +1292,7 @@ begin
tkInterface:
Result := ParseClassDecl(Parent, NamePos, TypeName, okInterface);
tkSpecialize: Result:=ParseSpecializeType(Parent,TypeName);
tkClass: Result := ParseClassDecl(Parent, NamePos, TypeName, okClass, PM);
tkClass: Result := ParseClassDecl(Parent, NamePos, TypeName, okClass, PM, GenericArgs);
tkType:
begin
NextToken;
@ -2624,12 +2624,7 @@ begin
begin
ClassEl := TPasClassType(CreateElement(TPasClassType,
TypeName, Declarations, NamePos));
ClassEl.ObjKind:=okGeneric;
For I:=0 to List.Count-1 do
begin
TPasElement(List[i]).Parent:=ClassEl;
ClassEl.GenericTemplateTypes.Add(List[i]);
end;
ClassEl.SetGenericTemplates(List);
NextToken;
DoParseClassType(ClassEl);
Declarations.Declarations.Add(ClassEl);
@ -2968,16 +2963,25 @@ var
TypeName: String;
NamePos: TPasSourcePos;
OldForceCaret : Boolean;
List : TFPList;
begin
TypeName := CurTokenString;
NamePos:=Scanner.CurSourcePos;
ExpectToken(tkEqual);
List:=Nil;
OldForceCaret:=Scanner.SetForceCaret(True);
try
Result:=ParseType(Parent,NamePos,TypeName,True);
NextToken;
if (CurToken=tkLessThan) and (msDelphi in CurrentModeswitches) then
List:=TFPList.Create;
UnGetToken; // ReadGenericArguments starts at <
if Assigned(List) then
ReadGenericArguments(List,Parent);
ExpectToken(tkEqual);
Result:=ParseType(Parent,NamePos,TypeName,True,List);
finally
Scanner.SetForceCaret(OldForceCaret);
List.Free;
end;
end;
@ -5028,13 +5032,16 @@ begin
NextToken;
end;
end;
procedure TPasParser.DoParseClassType(AType: TPasClassType);
var
Element : TPasElement;
s: String;
CT : TPasClassType;
begin
ct:=Nil;
// nettism/new delphi features
if (CurToken=tkIdentifier) and (Atype.ObjKind in [okClass,okGeneric]) then
begin
@ -5050,11 +5057,28 @@ begin
if (CurToken=tkBraceOpen) then
begin
AType.AncestorType := ParseType(AType,Scanner.CurSourcePos);
NextToken;
if curToken=tkLessthan then
CT := TPasClassType(CreateElement(TPasClassType, AType.AncestorType.Name, AType.Parent, Scanner.CurSourcePos));
UnGetToken ;
if Assigned(CT) then
try
CT.ObjKind := okSpecialize;
CT.AncestorType := TPasUnresolvedTypeRef.Create(AType.AncestorType.Name,AType.Parent);
CT.IsShortDefinition:=True;
ReadGenericArguments(CT.GenericTemplateTypes,CT);
AType.AncestorType.Release;
AType.AncestorType:=CT;
CT:=Nil;
Finally
FreeAndNil(CT);
end;
while True do
begin
NextToken;
if CurToken = tkBraceClose then
break;
break ;
UngetToken;
ExpectToken(tkComma);
Element:=ParseType(AType,Scanner.CurSourcePos,'',False); // search interface.
@ -5090,7 +5114,7 @@ end;
function TPasParser.ParseClassDecl(Parent: TPasElement;
const NamePos: TPasSourcePos; const AClassName: String;
AObjKind: TPasObjKind; PackMode: TPackMode): TPasType;
AObjKind: TPasObjKind; PackMode: TPackMode; GenericArgs: TFPList): TPasType;
Var
ok: Boolean;
@ -5131,6 +5155,8 @@ begin
try
TPasClassType(Result).ObjKind := AObjKind;
TPasClassType(Result).PackMode:=PackMode;
if Assigned(GenericArgs) then
TPasClassType(Result).SetGenericTemplates(GenericArgs);
DoParseClassType(TPasClassType(Result));
Engine.FinishScope(stTypeDef,Result);
ok:=true;

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

@ -5,7 +5,7 @@ unit tcgenerics;
interface
uses
Classes, SysUtils, fpcunit, pastree, testregistry, tctypeparser;
Classes, SysUtils, fpcunit, pastree, testregistry, pscanner, pparser, tctypeparser;
Type
@ -15,6 +15,8 @@ Type
Published
Procedure TestObjectGenerics;
Procedure TestSpecializationDelphi;
Procedure TestDeclarationDelphi;
Procedure TestDeclarationDelphiSpecialize;
end;
implementation
@ -33,6 +35,49 @@ begin
ParseType('TFPGList<integer>',TPasClassType,'');
end;
procedure TTestGenerics.TestDeclarationDelphi;
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(' b2 : T2;');
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('2 template types',2,T.GenericTemplateTypes.Count);
AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
end;
procedure TTestGenerics.TestDeclarationDelphiSpecialize;
Var
T : TPasClassType;
begin
Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
Source.Add('Type');
Source.Add(' TSomeClass<T,T2> = Class(TSomeGeneric<Integer,Integer>)');
Source.Add(' b : T;');
Source.Add(' b2 : T2;');
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('2 template types',2,T.GenericTemplateTypes.Count);
AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
end;
initialization
RegisterTest(TTestGenerics);
end.