mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-23 00:09:31 +02:00
fcl-passrc: changed constraints to TPasElementArray, changed TInlineSpecializeExpr to NameExpr:TPasExpr and Params:TFPList
git-svn-id: trunk@43020 -
This commit is contained in:
Mattias Gaertner
parent
0b2a6e5a74
commit
4f64058a9f
packages/fcl-passrc
@ -200,6 +200,8 @@ const
|
||||
nTypeParamXIsNotCompatibleWithY = 3134;
|
||||
nTypeParamXMustSupportIntfY = 3135;
|
||||
nTypeParamsNotAllowedOnX = 3136;
|
||||
nXMethodsCannotHaveTypeParams = 3137;
|
||||
nImplMustNotRepeatConstraints = 3138;
|
||||
|
||||
// using same IDs as FPC
|
||||
nVirtualMethodXHasLowerVisibility = 3250; // was 3050
|
||||
@ -347,6 +349,8 @@ resourcestring
|
||||
sTypeParamXIsNotCompatibleWithY = 'Type parameter "%s" is not compatible with type "%s"';
|
||||
sTypeParamXMustSupportIntfY = 'Type parameter "%s" must support interface "%s"';
|
||||
sTypeParamsNotAllowedOnX = 'Type parameters not allowed on %s';
|
||||
sXMethodsCannotHaveTypeParams = '%s methods cannot have type parameters';
|
||||
sImplMustNotRepeatConstraints = 'Implementations must not repeat constraints';
|
||||
|
||||
type
|
||||
{ TResolveData - base class for data stored in TPasElement.CustomData }
|
||||
@ -790,6 +794,7 @@ function GetObjPath(o: TObject): string;
|
||||
function GetTypeParamCommas(Cnt: integer): string;
|
||||
function dbgs(const Flags: TResEvalFlags): string; overload;
|
||||
function dbgs(v: TResEvalValue): string; overload;
|
||||
function LastPos(c: char; const s: string): sizeint;
|
||||
|
||||
implementation
|
||||
|
||||
@ -1094,6 +1099,15 @@ begin
|
||||
Result:=v.AsDebugString;
|
||||
end;
|
||||
|
||||
function LastPos(c: char; const s: string): sizeint;
|
||||
var
|
||||
i: SizeInt;
|
||||
begin
|
||||
for i:=length(s) downto 1 do
|
||||
if s[i]=c then exit(i);
|
||||
Result:=-1;
|
||||
end;
|
||||
|
||||
{ TResEvalExternal }
|
||||
|
||||
constructor TResEvalExternal.Create;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -192,6 +192,7 @@ type
|
||||
class property GlobalRefCount: NativeInt read FGlobalRefCount write FGlobalRefCount;
|
||||
{$endif}
|
||||
end;
|
||||
TPasElementArray = array of TPasElement;
|
||||
|
||||
TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst,
|
||||
pekRange, pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp,
|
||||
@ -558,10 +559,10 @@ type
|
||||
function GetDeclaration(full : boolean) : string; override;
|
||||
procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
|
||||
const Arg: Pointer); override;
|
||||
procedure AddConstraint(Expr: TPasExpr);
|
||||
procedure AddConstraint(El: TPasElement);
|
||||
Public
|
||||
TypeConstraint: String deprecated; // deprecated in fpc 3.3.1
|
||||
Constraints: TPasExprArray;
|
||||
Constraints: TPasElementArray; // list of TPasExpr or TPasType, can be nil!
|
||||
end;
|
||||
|
||||
{ TPasGenericType - abstract base class for all types which can be generics }
|
||||
@ -589,7 +590,6 @@ type
|
||||
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;
|
||||
@ -605,7 +605,8 @@ type
|
||||
procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
|
||||
const Arg: Pointer); override;
|
||||
public
|
||||
DestType: TPasSpecializeType;
|
||||
NameExpr: TPasExpr;
|
||||
Params: TFPList; // list of TPasType
|
||||
end;
|
||||
|
||||
{ TPasClassOfType }
|
||||
@ -1053,7 +1054,7 @@ type
|
||||
Name: string;
|
||||
Templates: TFPList; // optional list of TPasGenericTemplateType, can be nil!
|
||||
end;
|
||||
TProcedureNameParts = TFPList;
|
||||
TProcedureNameParts = TFPList; // list of TProcedureNamePart
|
||||
|
||||
TProcedureBody = class;
|
||||
|
||||
@ -1083,7 +1084,7 @@ type
|
||||
AliasName : String;
|
||||
ProcType : TPasProcedureType;
|
||||
Body : TProcedureBody;
|
||||
NameParts: TProcedureNameParts; // only used for generic functions
|
||||
NameParts: TProcedureNameParts; // only used for generic aka parametrized functions
|
||||
Procedure AddModifier(AModifier : TProcedureModifier);
|
||||
Function IsVirtual : Boolean;
|
||||
Function IsDynamic : Boolean;
|
||||
@ -1744,14 +1745,13 @@ const
|
||||
procedure ReleaseAndNil(var El: TPasElement {$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF}); overload;
|
||||
procedure ReleaseGenericTemplateTypes(var GenericTemplateTypes: TFPList{$IFDEF CheckPasTreeRefCount}; const Id: string{$ENDIF});
|
||||
function GenericTemplateTypesAsString(List: TFPList): string;
|
||||
procedure ReleaseProcNameParts(var NameParts: TProcedureNameParts);
|
||||
|
||||
{$IFDEF HasPTDumpStack}
|
||||
procedure PTDumpStack;
|
||||
function GetPTDumpStack: string;
|
||||
{$ENDIF}
|
||||
|
||||
procedure ReleaseProcNameParts(var NameParts: TProcedureNameParts);
|
||||
|
||||
implementation
|
||||
|
||||
uses SysUtils;
|
||||
@ -1944,14 +1944,13 @@ begin
|
||||
ForEachChildCall(aMethodCall,Arg,Constraints[i],false);
|
||||
end;
|
||||
|
||||
procedure TPasGenericTemplateType.AddConstraint(Expr: TPasExpr);
|
||||
procedure TPasGenericTemplateType.AddConstraint(El: TPasElement);
|
||||
var
|
||||
l: Integer;
|
||||
begin
|
||||
l:=Length(Constraints);
|
||||
SetLength(Constraints,l+1);
|
||||
Constraints[l]:=Expr;
|
||||
Expr.Parent:=Self;
|
||||
Constraints[l]:=El;
|
||||
end;
|
||||
|
||||
{$IFDEF HasPTDumpStack}
|
||||
@ -2039,11 +2038,17 @@ constructor TInlineSpecializeExpr.Create(const AName: string;
|
||||
begin
|
||||
if AName='' then ;
|
||||
inherited Create(AParent, pekSpecialize, eopNone);
|
||||
Params:=TFPList.Create;
|
||||
end;
|
||||
|
||||
destructor TInlineSpecializeExpr.Destroy;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
ReleaseAndNil(TPasElement(DestType){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
|
||||
TPasElement(NameExpr).Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
|
||||
for i:=0 to Params.Count-1 do
|
||||
TPasElement(Params[i]).Release{$IFDEF CheckPasTreeRefCount}('TInlineSpecializeExpr.Params'){$ENDIF};
|
||||
FreeAndNil(Params);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -2053,15 +2058,29 @@ begin
|
||||
end;
|
||||
|
||||
function TInlineSpecializeExpr.GetDeclaration(full: Boolean): string;
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
Result:=DestType.GetDeclaration(full);
|
||||
Result:='specialize '+NameExpr.GetDeclaration(false)+'<';
|
||||
for i:=0 to Params.Count-1 do
|
||||
begin
|
||||
if i>0 then
|
||||
Result:=Result+',';
|
||||
Result:=Result+TPasElement(Params[i]).GetDeclaration(false);
|
||||
end;
|
||||
Result:=Result+'>';
|
||||
if full then ;
|
||||
end;
|
||||
|
||||
procedure TInlineSpecializeExpr.ForEachCall(
|
||||
const aMethodCall: TOnForEachPasElement; const Arg: Pointer);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
inherited ForEachCall(aMethodCall, Arg);
|
||||
ForEachChildCall(aMethodCall,Arg,DestType,false);
|
||||
ForEachChildCall(aMethodCall,Arg,NameExpr,false);
|
||||
for i:=0 to Params.Count-1 do
|
||||
ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true);
|
||||
end;
|
||||
|
||||
{ TPasSpecializeType }
|
||||
@ -2116,11 +2135,6 @@ begin
|
||||
ForEachChildCall(aMethodCall,Arg,TPasElement(Params[i]),true);
|
||||
end;
|
||||
|
||||
procedure TPasSpecializeType.AddParam(El: TPasElement);
|
||||
begin
|
||||
Params.Add(El);
|
||||
end;
|
||||
|
||||
{ TInterfaceSection }
|
||||
|
||||
function TInterfaceSection.ElementTypeName: string;
|
||||
|
||||
@ -265,6 +265,7 @@ type
|
||||
procedure UseExprRef(El: TPasElement; Expr: TPasExpr;
|
||||
Access: TResolvedRefAccess; UseFull: boolean); virtual;
|
||||
procedure UseInheritedExpr(El: TInheritedExpr); virtual;
|
||||
procedure UseInlineSpecializeExpr(El: TInlineSpecializeExpr); virtual;
|
||||
procedure UseScopeReferences(Refs: TPasScopeReferences); virtual;
|
||||
procedure UseProcedure(Proc: TPasProcedure); virtual;
|
||||
procedure UseProcedureType(ProcType: TPasProcedureType); virtual;
|
||||
@ -1526,15 +1527,15 @@ procedure TPasAnalyzer.UseExpr(El: TPasExpr);
|
||||
|
||||
procedure UseSystemExit;
|
||||
var
|
||||
ParamsExpr: TParamsExpr;
|
||||
Params: TPasExprArray;
|
||||
SubEl: TPasElement;
|
||||
Proc: TPasProcedure;
|
||||
ProcScope: TPasProcedureScope;
|
||||
ParentParams: TPRParentParams;
|
||||
begin
|
||||
ParamsExpr:=Resolver.GetParamsOfNameExpr(El);
|
||||
if ParamsExpr=nil then exit;
|
||||
Params:=ParamsExpr.Params;
|
||||
Resolver.GetParamsOfNameExpr(El,ParentParams);
|
||||
if ParentParams.Params=nil then exit;
|
||||
Params:=ParentParams.Params.Params;
|
||||
if length(Params)<1 then
|
||||
exit;
|
||||
SubEl:=El.Parent;
|
||||
@ -1551,18 +1552,50 @@ procedure TPasAnalyzer.UseExpr(El: TPasExpr);
|
||||
UseElement(SubEl,rraAssign,false);
|
||||
end;
|
||||
|
||||
procedure UseBuilInFuncTypeInfo;
|
||||
var
|
||||
ParentParams: TPRParentParams;
|
||||
ParamResolved: TPasResolverResult;
|
||||
SubEl: TPasElement;
|
||||
Params: TPasExprArray;
|
||||
begin
|
||||
Resolver.GetParamsOfNameExpr(El,ParentParams);
|
||||
if ParentParams.Params=nil then
|
||||
RaiseNotSupported(20190225150136,El);
|
||||
Params:=ParentParams.Params.Params;
|
||||
if length(Params)<>1 then
|
||||
RaiseNotSupported(20180226144217,El.Parent);
|
||||
Resolver.ComputeElement(Params[0],ParamResolved,[rcNoImplicitProc]);
|
||||
{$IFDEF VerbosePasAnalyzer}
|
||||
writeln('TPasAnalyzer.UseExpr typeinfo ',GetResolverResultDbg(ParamResolved));
|
||||
{$ENDIF}
|
||||
if ParamResolved.IdentEl=nil then
|
||||
RaiseNotSupported(20180628155107,Params[0]);
|
||||
if (ParamResolved.IdentEl is TPasProcedure)
|
||||
and (TPasProcedure(ParamResolved.IdentEl).ProcType is TPasFunctionType) then
|
||||
begin
|
||||
SubEl:=TPasFunctionType(TPasProcedure(ParamResolved.IdentEl).ProcType).ResultEl.ResultType;
|
||||
MarkImplScopeRef(El,SubEl,psraTypeInfo);
|
||||
UseTypeInfo(SubEl);
|
||||
end
|
||||
else
|
||||
begin
|
||||
SubEl:=ParamResolved.IdentEl;
|
||||
MarkImplScopeRef(El,SubEl,psraTypeInfo);
|
||||
UseTypeInfo(SubEl);
|
||||
end;
|
||||
// the parameter is not used otherwise
|
||||
end;
|
||||
|
||||
var
|
||||
Ref: TResolvedReference;
|
||||
C: TClass;
|
||||
Params: TPasExprArray;
|
||||
i: Integer;
|
||||
BuiltInProc: TResElDataBuiltInProc;
|
||||
ParamResolved: TPasResolverResult;
|
||||
Decl: TPasElement;
|
||||
ModScope: TPasModuleScope;
|
||||
Access: TResolvedRefAccess;
|
||||
SubEl: TPasElement;
|
||||
ParamsExpr: TParamsExpr;
|
||||
begin
|
||||
if El=nil then exit;
|
||||
// Note: expression itself is not marked, but it can reference identifiers
|
||||
@ -1614,35 +1647,13 @@ begin
|
||||
BuiltInProc:=TResElDataBuiltInProc(Decl.CustomData);
|
||||
case BuiltInProc.BuiltIn of
|
||||
bfExit:
|
||||
begin
|
||||
UseSystemExit;
|
||||
exit;
|
||||
end;
|
||||
bfTypeInfo:
|
||||
begin
|
||||
ParamsExpr:=Resolver.GetParamsOfNameExpr(El);
|
||||
if ParamsExpr=nil then
|
||||
RaiseNotSupported(20190225150136,El);
|
||||
Params:=ParamsExpr.Params;
|
||||
if length(Params)<>1 then
|
||||
RaiseNotSupported(20180226144217,El.Parent);
|
||||
Resolver.ComputeElement(Params[0],ParamResolved,[rcNoImplicitProc]);
|
||||
{$IFDEF VerbosePasAnalyzer}
|
||||
writeln('TPasAnalyzer.UseExpr typeinfo ',GetResolverResultDbg(ParamResolved));
|
||||
{$ENDIF}
|
||||
if ParamResolved.IdentEl=nil then
|
||||
RaiseNotSupported(20180628155107,Params[0]);
|
||||
if (ParamResolved.IdentEl is TPasProcedure)
|
||||
and (TPasProcedure(ParamResolved.IdentEl).ProcType is TPasFunctionType) then
|
||||
begin
|
||||
SubEl:=TPasFunctionType(TPasProcedure(ParamResolved.IdentEl).ProcType).ResultEl.ResultType;
|
||||
MarkImplScopeRef(El,SubEl,psraTypeInfo);
|
||||
UseTypeInfo(SubEl);
|
||||
end
|
||||
else
|
||||
begin
|
||||
SubEl:=ParamResolved.IdentEl;
|
||||
MarkImplScopeRef(El,SubEl,psraTypeInfo);
|
||||
UseTypeInfo(SubEl);
|
||||
end;
|
||||
// the parameter is not used otherwise
|
||||
UseBuilInFuncTypeInfo;
|
||||
exit;
|
||||
end;
|
||||
bfAssert:
|
||||
@ -1694,7 +1705,7 @@ begin
|
||||
else if C=TProcedureExpr then
|
||||
UseProcedure(TProcedureExpr(El).Proc)
|
||||
else if C=TInlineSpecializeExpr then
|
||||
UseSpecializeType(TInlineSpecializeExpr(El).DestType,paumElement)
|
||||
UseInlineSpecializeExpr(TInlineSpecializeExpr(El))
|
||||
else
|
||||
RaiseNotSupported(20170307085444,El);
|
||||
end;
|
||||
@ -1804,6 +1815,15 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPasAnalyzer.UseInlineSpecializeExpr(El: TInlineSpecializeExpr);
|
||||
var
|
||||
i: Integer;
|
||||
begin
|
||||
for i:=0 to El.Params.Count-1 do
|
||||
UseType(TPasType(El.Params[i]),paumElement);
|
||||
UseExpr(El.NameExpr);
|
||||
end;
|
||||
|
||||
procedure TPasAnalyzer.UseScopeReferences(Refs: TPasScopeReferences);
|
||||
begin
|
||||
if Refs=nil then exit;
|
||||
|
||||
@ -320,7 +320,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(Parent: TPasElement; Params: TFPList);
|
||||
function ReadDottedIdentifier(Parent: TPasElement; out Expr: TPasExpr; NeedAsString: boolean): String;
|
||||
function CheckProcedureArgs(Parent: TPasElement;
|
||||
Args: TFPList; // list of TPasArgument
|
||||
@ -1695,8 +1695,6 @@ begin
|
||||
else
|
||||
begin
|
||||
// simple type reference
|
||||
if not NeedExpr then
|
||||
ReleaseAndNil(TPasElement(Expr){$IFDEF CheckPasTreeRefCount},'CreateElement'{$ENDIF});
|
||||
Result:=ResolveTypeReference(Name,Parent);
|
||||
end;
|
||||
ok:=true;
|
||||
@ -1730,7 +1728,7 @@ begin
|
||||
GenNameExpr:=nil; // ownership transferred to ST
|
||||
end;
|
||||
// read nested specialize arguments
|
||||
ReadSpecializeArguments(ST);
|
||||
ReadSpecializeArguments(ST,ST.Params);
|
||||
// Important: resolve type reference AFTER args, because arg count is needed
|
||||
ST.DestType:=ResolveTypeReference(GenName,ST,ST.Params.Count);
|
||||
|
||||
@ -2329,8 +2327,6 @@ var
|
||||
SrcPos, ScrPos: TPasSourcePos;
|
||||
ProcType: TProcType;
|
||||
ProcExpr: TProcedureExpr;
|
||||
SpecType: TPasSpecializeType;
|
||||
|
||||
begin
|
||||
Result:=nil;
|
||||
CanSpecialize:=aCannot;
|
||||
@ -2502,7 +2498,7 @@ begin
|
||||
// an inline specialization (e.g. A<B,C> or something.A<B>)
|
||||
// check expression in front is an identifier
|
||||
Expr:=Result;
|
||||
while Expr.Kind=pekBinary do
|
||||
if Expr.Kind=pekBinary then
|
||||
begin
|
||||
if Expr.OpCode<>eopSubIdent then
|
||||
ParseExcSyntaxError;
|
||||
@ -2511,25 +2507,14 @@ begin
|
||||
if Expr.Kind<>pekIdent then
|
||||
ParseExcSyntaxError;
|
||||
|
||||
// read specialized type
|
||||
// read specialized params
|
||||
ISE:=TInlineSpecializeExpr(CreateElement(TInlineSpecializeExpr,'',AParent,SrcPos));
|
||||
SpecType:=TPasSpecializeType(CreateElement(TPasSpecializeType,'',ISE,SrcPos));
|
||||
ISE.DestType:=SpecType;
|
||||
ReadSpecializeArguments(SpecType);
|
||||
// can't resolve SpecType.DestType here
|
||||
ReadSpecializeArguments(ISE,ISE.Params);
|
||||
|
||||
// A<B> or something.A<B>
|
||||
if Expr.Parent is TBinaryExpr then
|
||||
begin
|
||||
if TBinaryExpr(Expr.Parent).right<>Expr then
|
||||
ParseExcSyntaxError;
|
||||
TBinaryExpr(Expr.Parent).right:=ISE;
|
||||
ISE.Parent:=Expr.Parent;
|
||||
end;
|
||||
SpecType.Expr:=Expr;
|
||||
Expr.Parent:=SpecType;
|
||||
if Expr=Result then
|
||||
Result:=ISE;
|
||||
ISE.NameExpr:=Result;
|
||||
Result.Parent:=ISE;
|
||||
Result:=ISE;
|
||||
ISE:=nil;
|
||||
CanSpecialize:=aCannot;
|
||||
NextToken;
|
||||
@ -4113,8 +4098,6 @@ Var
|
||||
T : TPasGenericTemplateType;
|
||||
Expr: TPasExpr;
|
||||
TypeEl: TPasType;
|
||||
SrcPos: TPasSourcePos;
|
||||
ISE: TInlineSpecializeExpr;
|
||||
begin
|
||||
ExpectToken(tkLessThan);
|
||||
repeat
|
||||
@ -4125,39 +4108,28 @@ begin
|
||||
if Curtoken = tkColon then
|
||||
repeat
|
||||
NextToken;
|
||||
// comma separated list: identifier, class, record, constructor
|
||||
// comma separated list of constraints: identifier, class, record, constructor
|
||||
case CurToken of
|
||||
tkclass,tkrecord,tkconstructor:
|
||||
begin
|
||||
if T.TypeConstraint='' then
|
||||
T.TypeConstraint:=CurTokenString;
|
||||
Expr:=CreatePrimitiveExpr(T,pekIdent,CurTokenText);
|
||||
T.AddConstraint(Expr);
|
||||
NextToken;
|
||||
end;
|
||||
tkIdentifier,tkspecialize:
|
||||
begin
|
||||
SrcPos:=CurSourcePos;
|
||||
TypeEl:=ParseTypeReference(T,true,Expr);
|
||||
if TypeEl<>nil then
|
||||
begin
|
||||
TypeEl:=ParseTypeReference(T,false,Expr);
|
||||
if T.TypeConstraint='' then
|
||||
T.TypeConstraint:=TypeEl.Name;
|
||||
if TypeEl is TPasSpecializeType then
|
||||
begin
|
||||
ISE:=TInlineSpecializeExpr(CreateElement(TInlineSpecializeExpr,'',T,SrcPos));
|
||||
ISE.DestType:=TPasSpecializeType(TypeEl);
|
||||
TypeEl.Parent:=ISE;
|
||||
Expr:=ISE;
|
||||
end
|
||||
else if TypeEl.Parent=T then
|
||||
ParseExc(nParserExpectTokenError,SParserExpectTokenError,['20190831211205:'+TypeEl.ClassName])
|
||||
else
|
||||
TypeEl.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
|
||||
end;
|
||||
if (Expr<>nil) and (Expr.Parent=T) then
|
||||
Expr.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
|
||||
T.AddConstraint(TypeEl);
|
||||
end;
|
||||
else
|
||||
CheckToken(tkIdentifier);
|
||||
end;
|
||||
T.AddConstraint(Expr);
|
||||
until CurToken<>tkComma;
|
||||
Engine.FinishScope(stTypeDef,T);
|
||||
until not (CurToken in [tkSemicolon,tkComma]);
|
||||
@ -4167,7 +4139,8 @@ begin
|
||||
end;
|
||||
{$warn 5043 on}
|
||||
|
||||
procedure TPasParser.ReadSpecializeArguments(Spec: TPasSpecializeType);
|
||||
procedure TPasParser.ReadSpecializeArguments(Parent: TPasElement;
|
||||
Params: TFPList);
|
||||
// after parsing CurToken is on tkGreaterThan
|
||||
Var
|
||||
TypeEl: TPasType;
|
||||
@ -4176,8 +4149,8 @@ begin
|
||||
CheckToken(tkLessThan);
|
||||
repeat
|
||||
//writeln('ARG TPasParser.ReadSpecializeArguments ',CurTokenText,' ',CurTokenString);
|
||||
TypeEl:=ParseType(Spec,CurTokenPos,'');
|
||||
Spec.AddParam(TypeEl);
|
||||
TypeEl:=ParseType(Parent,CurTokenPos,'');
|
||||
Params.Add(TypeEl);
|
||||
NextToken;
|
||||
if CurToken=tkComma then
|
||||
continue
|
||||
|
||||
@ -42,6 +42,8 @@ type
|
||||
procedure TestGen_ConstraintClassType_DotIsAsTypeCast;
|
||||
procedure TestGen_ConstraintClassType_ForInT;
|
||||
procedure TestGen_ConstraintClassType_IsAs;
|
||||
// ToDo: A<T:T> fail
|
||||
// ToDo: A<T:B<T>> fail
|
||||
|
||||
// generic record
|
||||
procedure TestGen_RecordLocalNameDuplicateFail;
|
||||
@ -103,18 +105,29 @@ type
|
||||
|
||||
// ToDo: helpers for generics
|
||||
|
||||
// generic functions
|
||||
procedure TestGen_GenericFunction; // ToDo
|
||||
// ToDo: generic class method overload <T> <S,T>
|
||||
// ToDo: procedure TestGen_GenMethod_ClassConstructorFail;
|
||||
|
||||
// generic statements
|
||||
procedure TestGen_LocalVar;
|
||||
procedure TestGen_Statements;
|
||||
procedure TestGen_InlineSpecializeExpr;
|
||||
// ToDo: a.b<c>(d)
|
||||
// ToDo: with a do b<c>
|
||||
procedure TestGen_TryExcept;
|
||||
procedure TestGen_Call;
|
||||
// ToTo: nested proc
|
||||
procedure TestGen_NestedProc;
|
||||
|
||||
// generic functions
|
||||
procedure TestGenProc_Function; // ToDo
|
||||
//procedure TestGenProc_Forward; // ToDo
|
||||
// ToDo: forward parametrized impl must not repeat constraints
|
||||
// ToDo: forward parametrized impl overloads
|
||||
// ToDo: parametrized nested proc fail
|
||||
// ToDo: generic class method overload <T> <S,T>
|
||||
// ToDo: procedure TestGenMethod_ClassConstructorFail;
|
||||
// ToDo: procedure TestGenMethod_NestedProc;
|
||||
// ToDo: virtual method cannot have type parameters
|
||||
// ToDo: message method cannot have type parameters
|
||||
// ToDo: interface method cannot have type parameters
|
||||
// ToDo: parametrized method mismatch interface method
|
||||
end;
|
||||
|
||||
implementation
|
||||
@ -200,10 +213,7 @@ procedure TTestResolveGenerics.TestGen_ConstraintStringFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'generic function DoIt<T:string>(a: T): T;',
|
||||
'begin',
|
||||
' Result:=a;',
|
||||
'end;',
|
||||
'type generic TRec<T:string> = record end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('"String" is not a valid constraint',
|
||||
@ -219,10 +229,7 @@ begin
|
||||
' TObject = class end;',
|
||||
' TBird = class end;',
|
||||
' TBear = class end;',
|
||||
'generic function DoIt<T: TBird, TBear>(a: T): T;',
|
||||
'begin',
|
||||
' Result:=a;',
|
||||
'end;',
|
||||
' generic TRec<T: TBird, TBear> = record end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('"TBird" constraint and "TBear" constraint cannot be specified together',
|
||||
@ -553,6 +560,7 @@ begin
|
||||
' specialize TAnt<TObject>(v).v:=nil;',
|
||||
' a:=v as specialize TAnt<U>;',
|
||||
' if (v as specialize TAnt<TObject>).v=nil then ;',
|
||||
' if nil=(v as specialize TAnt<TObject>).v then ;',
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
@ -812,7 +820,7 @@ begin
|
||||
' end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('Declaration of "T" differs from previous declaration at afile.pp(7,20)',
|
||||
CheckResolverException('Declaration of "T" differs from previous declaration at afile.pp(7,18)',
|
||||
nDeclOfXDiffersFromPrevAtY);
|
||||
end;
|
||||
|
||||
@ -987,7 +995,7 @@ begin
|
||||
'end;',
|
||||
'begin',
|
||||
'']);
|
||||
CheckResolverException('T cannot have parameters',nXCannotHaveParameters);
|
||||
CheckResolverException('illegal qualifier ":" after "T"',nIllegalQualifierAfter);
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGen_Class_MethodImplTypeParamNameMismatch;
|
||||
@ -1480,24 +1488,6 @@ begin
|
||||
CheckParserException('Expected "Identifier" at token "specialize" in file afile.pp at line 4 column 11',nParserExpectTokenError);
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGen_GenericFunction;
|
||||
begin
|
||||
exit;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'generic function DoIt<T>(a: T): T;',
|
||||
'var i: T;',
|
||||
'begin',
|
||||
' a:=i;',
|
||||
' Result:=a;',
|
||||
'end;',
|
||||
'var w: word;',
|
||||
'begin',
|
||||
//' w:=DoIt<word>(3);',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGen_LocalVar;
|
||||
begin
|
||||
StartProgram(false);
|
||||
@ -1671,6 +1661,50 @@ begin
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGen_NestedProc;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'{$mode objfpc}',
|
||||
'type',
|
||||
' TObject = class end;',
|
||||
' generic TBird<T> = class',
|
||||
' function Fly(p:T): T;',
|
||||
' end;',
|
||||
'function TBird.Fly(p:T): T;',
|
||||
' function Run: T;',
|
||||
' begin',
|
||||
' Fly:=Result;',
|
||||
' end;',
|
||||
'begin',
|
||||
' Run;',
|
||||
'end;',
|
||||
'var',
|
||||
' w: specialize TBird<word>;',
|
||||
' b: specialize TBird<boolean>;',
|
||||
'begin',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolveGenerics.TestGenProc_Function;
|
||||
begin
|
||||
exit;
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'generic function DoIt<T>(a: T): T;',
|
||||
'var i: T;',
|
||||
'begin',
|
||||
' a:=i;',
|
||||
' Result:=a;',
|
||||
'end;',
|
||||
'var w: word;',
|
||||
'begin',
|
||||
' w:=DoIt<word>(3);',
|
||||
'']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTests([TTestResolveGenerics]);
|
||||
|
||||
|
||||
@ -1092,6 +1092,8 @@ begin
|
||||
writeln('TCustomTestResolver.TearDown GlobalRefCount Was='+IntToStr(FStartElementRefCount)+' Now='+IntToStr(TPasElement.GlobalRefCount));
|
||||
{$IFDEF CheckPasTreeRefCount}
|
||||
El:=TPasElement.FirstRefEl;
|
||||
if El=nil then
|
||||
writeln(' TPasElement.FirstRefEl=nil');
|
||||
while El<>nil do
|
||||
begin
|
||||
writeln(' ',GetObjName(El),' RefIds.Count=',El.RefIds.Count,':');
|
||||
|
||||
Loading…
Reference in New Issue
Block a user