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