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

fcl-passrc: fixed parsing objfpc inline specialize

Browse Source 
git-svn-id: trunk@42251 -
This commit is contained in:
Mattias Gaertner 2019-06-20 08:47:04 +00:00
parent 6c1593652b
commit fb29815fbf
6 changed files with 290 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
packages/fcl-passrc/src/pasresolver.pp
View File

@ -1525,6 +1525,7 @@ type
procedure FinishClassOfType(El: TPasClassOfType); virtual;
procedure FinishPointerType(El: TPasPointerType); virtual;
procedure FinishArrayType(El: TPasArrayType); virtual;
procedure FinishGenericTemplateType(El: TPasGenericTemplateType); virtual;
procedure FinishResourcestring(El: TPasResString); virtual;
procedure FinishProcedure(aProc: TPasProcedure); virtual;
procedure FinishProcedureType(El: TPasProcedureType); virtual;
@ -5397,7 +5398,9 @@ begin
EmitTypeHints(El,TPasAliasType(El).DestType);
end
else if (C=TPasPointerType) then
EmitTypeHints(El,TPasPointerType(El).DestType);
EmitTypeHints(El,TPasPointerType(El).DestType)
else if C=TPasGenericTemplateType then
FinishGenericTemplateType(TPasGenericTemplateType(El));
end;
procedure TPasResolver.FinishEnumType(El: TPasEnumType);
@ -5801,6 +5804,24 @@ begin
end;
end;
procedure TPasResolver.FinishGenericTemplateType(El: TPasGenericTemplateType);
var
i: Integer;
Expr: TPasExpr;
Value: String;
begin
for i:=0 to length(El.Constraints)-1 do
begin
Expr:=El.Constraints[i];
if (Expr.ClassType=TPrimitiveExpr) and (TPrimitiveExpr(Expr).Kind=pekIdent) then
begin
Value:=TPrimitiveExpr(Expr).Value;
if SameText(Value,'class') then
; // ToDo
end;
end;
end;
procedure TPasResolver.FinishResourcestring(El: TPasResString);
var
ResolvedEl: TPasResolverResult;
@ -15852,6 +15873,7 @@ begin
// resolved when finished
else if AClass=TPasImplCommand then
else if AClass=TPasAttributes then
else if AClass=TPasGenericTemplateType then
else if AClass=TPasUnresolvedUnitRef then
RaiseMsg(20171018121900,nCantFindUnitX,sCantFindUnitX,[AName],El)
else

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

