summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authormattias <mattias@3ad0048d-3df7-0310-abae-a5850022a9f2>2019-06-20 08:47:04 +0000
committermattias <mattias@3ad0048d-3df7-0310-abae-a5850022a9f2>2019-06-20 08:47:04 +0000
commitca02da2492d71624b9041418e50a0a99207a77b1 (patch)
tree97fc07e2d0c435f97570e0aef2466467a4157b9c
parent43279c8b2ebb159cd6be7c3f640b0dc2e1270fd6 (diff)
downloadfpc-ca02da2492d71624b9041418e50a0a99207a77b1.tar.gz
fcl-passrc: fixed parsing objfpc inline specialize
git-svn-id: https://svn.freepascal.org/svn/fpc/trunk@42251 3ad0048d-3df7-0310-abae-a5850022a9f2
-rw-r--r--packages/fcl-passrc/src/pasresolver.pp24
-rw-r--r--packages/fcl-passrc/src/pastree.pp138
-rw-r--r--packages/fcl-passrc/src/pparser.pp128
-rw-r--r--packages/fcl-passrc/src/pscanner.pp6
-rw-r--r--packages/fcl-passrc/tests/tcgenerics.pp67
-rw-r--r--packages/fcl-passrc/tests/testpassrc.lpr2
6 files changed, 290 insertions, 75 deletions
diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp
index 5460af4a71..fc4e3c3e34 100644
--- a/packages/fcl-passrc/src/pasresolver.pp
+++ b/packages/fcl-passrc/src/pasresolver.pp
@@ -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
diff --git a/packages/fcl-passrc/src/pastree.pp b/packages/fcl-passrc/src/pastree.pp
index af8c0c7499..39661abefb 100644
--- a/packages/fcl-passrc/src/pastree.pp
+++ b/packages/fcl-passrc/src/pastree.pp
@@ -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);
diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp
index 0dd9261666..3271b6bc38 100644
--- a/packages/fcl-passrc/src/pparser.pp
+++ b/packages/fcl-passrc/src/pparser.pp
@@ -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: TPasElement);
-procedure TPasParser.ReadSpecializeArguments(Spec: TPasSpecializeType);
+ 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
diff --git a/packages/fcl-passrc/src/pscanner.pp b/packages/fcl-passrc/src/pscanner.pp
index f3d67722ff..90c4f7d578 100644
--- a/packages/fcl-passrc/src/pscanner.pp
+++ b/packages/fcl-passrc/src/pscanner.pp
@@ -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);
diff --git a/packages/fcl-passrc/tests/tcgenerics.pp b/packages/fcl-passrc/tests/tcgenerics.pp
index 722fa84827..4dc0959666 100644
--- a/packages/fcl-passrc/tests/tcgenerics.pp
+++ b/packages/fcl-passrc/tests/tcgenerics.pp
@@ -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);
@@ -210,9 +238,22 @@ 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;
diff --git a/packages/fcl-passrc/tests/testpassrc.lpr b/packages/fcl-passrc/tests/testpassrc.lpr
index 55604dccc8..9f9444929b 100644
--- a/packages/fcl-passrc/tests/testpassrc.lpr
+++ b/packages/fcl-passrc/tests/testpassrc.lpr
@@ -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