@ -58,6 +58,7 @@ resourcestring
SPasTreeClassType = 'class';
SPasTreeInterfaceType = 'interface';
SPasTreeSpecializedType = 'specialized class type';
SPasTreeSpecializedExpr = 'specialize expr';
SPasClassHelperType = 'class helper type';
SPasRecordHelperType = 'record helper type';
SPasTypeHelperType = 'type helper type';
@ -564,28 +565,27 @@ type
destructor Destroy; override;
function ElementTypeName: string; override;
function GetDeclaration(full: boolean) : string; override;
procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
const Arg: Pointer); override;
procedure AddParam(El: TPasElement);
public
Params: TFPList; // list of TPasType or TPasExpr
end;
{ TInlineTypeExpr - base class TInlineSpecializeExpr }
{ TInlineSpecializeExpr - A<B,C> }
TInlineTypeExpr = class(TPasExpr)
TInlineSpecializeExpr = class(TPasExpr)
public
constructor Create(const AName: string; AParent: TPasElement); override;
destructor Destroy; override;
function ElementTypeName: string; override;
function GetDeclaration(full : Boolean): string; override;
procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
const Arg: Pointer); override;
procedure ClearTypeReferences(aType: TPasElement); override;
procedure AddParam(El: TPasElement);
public
DestType: TPasType; // TPasSpecializeType
end;
{ TInlineSpecializeExpr - A<B,C> }
TInlineSpecializeExpr = class(TInlineTypeExpr)
NameExpr: TPasExpr; // TPrimitiveExpr
Params: TFPList; // list of TPasType or TPasExpr
end;
{ TPasRangeType }
@ -731,9 +731,18 @@ type
Function IsAdvancedRecord : Boolean;
end;
{ TPasGenericTemplateType }
TPasGenericTemplateType = Class(TPasType)
public
destructor Destroy; override;
function GetDeclaration(full : boolean) : string; override;
procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
const Arg: Pointer); override;
procedure AddConstraint(Expr: TPasExpr);
Public
TypeConstraint : String;
TypeConstraint: String deprecated; // deprecated in fpc 3.3.1
Constraints: TPasExprArray;
end;
TPasObjKind = (
@ -1753,6 +1762,54 @@ begin
end;
end;
{ TPasGenericTemplateType }
destructor TPasGenericTemplateType.Destroy;
var
i: Integer;
begin
for i:=0 to length(Constraints)-1 do
Constraints[i].Release;
Constraints:=nil;
inherited Destroy;
end;
function TPasGenericTemplateType.GetDeclaration(full: boolean): string;
var
i: Integer;
begin
Result:=inherited GetDeclaration(full);
if length(Constraints)>0 then
begin
Result:=Result+': ';
for i:=0 to length(Constraints)-1 do
begin
if i>0 then
Result:=Result+',';
Result:=Result+Constraints[i].GetDeclaration(false);
end;
end;
end;
procedure TPasGenericTemplateType.ForEachCall(
const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
var
i: Integer;
begin
inherited ForEachCall(aMethodCall, Arg);
for i:=0 to length(Constraints)-1 do
ForEachChildCall(aMethodCall,Arg,Constraints[i],false);
end;
procedure TPasGenericTemplateType.AddConstraint(Expr: TPasExpr);
var
l: Integer;
begin
l:=Length(Constraints);
SetLength(Constraints,l+1);
Constraints[l]:=Expr;
end;
{$IFDEF HasPTDumpStack}
procedure PTDumpStack;
begin
@ -1831,34 +1888,61 @@ begin
SemicolonAtEOL := true;
end;
{ TInlineTypeExpr }
{ TInlineSpecializeExpr }
destructor TInlineTypeExpr.Destroy;
constructor TInlineSpecializeExpr.Create(const AName: string;
AParent: TPasElement);
begin
ReleaseAndNil(TPasElement(DestType){$IFDEF CheckPasTreeRefCount},'TInlineTypeExpr.DestType'{$ENDIF});
if AName='' then ;
inherited Create(AParent, pekSpecialize, eopNone);
Params:=TFPList.Create;
end;
destructor TInlineSpecializeExpr.Destroy;
var
i: Integer;
begin
ReleaseAndNil(TPasElement(NameExpr));
for i:=0 to Params.Count-1 do
TPasElement(Params[i]).Release{$IFDEF CheckPasTreeRefCount}('TInlineSpecializeExpr.Params'){$ENDIF};
FreeAndNil(Params);
inherited Destroy;
end;
function TInlineTypeExpr.ElementTypeName: string;
function TInlineSpecializeExpr.ElementTypeName: string;
begin
Result := DestType.ElementTypeName;
Result:=SPasTreeSpecializedExpr;
end;
function TInlineTypeExpr.GetDeclaration(full: Boolean): string;
function TInlineSpecializeExpr.GetDeclaration(full: Boolean): string;
var
i: Integer;
begin
Result:=DestType.GetDeclaration(full);
Result:='specialize ';
Result:=Result+NameExpr.GetDeclaration(full);
Result:=Result+'<';
for i:=0 to Params.Count-1 do
begin
if i>0 then
Result:=Result+',';
Result:=Result+TPasElement(Params[i]).GetDeclaration(false);
end;
end;
procedure TInlineTypeExpr.ForEachCall(
procedure TInlineSpecializeExpr.ForEachCall(
const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
var
i: Integer;
begin
DestType.ForEachChildCall(aMethodCall,Arg,DestType,true);
inherited ForEachCall(aMethodCall, Arg);
ForEachChildCall(aMethodCall,Arg,NameExpr,false);
for i:=0 to Params.Count-1 do
ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true);
end;
procedure TInlineTypeExpr.ClearTypeReferences(aType: TPasElement);
procedure TInlineSpecializeExpr.AddParam(El: TPasElement);
begin
if DestType=aType then
ReleaseAndNil(TPasElement(DestType){$IFDEF CheckPasTreeRefCount},'TInlineTypeExpr.DestType'{$ENDIF});
Params.Add(El);
end;
{ TPasSpecializeType }
@ -1903,6 +1987,16 @@ begin
end;
end;
procedure TPasSpecializeType.ForEachCall(
const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
var
i: Integer;
begin
inherited ForEachCall(aMethodCall, Arg);
for i:=0 to Params.Count-1 do
ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true);
end;
procedure TPasSpecializeType.AddParam(El: TPasElement);
begin
Params.Add(El);

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

@ -72,7 +72,7 @@ const
nParserNotAProcToken = 2026;
nRangeExpressionExpected = 2027;
nParserExpectCase = 2028;
// free 2029;
nParserGenericFunctionNeedsGenericKeyword = 2029;
nLogStartImplementation = 2030;
nLogStartInterface = 2031;
nParserNoConstructorAllowed = 2032;
@ -132,7 +132,7 @@ resourcestring
SParserNotAProcToken = 'Not a procedure or function token';
SRangeExpressionExpected = 'Range expression expected';
SParserExpectCase = 'Case label expression expected';
// free for 2029
SParserGenericFunctionNeedsGenericKeyword = 'Generic function needs keyword generic';
SLogStartImplementation = 'Start parsing implementation section.';
SLogStartInterface = 'Start parsing interface section';
SParserNoConstructorAllowed = 'Constructors or Destructors are not allowed in Interfaces or Records';
@ -319,7 +319,7 @@ type
procedure ParseClassMembers(AType: TPasClassType);
procedure ProcessMethod(AType: TPasClassType; IsClass : Boolean; AVisibility : TPasMemberVisibility);
procedure ReadGenericArguments(List : TFPList;Parent : TPasElement);
procedure ReadSpecializeArguments(Spec: TPasSpecializeType);
procedure ReadSpecializeArguments(Spec: TPasElement);
function ReadDottedIdentifier(Parent: TPasElement; out Expr: TPasExpr; NeedAsString: boolean): String;
function CheckProcedureArgs(Parent: TPasElement;
Args: TFPList; // list of TPasArgument
@ -1587,7 +1587,7 @@ begin
Expr:=nil;
ST:=nil;
try
if not (msDelphi in CurrentModeswitches) and (CurToken=tkspecialize) then
if CurToken=tkspecialize then
begin
IsSpecialize:=true;
NextToken;
@ -1739,7 +1739,8 @@ begin
Result := ParseClassDecl(Parent, NamePos, TypeName, okDispInterface);
tkInterface:
Result := ParseClassDecl(Parent, NamePos, TypeName, okInterface);
tkSpecialize: Result:=ParseSpecializeType(Parent,TypeName);
tkSpecialize:
Result:=ParseSpecializeType(Parent,TypeName);
tkClass:
begin
isHelper:=false;
@ -2165,6 +2166,8 @@ begin
end;
function TPasParser.ParseExprOperand(AParent: TPasElement): TPasExpr;
type
TAllow = (aCannot, aCan, aMust);
Function IsWriteOrStr(P : TPasExpr) : boolean;
@ -2235,17 +2238,17 @@ var
Last, Func, Expr: TPasExpr;
Params: TParamsExpr;
Bin: TBinaryExpr;
ok, CanSpecialize: Boolean;
ok: Boolean;
CanSpecialize: TAllow;
aName: String;
ISE: TInlineSpecializeExpr;
ST: TPasSpecializeType;
SrcPos, ScrPos: TPasSourcePos;
ProcType: TProcType;
ProcExpr: TProcedureExpr;
begin
Result:=nil;
CanSpecialize:=false;
CanSpecialize:=aCannot;
aName:='';
case CurToken of
tkString: Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString);
@ -2253,13 +2256,20 @@ begin
tkNumber: Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
tkIdentifier:
begin
CanSpecialize:=true;
CanSpecialize:=aCan;
aName:=CurTokenText;
if (CompareText(aName,'self')=0) and not (tkself in Scanner.NonTokens) then
Last:=CreateSelfExpr(AParent)
else
Last:=CreatePrimitiveExpr(AParent,pekIdent,aName);
end;
tkspecialize:
begin
CanSpecialize:=aMust;
ExpectToken(tkIdentifier);
aName:=CurTokenText;
Last:=CreatePrimitiveExpr(AParent,pekIdent,aName);
end;
tkfalse, tktrue: Last:=CreateBoolConstExpr(AParent,pekBoolConst, CurToken=tktrue);
tknil: Last:=CreateNilExpr(AParent);
tkSquaredBraceOpen:
@ -2288,7 +2298,7 @@ begin
end;
tkself:
begin
CanSpecialize:=true;
CanSpecialize:=aCan;
aName:=CurTokenText;
Last:=CreateSelfExpr(AParent);
end;
@ -2350,6 +2360,13 @@ begin
begin
ScrPos:=CurTokenPos;
NextToken;
if CurToken=tkspecialize then
begin
if CanSpecialize=aMust then
CheckToken(tkLessThan);
CanSpecialize:=aMust;
NextToken;
end;
if CurToken in [tkIdentifier,tktrue,tkfalse,tkself] then // true and false are sub identifiers as well
begin
aName:=aName+'.'+CurTokenString;
@ -2374,34 +2391,32 @@ begin
Params.Value:=Result;
Result.Parent:=Params;
Result:=Params;
CanSpecialize:=false;
CanSpecialize:=aCannot;
Func:=nil;
end;
tkCaret:
begin
Result:=CreateUnaryExpr(AParent,Result,TokenToExprOp(CurToken));
NextToken;
CanSpecialize:=false;
CanSpecialize:=aCannot;
Func:=nil;
end;
tkLessThan:
begin
SrcPos:=CurTokenPos;
if (not CanSpecialize) or not IsSpecialize then
if CanSpecialize=aCannot then
break
else if (CanSpecialize=aCan) and not IsSpecialize then
break
else
begin
// an inline specialization (e.g. A<B,C>)
ISE:=TInlineSpecializeExpr(CreateElement(TInlineSpecializeExpr,'',AParent,SrcPos));
ISE.Kind:=pekSpecialize;
ST:=TPasSpecializeType(CreateElement(TPasSpecializeType,'',ISE,SrcPos));
ISE.DestType:=ST;
ReadSpecializeArguments(ST);
ST.DestType:=ResolveTypeReference(aName,ST);
ST.Expr:=Result;
ReadSpecializeArguments(ISE);
ISE.NameExpr:=Result;
Result:=ISE;
ISE:=nil;
CanSpecialize:=false;
CanSpecialize:=aCannot;
NextToken;
end;
Func:=nil;
@ -3585,6 +3600,9 @@ begin
Declarations.Declarations.Add(ArrEl);
Declarations.Types.Add(ArrEl);
CheckHint(ArrEl,True);
{$IFDEF VerbosePasResolver}
ParseExcTokenError('20190619145000');
{$ENDIF}
ArrEl.ElType.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
ArrEl.ElType:=TPasGenericTemplateType(List[0]);
List.Clear;
@ -4008,12 +4026,12 @@ begin
end;
end;
{$warn 5043 off}
procedure TPasParser.ReadGenericArguments(List: TFPList; Parent: TPasElement);
Var
N : String;
T : TPasGenericTemplateType;
Expr: TPasExpr;
begin
ExpectToken(tkLessThan);
repeat
@ -4022,17 +4040,46 @@ begin
List.Add(T);
NextToken;
if Curtoken = tkColon then
begin
T.TypeConstraint:=ExpectIdentifier;
NextToken;
end;
if not (CurToken in [tkComma,tkSemicolon,tkGreaterThan]) then
ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
[TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
until CurToken = tkGreaterThan;
repeat
NextToken;
// comma separated list: identifier, class, record, constructor
if CurToken in [tkclass,tkrecord,tkconstructor] then
begin
if T.TypeConstraint='' then
T.TypeConstraint:=CurTokenString;
Expr:=CreatePrimitiveExpr(T,pekIdent,CurTokenText);
NextToken;
end
else if CurToken=tkIdentifier then
begin
if T.TypeConstraint='' then
T.TypeConstraint:=ReadDottedIdentifier(T,Expr,true)
else
ReadDottedIdentifier(T,Expr,false);
end
else
CheckToken(tkIdentifier);
T.AddConstraint(Expr);
until CurToken<>tkComma;
Engine.FinishScope(stTypeDef,T);
until not (CurToken in [tkSemicolon,tkComma]);
if CurToken<>tkGreaterThan then
ParseExc(nParserExpectToken2Error,SParserExpectToken2Error,
[TokenInfos[tkComma], TokenInfos[tkGreaterThan]]);
end;
{$warn 5043 on}
procedure TPasParser.ReadSpecializeArguments(Spec: TPasSpecializeType);
procedure TPasParser.ReadSpecializeArguments(Spec: TPasElement);
procedure AddParam(El: TPasElement);
begin
if Spec is TPasSpecializeType then
TPasSpecializeType(Spec).AddParam(El)
else if Spec is TInlineSpecializeExpr then
TInlineSpecializeExpr(Spec).AddParam(El)
else
ParseExcTokenError('[20190619112611] '+Spec.ClassName);
end;
Var
Name : String;
@ -4042,6 +4089,7 @@ Var
Expr: TPasExpr;
begin
//writeln('START TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
CheckToken(tkLessThan);
NextToken;
Expr:=nil;
@ -4049,7 +4097,8 @@ begin
NestedSpec:=nil;
try
repeat
if not (msDelphi in CurrentModeswitches) and (CurToken=tkspecialize) then
//writeln('ARG TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
if CurToken=tkspecialize then
begin
IsNested:=true;
NextToken;
@ -4060,6 +4109,7 @@ begin
CheckToken(tkIdentifier);
Expr:=nil;
Name:=ReadDottedIdentifier(Spec,Expr,true);
//writeln('AFTER NAME TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
if CurToken=tkLessThan then
begin
@ -4075,18 +4125,19 @@ begin
// read nested specialize arguments
ReadSpecializeArguments(NestedSpec);
// add nested specialize
Spec.AddParam(NestedSpec);
AddParam(NestedSpec);
NestedSpec:=nil;
NextToken;
end
else if IsNested then
CheckToken(tkLessThan)
CheckToken(tkLessThan) // specialize keyword without <
else
begin
// simple type reference
Spec.AddParam(Expr);
AddParam(Expr);
Expr:=nil;
end;
//writeln('AFTER PARAMS TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
if CurToken=tkComma then
begin
@ -6043,7 +6094,8 @@ begin
tkEOF:
CheckToken(tkend);
tkAt,tkAtAt,
tkIdentifier,tkNumber,tkString,tkfalse,tktrue,tkChar,
tkIdentifier,tkspecialize,
tkNumber,tkString,tkfalse,tktrue,tkChar,
tkBraceOpen,tkSquaredBraceOpen,
tkMinus,tkPlus,tkinherited:
begin
@ -6207,9 +6259,9 @@ function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
if CurToken=tkDot then
Result:=Result+'.'+ExpectIdentifier
else if CurToken=tkLessThan then
begin // <> can be ignored, we read the list but discard its content
begin
if (not MustBeGeneric) and not (msDelphi in CurrentModeswitches) then
ParseExcTokenError('('); // e.g. "generic" is missing in mode objfpc
ParseExc(nParserGenericFunctionNeedsGenericKeyword,SParserGenericFunctionNeedsGenericKeyword);
UnGetToken;
L:=TFPList.Create;
Try

6
packages/fcl-passrc/src/pscanner.pp
View File

@ -3432,16 +3432,22 @@ begin
'FPC','DEFAULT':
SetMode(msFpc,FPCModeSwitches,false,bsFPCMode);
'OBJFPC':
begin
SetMode(msObjfpc,OBJFPCModeSwitches,true,bsObjFPCMode);
UnsetNonToken(tkgeneric);
UnsetNonToken(tkspecialize);
end;
'DELPHI':
begin
SetMode(msDelphi,DelphiModeSwitches,true,bsDelphiMode,[bsPointerMath]);
SetNonToken(tkgeneric);
SetNonToken(tkspecialize);
end;
'DELPHIUNICODE':
begin
SetMode(msDelphiUnicode,DelphiUnicodeModeSwitches,true,bsDelphiUnicodeMode,[bsPointerMath]);
SetNonToken(tkgeneric);
SetNonToken(tkspecialize);
end;
'TP':
SetMode(msTP7,TPModeSwitches,false);

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

@ -17,6 +17,7 @@ Type
Procedure TestRecordGenerics;
Procedure TestArrayGenerics;
Procedure TestGenericConstraint;
Procedure TestGenericInterfaceConstraint; // ToDo
Procedure TestDeclarationConstraint;
Procedure TestSpecializationDelphi;
Procedure TestDeclarationDelphi;
@ -26,7 +27,8 @@ Type
Procedure TestInlineSpecializationInArgument;
Procedure TestSpecializeNested;
Procedure TestInlineSpecializeInStatement;
Procedure TestGenericFunction; // ToDo
Procedure TestInlineSpecializeInStatementDelphi;
Procedure TestGenericFunction;
end;
implementation
@ -69,6 +71,32 @@ begin
'Generic TSomeClass<T: TObject> = class',
' b : T;',
'end;',
'Generic TBird<T: class> = class',
' c : TBird<T>;',
'end;',
'Generic TEagle<T: record> = class',
'end;',
'Generic TEagle<T: constructor> = class',
'end;',
'']);
ParseDeclarations;
end;
procedure TTestGenerics.TestGenericInterfaceConstraint;
begin
Add([
'Type',
'TIntfA = interface end;',
'TIntfB = interface end;',
'TBird = class(TInterfacedObject,TIntfA,TIntfB) end;',
'Generic TAnt<T: TIntfA, TIntfB> = class',
' b: T;',
' c: TAnt<T>;',
'end;',
'Generic TFly<T: TIntfA, TIntfB; S> = class',
' b: S;',
' c: TFly<T>;',
'end;',
'']);
ParseDeclarations;
end;
@ -80,8 +108,8 @@ begin
Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
Source.Add('Type');
Source.Add(' TSomeClass<T: T2> = Class(TObject)');
Source.Add(' b : T;');
Source.Add('end;');
Source.Add(' b : T;');
Source.Add(' end;');
ParseDeclarations;
AssertNotNull('have generic definition',Declarations.Classes);
AssertEquals('have generic definition',1,Declarations.Classes.Count);
@ -105,9 +133,9 @@ 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;');
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);
@ -126,9 +154,9 @@ 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;');
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);
@ -148,9 +176,9 @@ 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;');
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);
@ -207,12 +235,25 @@ begin
end;
procedure TTestGenerics.TestInlineSpecializeInStatement;
begin
Add([
'begin',
' t:=specialize a<b>;',
' t:=a.specialize b<c>;',
'']);
ParseModule;
end;
procedure TTestGenerics.TestInlineSpecializeInStatementDelphi;
begin
Add([
'begin',
' vec:=TVector<double>.create;',
' b:=a<b;',
' t:=a<b.c<d,e.f>>;',
' t:=a.b<c>;',
' t:=a<b>.c;',
// forbidden:' t:=a<b<c>.d>;',
'']);
ParseModule;
end;
@ -224,7 +265,7 @@ begin
'begin',
'end;',
'begin',
//' specialize IfThen<word>(true,2,3);',
' specialize IfThen<word>(true,2,3);',
'']);
ParseModule;
end;

2
packages/fcl-passrc/tests/testpassrc.lpr
View File

@ -7,7 +7,7 @@ uses
Classes, consoletestrunner, tcscanner, tctypeparser, tcstatements,
tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
tcexprparser, tcprocfunc, tcpassrcutil, tcresolver, tcgenerics,
tcuseanalyzer, pasresolveeval;
tcuseanalyzer, pasresolveeval, tcresolvegenerics;
type