mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-09 07:28:26 +02:00
fcl-passrc: started anonymous methods
git-svn-id: trunk@40475 -
This commit is contained in:
Mattias Gaertner
parent
b82026dcf8
commit
0fe9e24297
@ -1824,6 +1824,7 @@ type
|
||||
function GetPasPropertyStoredExpr(El: TPasProperty): TPasExpr;
|
||||
function GetPasPropertyDefaultExpr(El: TPasProperty): TPasExpr;
|
||||
function GetPasClassAncestor(ClassEl: TPasClassType; SkipAlias: boolean): TPasType;
|
||||
function GetParentProcBody(El: TPasElement): TProcedureBody;
|
||||
function ProcHasImplElements(Proc: TPasProcedure): boolean; virtual;
|
||||
function IndexOfImplementedInterface(ClassEl: TPasClassType; aType: TPasType): integer;
|
||||
function GetLoop(El: TPasElement): TPasImplElement;
|
||||
@ -2072,8 +2073,8 @@ begin
|
||||
dec(Indent,2);
|
||||
end;
|
||||
Result:=Result+')';
|
||||
if El is TPasFunction then
|
||||
Result:=Result+':'+GetTreeDbg(TPasFunctionType(TPasFunction(El).ProcType).ResultEl,Indent);
|
||||
if (El is TPasProcedure) and (TPasProcedure(El).ProcType is TPasFunctionType) then
|
||||
Result:=Result+':'+GetTreeDbg(TPasFunctionType(TPasProcedure(El).ProcType).ResultEl,Indent);
|
||||
if TPasProcedureType(El).IsOfObject then
|
||||
Result:=Result+' '+ProcTypeModifiers[ptmOfObject];
|
||||
if TPasProcedureType(El).IsNested then
|
||||
@ -2273,6 +2274,10 @@ begin
|
||||
Result:='class procedure'
|
||||
else if C=TPasClassFunction then
|
||||
Result:='class function'
|
||||
else if C=TPasAnonymousProcedure then
|
||||
Result:='anonymous procedure'
|
||||
else if C=TPasAnonymousFunction then
|
||||
Result:='anonymous function'
|
||||
else if C=TPasMethodResolution then
|
||||
Result:='method resolution'
|
||||
else if C=TInterfaceSection then
|
||||
@ -5310,13 +5315,17 @@ var
|
||||
pm: TProcedureModifier;
|
||||
ptm: TProcTypeModifier;
|
||||
ObjKind: TPasObjKind;
|
||||
ParentBody: TProcedureBody;
|
||||
begin
|
||||
if (El.Parent is TPasProcedure) and (TPasProcedure(El.Parent).ProcType=El) then
|
||||
if El.Parent is TPasProcedure then
|
||||
Proc:=TPasProcedure(El.Parent)
|
||||
else
|
||||
Proc:=nil;
|
||||
if (Proc<>nil) and (Proc.ProcType=El) then
|
||||
begin
|
||||
// finished header of a procedure declaration
|
||||
// -> search the best fitting proc
|
||||
CheckTopScope(FScopeClass_Proc);
|
||||
Proc:=TPasProcedure(El.Parent);
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.FinishProcedureHeader El=',GetTreeDbg(El),' ',GetElementSourcePosStr(El),' IsForward=',Proc.IsForward,' Parent=',GetObjName(El.Parent));
|
||||
{$ENDIF}
|
||||
@ -5325,13 +5334,14 @@ begin
|
||||
if (proProcTypeWithoutIsNested in Options) and El.IsNested then
|
||||
RaiseInvalidProcTypeModifier(20170402120811,El,ptmIsNested,El);
|
||||
|
||||
if (Proc.Parent.ClassType=TProcedureBody) then
|
||||
ParentBody:=GetParentProcBody(Proc.Parent);
|
||||
if (ParentBody<>nil) then
|
||||
begin
|
||||
// nested sub proc
|
||||
if not (proProcTypeWithoutIsNested in Options) then
|
||||
El.IsNested:=true;
|
||||
// inherit 'of Object'
|
||||
ParentProc:=Proc.Parent.Parent as TPasProcedure;
|
||||
ParentProc:=ParentBody.Parent as TPasProcedure;
|
||||
if ParentProc.ProcType.IsOfObject then
|
||||
El.IsOfObject:=true;
|
||||
end;
|
||||
@ -5393,7 +5403,7 @@ begin
|
||||
end
|
||||
else
|
||||
begin
|
||||
// intf proc, forward proc, proc body, method body
|
||||
// intf proc, forward proc, proc body, method body, anonymous proc
|
||||
if Proc.IsAbstract then
|
||||
RaiseInvalidProcModifier(20170216151634,Proc,pmAbstract,Proc);
|
||||
if Proc.IsVirtual then
|
||||
@ -5405,8 +5415,12 @@ begin
|
||||
if Proc.IsStatic then
|
||||
RaiseInvalidProcTypeModifier(20170216151640,El,ptmStatic,El);
|
||||
if (not HasDots)
|
||||
and (Proc.ClassType<>TPasProcedure)
|
||||
and (Proc.ClassType<>TPasFunction) then
|
||||
and (Proc.GetProcTypeEnum in [
|
||||
ptClassOperator,
|
||||
ptConstructor, ptDestructor,
|
||||
ptClassProcedure, ptClassFunction,
|
||||
ptClassConstructor, ptClassDestructor
|
||||
]) then
|
||||
RaiseXExpectedButYFound(20170419232724,'full method name','short name',El);
|
||||
end;
|
||||
|
||||
@ -5418,7 +5432,8 @@ begin
|
||||
|
||||
// finish interface/implementation/nested procedure/method declaration
|
||||
|
||||
if not IsValidIdent(ProcName) then
|
||||
if not (Proc.GetProcTypeEnum in [ptAnonymousProcedure,ptAnonymousFunction])
|
||||
and not IsValidIdent(ProcName) then
|
||||
RaiseNotYetImplemented(20160922163407,El);
|
||||
|
||||
if El is TPasFunctionType then
|
||||
@ -5436,7 +5451,7 @@ begin
|
||||
end;
|
||||
|
||||
// finish interface/implementation/nested procedure
|
||||
if ProcNeedsBody(Proc) then
|
||||
if (ProcName<>'') and ProcNeedsBody(Proc) then
|
||||
begin
|
||||
// check if there is a forward declaration
|
||||
ParentScope:=Scopes[ScopeCount-2];
|
||||
@ -5483,13 +5498,16 @@ begin
|
||||
StoreScannerFlagsInProc(ProcScope);
|
||||
end;
|
||||
|
||||
// check for invalid overloads
|
||||
FindData:=Default(TFindOverloadProcData);
|
||||
FindData.Proc:=Proc;
|
||||
FindData.Args:=Proc.ProcType.Args;
|
||||
FindData.Kind:=fopkProc;
|
||||
Abort:=false;
|
||||
IterateElements(ProcName,@OnFindOverloadProc,@FindData,Abort);
|
||||
if ProcName<>'' then
|
||||
begin
|
||||
// check for invalid overloads
|
||||
FindData:=Default(TFindOverloadProcData);
|
||||
FindData.Proc:=Proc;
|
||||
FindData.Args:=Proc.ProcType.Args;
|
||||
FindData.Kind:=fopkProc;
|
||||
Abort:=false;
|
||||
IterateElements(ProcName,@OnFindOverloadProc,@FindData,Abort);
|
||||
end;
|
||||
end
|
||||
else if El.Name<>'' then
|
||||
begin
|
||||
@ -6836,12 +6854,12 @@ begin
|
||||
else
|
||||
RaiseNotYetImplemented(20170203161826,ImplProc);
|
||||
end;
|
||||
if DeclProc is TPasFunction then
|
||||
if DeclProc.ProcType is TPasFunctionType then
|
||||
begin
|
||||
// redirect implementation 'Result' to declaration FuncType.ResultEl
|
||||
Identifier:=ImplProcScope.FindLocalIdentifier(ResolverResultVar);
|
||||
if Identifier.Element is TPasResultElement then
|
||||
Identifier.Element:=TPasFunction(DeclProc).FuncType.ResultEl;
|
||||
Identifier.Element:=TPasFunctionType(DeclProc.ProcType).ResultEl;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -6899,11 +6917,11 @@ begin
|
||||
RaiseXExpectedButYFound(20170216151729,DeclProc.TypeName,ImplProc.TypeName,ImplProc);
|
||||
if ImplProc.CallingConvention<>DeclProc.CallingConvention then
|
||||
RaiseMsg(20170216151731,nCallingConventionMismatch,sCallingConventionMismatch,[],ImplProc);
|
||||
if ImplProc is TPasFunction then
|
||||
if ImplProc.ProcType is TPasFunctionType then
|
||||
begin
|
||||
// check result type
|
||||
ImplResult:=TPasFunction(ImplProc).FuncType.ResultEl.ResultType;
|
||||
DeclResult:=TPasFunction(DeclProc).FuncType.ResultEl.ResultType;
|
||||
ImplResult:=TPasFunctionType(ImplProc.ProcType).ResultEl.ResultType;
|
||||
DeclResult:=TPasFunctionType(DeclProc.ProcType).ResultEl.ResultType;
|
||||
|
||||
if not CheckElTypeCompatibility(ImplResult,DeclResult,prraSimple) then
|
||||
RaiseIncompatibleType(20170216151734,nResultTypeMismatchExpectedButFound,
|
||||
@ -7827,6 +7845,7 @@ begin
|
||||
[],El);
|
||||
ResolveRecordValues(TRecordValues(El));
|
||||
end
|
||||
else if ElClass=TProcedureExpr then
|
||||
else
|
||||
RaiseNotYetImplemented(20170222184329,El);
|
||||
|
||||
@ -7882,7 +7901,7 @@ begin
|
||||
begin
|
||||
// examples: funca or @proca or a.funca or @a.funca ...
|
||||
Proc:=TPasProcedure(DeclEl);
|
||||
if (Access=rraAssign) and (Proc is TPasFunction)
|
||||
if (Access=rraAssign) and (Proc.ProcType is TPasFunctionType)
|
||||
and (El.ClassType=TPrimitiveExpr)
|
||||
and (El.Parent.ClassType=TPasImplAssign)
|
||||
and (TPasImplAssign(El.Parent).left=El) then
|
||||
@ -7895,7 +7914,7 @@ begin
|
||||
if El.HasParent(ImplProc) then
|
||||
begin
|
||||
// "FuncA:=" within FuncA -> redirect to ResultEl
|
||||
Ref.Declaration:=(Proc as TPasFunction).FuncType.ResultEl;
|
||||
Ref.Declaration:=TPasFunctionType(Proc.ProcType).ResultEl;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
@ -8499,7 +8518,7 @@ var
|
||||
if DeclEl is TPasProcedure then
|
||||
begin
|
||||
Proc:=TPasProcedure(DeclEl);
|
||||
if (Access=rraAssign) and (Proc is TPasFunction)
|
||||
if (Access=rraAssign) and (Proc.ProcType is TPasFunctionType)
|
||||
and (Value.ClassType=TPrimitiveExpr)
|
||||
and (Params.Parent.ClassType=TPasImplAssign)
|
||||
and (TPasImplAssign(Params.Parent).left=Params) then
|
||||
@ -8512,7 +8531,7 @@ var
|
||||
if Params.HasParent(ImplProc) then
|
||||
begin
|
||||
// "FuncA[]:=" within FuncA -> redirect to ResultEl
|
||||
Ref.Declaration:=(Proc as TPasFunction).FuncType.ResultEl;
|
||||
Ref.Declaration:=TPasFunctionType(Proc.ProcType).ResultEl;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -8930,7 +8949,8 @@ begin
|
||||
else if (Access in [rraRead,rraParamToUnknownProc])
|
||||
and ((C=TPrimitiveExpr)
|
||||
or (C=TNilExpr)
|
||||
or (C=TBoolConstExpr)) then
|
||||
or (C=TBoolConstExpr)
|
||||
or (C=TProcedureExpr)) then
|
||||
// ok
|
||||
else if C=TUnaryExpr then
|
||||
AccessExpr(TUnaryExpr(Expr).Operand,Access)
|
||||
@ -9350,10 +9370,10 @@ begin
|
||||
{$ENDIF}
|
||||
if not (TopScope is TPasIdentifierScope) then
|
||||
RaiseInvalidScopeForElement(20160922163522,El);
|
||||
// Note: El.ProcType is nil !
|
||||
// Note: El.ProcType is nil ! It is parsed later.
|
||||
ProcName:=El.Name;
|
||||
HasDot:=Pos('.',ProcName)>1;
|
||||
if not HasDot then
|
||||
if (not HasDot) and (ProcName<>'') then
|
||||
AddIdentifier(TPasIdentifierScope(TopScope),ProcName,El,pikProc);
|
||||
ProcScope:=TPasProcedureScope(PushScope(El,FScopeClass_Proc));
|
||||
ProcScope.ModeSwitches:=CurrentParser.CurrentModeswitches;
|
||||
@ -9420,7 +9440,7 @@ begin
|
||||
|
||||
ProcScope.VisibilityContext:=CurClassType;
|
||||
ProcScope.ClassScope:=NoNil(CurClassType.CustomData) as TPasClassScope;
|
||||
end;
|
||||
end;// HasDot=true
|
||||
end;
|
||||
|
||||
procedure TPasResolver.AddArgument(El: TPasArgument);
|
||||
@ -10500,9 +10520,9 @@ begin
|
||||
Proc:=TPasProcedure(ResolvedEl.IdentEl);
|
||||
if rcConstant in Flags then
|
||||
RaiseConstantExprExp(20170216152637,Params);
|
||||
if Proc is TPasFunction then
|
||||
if Proc.ProcType is TPasFunctionType then
|
||||
// function call => return result
|
||||
ComputeElement(TPasFunction(Proc).FuncType.ResultEl,ResolvedEl,
|
||||
ComputeElement(TPasFunctionType(Proc.ProcType).ResultEl,ResolvedEl,
|
||||
Flags+[rcNoImplicitProc],StartEl)
|
||||
else if (Proc.ClassType=TPasConstructor)
|
||||
and (rrfNewInstance in Ref.Flags) then
|
||||
@ -12498,6 +12518,7 @@ var
|
||||
ProcScope: TPasProcedureScope;
|
||||
ResultEl: TPasResultElement;
|
||||
Flags: TPasResolverComputeFlags;
|
||||
CtxProc: TPasProcedure;
|
||||
begin
|
||||
if (not (Expr is TParamsExpr)) or (length(TParamsExpr(Expr).Params)=0) then
|
||||
exit(cExact);
|
||||
@ -12515,14 +12536,15 @@ begin
|
||||
begin
|
||||
// first param is function result
|
||||
ProcScope:=TPasProcedureScope(Scopes[i]);
|
||||
if not (ProcScope.Element is TPasFunction) then
|
||||
CtxProc:=TPasProcedure(ProcScope.Element);
|
||||
if not (CtxProc.ProcType is TPasFunctionType) then
|
||||
begin
|
||||
if RaiseOnError then
|
||||
RaiseMsg(20170216152312,nWrongNumberOfParametersForCallTo,
|
||||
sWrongNumberOfParametersForCallTo,['procedure exit'],Params.Params[0]);
|
||||
exit(cIncompatible);
|
||||
end;
|
||||
ResultEl:=(ProcScope.Element as TPasFunction).FuncType.ResultEl;
|
||||
ResultEl:=TPasFunctionType(CtxProc.ProcType).ResultEl;
|
||||
ComputeElement(ResultEl,ResultResolved,[rcType]);
|
||||
end
|
||||
else
|
||||
@ -12937,9 +12959,9 @@ begin
|
||||
begin
|
||||
Expr:=TPasVariable(ParamResolved.IdentEl).Expr;
|
||||
if Expr is TArrayValues then
|
||||
Evaluated:=TResEvalInt.CreateValue(length(TArrayValues(Expr).Values)-1)
|
||||
Evaluated:=TResEvalInt.CreateValue(TMaxPrecInt(length(TArrayValues(Expr).Values))-1)
|
||||
else if (Expr is TParamsExpr) and (TParamsExpr(Expr).Kind=pekSet) then
|
||||
Evaluated:=TResEvalInt.CreateValue(length(TParamsExpr(Expr).Params)-1);
|
||||
Evaluated:=TResEvalInt.CreateValue(TMaxPrecInt(length(TParamsExpr(Expr).Params))-1);
|
||||
if Evaluated=nil then
|
||||
RaiseXExpectedButYFound(20170601191003,'array constant','expression',Params);
|
||||
end
|
||||
@ -13635,8 +13657,9 @@ begin
|
||||
aType:=TPasArgument(Decl).ArgType
|
||||
else if Decl.ClassType=TPasResultElement then
|
||||
aType:=TPasResultElement(Decl).ResultType
|
||||
else if Decl is TPasFunction then
|
||||
aType:=TPasFunction(Decl).FuncType.ResultEl.ResultType;
|
||||
else if (Decl is TPasProcedure)
|
||||
and (TPasProcedure(Decl).ProcType is TPasFunctionType) then
|
||||
aType:=TPasFunctionType(TPasProcedure(Decl).ProcType).ResultEl.ResultType;
|
||||
{$IFDEF VerbosePasResolver}
|
||||
{AllowWriteln}
|
||||
if aType=nil then
|
||||
@ -16446,7 +16469,7 @@ begin
|
||||
begin
|
||||
EnumType:=TPasEnumType(LTypeEl);
|
||||
LRangeValue:=TResEvalRangeInt.CreateValue(revskEnum,EnumType,
|
||||
0,EnumType.Values.Count-1);
|
||||
0,TMaxPrecInt(EnumType.Values.Count)-1);
|
||||
end
|
||||
else if C=TPasUnresolvedSymbolRef then
|
||||
begin
|
||||
@ -17047,7 +17070,15 @@ begin
|
||||
if CheckProcTypeCompatibility(TPasProcedureType(LHS.LoTypeEl),
|
||||
TPasProcedure(RHS.IdentEl).ProcType,true,ErrorEl,RaiseOnIncompatible) then
|
||||
exit(cExact);
|
||||
end;
|
||||
end
|
||||
else if (LHS.LoTypeEl is TPasProcedureType)
|
||||
and (RHS.ExprEl is TProcedureExpr) then
|
||||
begin
|
||||
// for example ProcVar:=anonymous-procedure...
|
||||
if CheckProcTypeCompatibility(TPasProcedureType(LHS.LoTypeEl),
|
||||
TProcedureExpr(RHS.ExprEl).Proc.ProcType,true,ErrorEl,RaiseOnIncompatible) then
|
||||
exit(cExact);
|
||||
end
|
||||
end
|
||||
else if LBT=btPointer then
|
||||
begin
|
||||
@ -19846,7 +19877,7 @@ begin
|
||||
begin
|
||||
TypeEl:=TPasProcedure(El).ProcType;
|
||||
SetResolverIdentifier(ResolvedEl,btProc,El,TypeEl,TypeEl,[rrfCanBeStatement]);
|
||||
if El is TPasFunction then
|
||||
if TPasProcedure(El).ProcType is TPasFunctionType then
|
||||
Include(ResolvedEl.Flags,rrfReadable);
|
||||
// Note: the readability of TPasConstructor depends on the context
|
||||
// Note: implicit calls are handled in TPrimitiveExpr
|
||||
@ -19857,6 +19888,11 @@ begin
|
||||
TPasProcedureType(El),TPasProcedureType(El),[rrfCanBeStatement]);
|
||||
// Note: implicit calls are handled in TPrimitiveExpr
|
||||
end
|
||||
else if ElClass=TProcedureExpr then
|
||||
begin
|
||||
TypeEl:=TProcedureExpr(El).Proc.ProcType;
|
||||
SetResolverValueExpr(ResolvedEl,btProc,TypeEl,TypeEl,TProcedureExpr(El),[rrfReadable]);
|
||||
end
|
||||
else if ElClass=TPasArrayType then
|
||||
SetResolverIdentifier(ResolvedEl,btContext,El,TPasArrayType(El),TPasArrayType(El),[])
|
||||
else if ElClass=TArrayValues then
|
||||
@ -20001,6 +20037,17 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPasResolver.GetParentProcBody(El: TPasElement): TProcedureBody;
|
||||
begin
|
||||
while El<>nil do
|
||||
begin
|
||||
if El is TProcedureBody then
|
||||
exit(TProcedureBody(El));
|
||||
El:=El.Parent;
|
||||
end;
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
function TPasResolver.ProcHasImplElements(Proc: TPasProcedure): boolean;
|
||||
begin
|
||||
Result:=GetProcFirstImplEl(Proc)<>nil;
|
||||
@ -20558,7 +20605,7 @@ begin
|
||||
else if C=TPasEnumType then
|
||||
begin
|
||||
Result:=TResEvalRangeInt.CreateValue(revskEnum,TPasEnumType(Decl),
|
||||
0,TPasEnumType(Decl).Values.Count-1);
|
||||
0,TMaxPrecInt(TPasEnumType(Decl).Values.Count)-1);
|
||||
Result.IdentEl:=Decl;
|
||||
exit;
|
||||
end
|
||||
|
||||
@ -82,6 +82,8 @@ resourcestring
|
||||
SPasTreeClassDestructor = 'class destructor';
|
||||
SPasTreeConstructor = 'constructor';
|
||||
SPasTreeDestructor = 'destructor';
|
||||
SPasTreeAnonymousProcedure = 'anonymous procedure';
|
||||
SPasTreeAnonymousFunction = 'anonymous function';
|
||||
SPasTreeProcedureImpl = 'procedure/function implementation';
|
||||
SPasTreeConstructorImpl = 'constructor implementation';
|
||||
SPasTreeDestructorImpl = 'destructor implementation';
|
||||
@ -192,7 +194,7 @@ type
|
||||
|
||||
TPasExprKind = (pekIdent, pekNumber, pekString, pekSet, pekNil, pekBoolConst,
|
||||
pekRange, pekUnary, pekBinary, pekFuncParams, pekArrayParams, pekListOfExp,
|
||||
pekInherited, pekSelf, pekSpecialize);
|
||||
pekInherited, pekSelf, pekSpecialize, pekProcedure);
|
||||
|
||||
TExprOpCode = (eopNone,
|
||||
eopAdd,eopSubtract,eopMultiply,eopDivide, eopDiv,eopMod, eopPower,// arithmetic
|
||||
@ -969,7 +971,8 @@ type
|
||||
ptOperator, ptClassOperator,
|
||||
ptConstructor, ptDestructor,
|
||||
ptClassProcedure, ptClassFunction,
|
||||
ptClassConstructor, ptClassDestructor);
|
||||
ptClassConstructor, ptClassDestructor,
|
||||
ptAnonymousProcedure, ptAnonymousFunction);
|
||||
|
||||
{ TPasProcedureBase }
|
||||
|
||||
@ -1004,6 +1007,8 @@ type
|
||||
|
||||
TProcedureBody = class;
|
||||
|
||||
{ TPasProcedure - named procedure, not anonymous }
|
||||
|
||||
TPasProcedure = class(TPasProcedureBase)
|
||||
Private
|
||||
FModifiers : TProcedureModifiers;
|
||||
@ -1020,13 +1025,13 @@ type
|
||||
procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
|
||||
const Arg: Pointer); override;
|
||||
public
|
||||
ProcType : TPasProcedureType;
|
||||
Body : TProcedureBody;
|
||||
PublicName, // e.g. public PublicName;
|
||||
LibrarySymbolName,
|
||||
LibraryExpr : TPasExpr; // e.g. external LibraryExpr name LibrarySymbolName;
|
||||
DispIDExpr : TPasExpr;
|
||||
AliasName : String;
|
||||
ProcType : TPasProcedureType;
|
||||
Body : TProcedureBody;
|
||||
Procedure AddModifier(AModifier : TProcedureModifier);
|
||||
Function IsVirtual : Boolean;
|
||||
Function IsDynamic : Boolean;
|
||||
@ -1039,6 +1044,7 @@ type
|
||||
Function IsReintroduced : Boolean;
|
||||
Function IsStatic : Boolean;
|
||||
Function IsForward: Boolean;
|
||||
Function GetProcTypeEnum: TProcType; virtual;
|
||||
Property Modifiers : TProcedureModifiers Read FModifiers Write FModifiers;
|
||||
Property CallingConvention : TCallingConvention Read GetCallingConvention Write SetCallingConvention;
|
||||
Property MessageName : String Read FMessageName Write FMessageName;
|
||||
@ -1048,14 +1054,16 @@ type
|
||||
|
||||
TArrayOfPasProcedure = array of TPasProcedure;
|
||||
|
||||
{ TPasFunction - named function, not anonymous function}
|
||||
|
||||
TPasFunction = class(TPasProcedure)
|
||||
private
|
||||
function GetFT: TPasFunctionType; inline;
|
||||
public
|
||||
function ElementTypeName: string; override;
|
||||
function TypeName: string; override;
|
||||
function GetDeclaration (full : boolean) : string; override;
|
||||
Property FuncType : TPasFunctionType Read GetFT;
|
||||
function GetProcTypeEnum: TProcType; override;
|
||||
end;
|
||||
|
||||
{ TPasOperator }
|
||||
@ -1082,17 +1090,18 @@ type
|
||||
Function OldName(WithPath : Boolean) : String;
|
||||
function ElementTypeName: string; override;
|
||||
function TypeName: string; override;
|
||||
function GetProcTypeEnum: TProcType; override;
|
||||
function GetDeclaration (full : boolean) : string; override;
|
||||
Property OperatorType : TOperatorType Read FOperatorType Write FOperatorType;
|
||||
// True if the declaration was using a token instead of an identifier
|
||||
Property TokenBased : Boolean Read FTokenBased Write FTokenBased;
|
||||
end;
|
||||
|
||||
Type
|
||||
{ TPasClassOperator }
|
||||
|
||||
TPasClassOperator = class(TPasOperator)
|
||||
function TypeName: string; override;
|
||||
function GetProcTypeEnum: TProcType; override;
|
||||
end;
|
||||
|
||||
|
||||
@ -1102,6 +1111,7 @@ Type
|
||||
public
|
||||
function ElementTypeName: string; override;
|
||||
function TypeName: string; override;
|
||||
function GetProcTypeEnum: TProcType; override;
|
||||
end;
|
||||
|
||||
{ TPasClassConstructor }
|
||||
@ -1110,6 +1120,7 @@ Type
|
||||
public
|
||||
function ElementTypeName: string; override;
|
||||
function TypeName: string; override;
|
||||
function GetProcTypeEnum: TProcType; override;
|
||||
end;
|
||||
|
||||
{ TPasDestructor }
|
||||
@ -1118,6 +1129,7 @@ Type
|
||||
public
|
||||
function ElementTypeName: string; override;
|
||||
function TypeName: string; override;
|
||||
function GetProcTypeEnum: TProcType; override;
|
||||
end;
|
||||
|
||||
{ TPasClassDestructor }
|
||||
@ -1126,6 +1138,7 @@ Type
|
||||
public
|
||||
function ElementTypeName: string; override;
|
||||
function TypeName: string; override;
|
||||
function GetProcTypeEnum: TProcType; override;
|
||||
end;
|
||||
|
||||
{ TPasClassProcedure }
|
||||
@ -1134,6 +1147,7 @@ Type
|
||||
public
|
||||
function ElementTypeName: string; override;
|
||||
function TypeName: string; override;
|
||||
function GetProcTypeEnum: TProcType; override;
|
||||
end;
|
||||
|
||||
{ TPasClassFunction }
|
||||
@ -1142,8 +1156,43 @@ Type
|
||||
public
|
||||
function ElementTypeName: string; override;
|
||||
function TypeName: string; override;
|
||||
function GetProcTypeEnum: TProcType; override;
|
||||
end;
|
||||
|
||||
{ TPasAnonymousProcedure - parent is TProcedureExpr }
|
||||
|
||||
TPasAnonymousProcedure = class(TPasProcedure)
|
||||
public
|
||||
function ElementTypeName: string; override;
|
||||
function TypeName: string; override;
|
||||
function GetProcTypeEnum: TProcType; override;
|
||||
end;
|
||||
|
||||
{ TPasAnonymousFunction - parent is TProcedureExpr and ProcType is TPasFunctionType}
|
||||
|
||||
TPasAnonymousFunction = class(TPasAnonymousProcedure)
|
||||
private
|
||||
function GetFT: TPasFunctionType; inline;
|
||||
public
|
||||
function ElementTypeName: string; override;
|
||||
function TypeName: string; override;
|
||||
Property FuncType : TPasFunctionType Read GetFT;
|
||||
function GetProcTypeEnum: TProcType; override;
|
||||
end;
|
||||
|
||||
{ TProcedureExpr }
|
||||
|
||||
TProcedureExpr = class(TPasExpr)
|
||||
public
|
||||
Proc: TPasAnonymousProcedure;
|
||||
constructor Create(AParent: TPasElement); overload;
|
||||
destructor Destroy; override;
|
||||
function GetDeclaration(full: Boolean): string; override;
|
||||
procedure ForEachCall(const aMethodCall: TOnForEachPasElement;
|
||||
const Arg: Pointer); override;
|
||||
end;
|
||||
|
||||
|
||||
TPasImplBlock = class;
|
||||
|
||||
{ TProcedureBody - the var+type+const+begin, without the header, child of TPasProcedure }
|
||||
@ -1577,7 +1626,8 @@ const
|
||||
'ListOfExp',
|
||||
'Inherited',
|
||||
'Self',
|
||||
'Specialize');
|
||||
'Specialize',
|
||||
'Procedure');
|
||||
|
||||
OpcodeStrings : Array[TExprOpCode] of string = (
|
||||
'','+','-','*','/','div','mod','**',
|
||||
@ -1643,6 +1693,26 @@ begin
|
||||
El:=nil;
|
||||
end;
|
||||
|
||||
Function IndentStrings(S : TStrings; indent : Integer) : string;
|
||||
Var
|
||||
I,CurrLen,CurrPos : Integer;
|
||||
begin
|
||||
Result:='';
|
||||
CurrLen:=0;
|
||||
CurrPos:=0;
|
||||
For I:=0 to S.Count-1 do
|
||||
begin
|
||||
CurrLen:=Length(S[i]);
|
||||
If (CurrLen+CurrPos)>72 then
|
||||
begin
|
||||
Result:=Result+LineEnding+StringOfChar(' ',Indent);
|
||||
CurrPos:=Indent;
|
||||
end;
|
||||
Result:=Result+S[i];
|
||||
CurrPos:=CurrPos+CurrLen;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$IFDEF HasPTDumpStack}
|
||||
procedure PTDumpStack;
|
||||
begin
|
||||
@ -1843,6 +1913,11 @@ begin
|
||||
Result:='class operator';
|
||||
end;
|
||||
|
||||
function TPasClassOperator.GetProcTypeEnum: TProcType;
|
||||
begin
|
||||
Result:=ptClassOperator;
|
||||
end;
|
||||
|
||||
{ TPasImplAsmStatement }
|
||||
|
||||
constructor TPasImplAsmStatement.Create(const AName: string;
|
||||
@ -1865,6 +1940,79 @@ begin
|
||||
Result:='class '+ inherited TypeName;
|
||||
end;
|
||||
|
||||
function TPasClassConstructor.GetProcTypeEnum: TProcType;
|
||||
begin
|
||||
Result:=ptClassConstructor;
|
||||
end;
|
||||
|
||||
{ TPasAnonymousProcedure }
|
||||
|
||||
function TPasAnonymousProcedure.ElementTypeName: string;
|
||||
begin
|
||||
Result:=SPasTreeAnonymousProcedure;
|
||||
end;
|
||||
|
||||
function TPasAnonymousProcedure.TypeName: string;
|
||||
begin
|
||||
Result:='anonymous procedure';
|
||||
end;
|
||||
|
||||
function TPasAnonymousProcedure.GetProcTypeEnum: TProcType;
|
||||
begin
|
||||
Result:=ptAnonymousProcedure;
|
||||
end;
|
||||
|
||||
{ TPasAnonymousFunction }
|
||||
|
||||
function TPasAnonymousFunction.GetFT: TPasFunctionType;
|
||||
begin
|
||||
Result:=ProcType as TPasFunctionType;
|
||||
end;
|
||||
|
||||
function TPasAnonymousFunction.ElementTypeName: string;
|
||||
begin
|
||||
Result := SPasTreeAnonymousFunction;
|
||||
end;
|
||||
|
||||
function TPasAnonymousFunction.TypeName: string;
|
||||
begin
|
||||
Result:='anonymous function';
|
||||
end;
|
||||
|
||||
function TPasAnonymousFunction.GetProcTypeEnum: TProcType;
|
||||
begin
|
||||
Result:=ptAnonymousFunction;
|
||||
end;
|
||||
|
||||
{ TProcedureExpr }
|
||||
|
||||
constructor TProcedureExpr.Create(AParent: TPasElement);
|
||||
begin
|
||||
inherited Create(AParent,pekProcedure, eopNone);
|
||||
end;
|
||||
|
||||
destructor TProcedureExpr.Destroy;
|
||||
begin
|
||||
ReleaseAndNil(TPasElement(Proc){$IFDEF CheckPasTreeRefCount},'TProcedureExpr.Proc'{$ENDIF});
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
function TProcedureExpr.GetDeclaration(full: Boolean): string;
|
||||
begin
|
||||
if Proc<>nil then
|
||||
Result:=Proc.GetDeclaration(full)
|
||||
else
|
||||
Result:='procedure-expr';
|
||||
end;
|
||||
|
||||
procedure TProcedureExpr.ForEachCall(const aMethodCall: TOnForEachPasElement;
|
||||
const Arg: Pointer);
|
||||
begin
|
||||
inherited ForEachCall(aMethodCall, Arg);
|
||||
if Proc<>nil then
|
||||
Proc.ForEachCall(aMethodCall,Arg);
|
||||
end;
|
||||
|
||||
{ TPasImplRaise }
|
||||
|
||||
destructor TPasImplRaise.Destroy;
|
||||
@ -2157,7 +2305,7 @@ begin
|
||||
Result:=ProcType as TPasFunctionType;
|
||||
end;
|
||||
|
||||
function TPasFunction.ElementTypeName: string; begin Result := SPasTreeFunction end;
|
||||
function TPasFunction.ElementTypeName: string; begin Result := SPasTreeFunction; end;
|
||||
function TPasClassProcedure.ElementTypeName: string; begin Result := SPasTreeClassProcedure; end;
|
||||
function TPasClassConstructor.ElementTypeName: string; begin Result := SPasTreeClassConstructor; end;
|
||||
function TPasClassDestructor.ElementTypeName: string; begin Result := SPasTreeClassDestructor; end;
|
||||
@ -2167,6 +2315,11 @@ begin
|
||||
Result:='destructor';
|
||||
end;
|
||||
|
||||
function TPasClassDestructor.GetProcTypeEnum: TProcType;
|
||||
begin
|
||||
Result:=ptClassDestructor;
|
||||
end;
|
||||
|
||||
function TPasClassFunction.ElementTypeName: string; begin Result := SPasTreeClassFunction; end;
|
||||
|
||||
class function TPasOperator.OperatorTypeToToken(T: TOperatorType): String;
|
||||
@ -3229,12 +3382,12 @@ end;
|
||||
|
||||
destructor TPasProcedure.Destroy;
|
||||
begin
|
||||
ReleaseAndNil(TPasElement(ProcType){$IFDEF CheckPasTreeRefCount},'TPasProcedure.ProcType'{$ENDIF});
|
||||
ReleaseAndNil(TPasElement(Body){$IFDEF CheckPasTreeRefCount},'TPasProcedure.Body'{$ENDIF});
|
||||
ReleaseAndNil(TPasElement(PublicName){$IFDEF CheckPasTreeRefCount},'TPasProcedure.PublicName'{$ENDIF});
|
||||
ReleaseAndNil(TPasElement(LibraryExpr){$IFDEF CheckPasTreeRefCount},'TPasProcedure.LibraryExpr'{$ENDIF});
|
||||
ReleaseAndNil(TPasElement(LibrarySymbolName){$IFDEF CheckPasTreeRefCount},'TPasProcedure.LibrarySymbolName'{$ENDIF});
|
||||
ReleaseAndNil(TPasElement(DispIDExpr){$IFDEF CheckPasTreeRefCount},'TPasProcedure.DispIDExpr'{$ENDIF});
|
||||
ReleaseAndNil(TPasElement(ProcType){$IFDEF CheckPasTreeRefCount},'TPasProcedure.ProcType'{$ENDIF});
|
||||
ReleaseAndNil(TPasElement(Body){$IFDEF CheckPasTreeRefCount},'TPasProcedure.Body'{$ENDIF});
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
@ -3764,29 +3917,6 @@ begin
|
||||
ForEachChildCall(aMethodCall,Arg,ElType,true);
|
||||
end;
|
||||
|
||||
Function IndentStrings(S : TStrings; indent : Integer) : string;
|
||||
|
||||
Var
|
||||
I,CurrLen,CurrPos : Integer;
|
||||
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
CurrLen:=0;
|
||||
CurrPos:=0;
|
||||
For I:=0 to S.Count-1 do
|
||||
begin
|
||||
CurrLen:=Length(S[i]);
|
||||
If (CurrLen+CurrPos)>72 then
|
||||
begin
|
||||
Result:=Result+LineEnding+StringOfChar(' ',Indent);
|
||||
CurrPos:=Indent;
|
||||
end;
|
||||
Result:=Result+S[i];
|
||||
CurrPos:=CurrPos+CurrLen;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPasEnumType.GetDeclaration (full : boolean) : string;
|
||||
|
||||
Var
|
||||
@ -4278,8 +4408,8 @@ procedure TPasProcedure.ForEachCall(const aMethodCall: TOnForEachPasElement;
|
||||
const Arg: Pointer);
|
||||
begin
|
||||
inherited ForEachCall(aMethodCall, Arg);
|
||||
ForEachChildCall(aMethodCall,Arg,PublicName,false);
|
||||
ForEachChildCall(aMethodCall,Arg,ProcType,false);
|
||||
ForEachChildCall(aMethodCall,Arg,PublicName,false);
|
||||
ForEachChildCall(aMethodCall,Arg,LibraryExpr,false);
|
||||
ForEachChildCall(aMethodCall,Arg,LibrarySymbolName,false);
|
||||
ForEachChildCall(aMethodCall,Arg,Body,false);
|
||||
@ -4347,36 +4477,28 @@ begin
|
||||
Result:=pmForward in FModifiers;
|
||||
end;
|
||||
|
||||
function TPasProcedure.GetDeclaration(full: Boolean): string;
|
||||
|
||||
Var
|
||||
S : TStringList;
|
||||
function TPasProcedure.GetProcTypeEnum: TProcType;
|
||||
begin
|
||||
S:=TStringList.Create;
|
||||
try
|
||||
If Full then
|
||||
S.Add(TypeName+' '+Name);
|
||||
ProcType.GetArguments(S);
|
||||
GetModifiers(S);
|
||||
Result:=IndentStrings(S,Length(S[0]));
|
||||
finally
|
||||
S.Free;
|
||||
end;
|
||||
Result:=ptProcedure;
|
||||
end;
|
||||
|
||||
function TPasFunction.GetDeclaration (full : boolean) : string;
|
||||
|
||||
function TPasProcedure.GetDeclaration(full: Boolean): string;
|
||||
Var
|
||||
S : TStringList;
|
||||
T : string;
|
||||
|
||||
T: String;
|
||||
begin
|
||||
S:=TStringList.Create;
|
||||
try
|
||||
If Full then
|
||||
S.Add(TypeName+' '+Name);
|
||||
begin
|
||||
T:=TypeName;
|
||||
if Name<>'' then
|
||||
T:=T+' '+Name;
|
||||
S.Add(T);
|
||||
end;
|
||||
ProcType.GetArguments(S);
|
||||
If Assigned((Proctype as TPasFunctionType).ResultEl) then
|
||||
If ProcType is TPasFunctionType
|
||||
and Assigned(TPasFunctionType(Proctype).ResultEl) then
|
||||
With TPasFunctionType(ProcType).ResultEl.ResultType do
|
||||
begin
|
||||
T:=' : ';
|
||||
@ -4398,6 +4520,11 @@ begin
|
||||
Result:='function';
|
||||
end;
|
||||
|
||||
function TPasFunction.GetProcTypeEnum: TProcType;
|
||||
begin
|
||||
Result:=ptFunction;
|
||||
end;
|
||||
|
||||
function TPasOperator.GetOperatorDeclaration(Full : Boolean) : string;
|
||||
|
||||
begin
|
||||
@ -4450,26 +4577,51 @@ begin
|
||||
Result:='operator';
|
||||
end;
|
||||
|
||||
function TPasOperator.GetProcTypeEnum: TProcType;
|
||||
begin
|
||||
Result:=ptOperator;
|
||||
end;
|
||||
|
||||
function TPasClassProcedure.TypeName: string;
|
||||
begin
|
||||
Result:='class procedure';
|
||||
end;
|
||||
|
||||
function TPasClassProcedure.GetProcTypeEnum: TProcType;
|
||||
begin
|
||||
Result:=ptClassProcedure;
|
||||
end;
|
||||
|
||||
function TPasClassFunction.TypeName: string;
|
||||
begin
|
||||
Result:='class function';
|
||||
end;
|
||||
|
||||
function TPasClassFunction.GetProcTypeEnum: TProcType;
|
||||
begin
|
||||
Result:=ptClassFunction;
|
||||
end;
|
||||
|
||||
function TPasConstructor.TypeName: string;
|
||||
begin
|
||||
Result:='constructor';
|
||||
end;
|
||||
|
||||
function TPasConstructor.GetProcTypeEnum: TProcType;
|
||||
begin
|
||||
Result:=ptConstructor;
|
||||
end;
|
||||
|
||||
function TPasDestructor.TypeName: string;
|
||||
begin
|
||||
Result:='destructor';
|
||||
end;
|
||||
|
||||
function TPasDestructor.GetProcTypeEnum: TProcType;
|
||||
begin
|
||||
Result:=ptDestructor;
|
||||
end;
|
||||
|
||||
function TPasArgument.GetDeclaration (full : boolean) : string;
|
||||
begin
|
||||
If Assigned(ArgType) then
|
||||
|
||||
@ -314,7 +314,7 @@ type
|
||||
function ReadDottedIdentifier(Parent: TPasElement; out Expr: TPasExpr; NeedAsString: boolean): String;
|
||||
function CheckProcedureArgs(Parent: TPasElement;
|
||||
Args: TFPList; // list of TPasArgument
|
||||
Mandatory: Boolean): boolean;
|
||||
ProcType: TProcType): boolean;
|
||||
function CheckVisibility(S: String; var AVisibility: TPasMemberVisibility): Boolean;
|
||||
procedure ParseExc(MsgNumber: integer; const Msg: String);
|
||||
procedure ParseExc(MsgNumber: integer; const Fmt: String; Args : Array of {$ifdef pas2js}jsvalue{$else}const{$endif});
|
||||
@ -349,12 +349,15 @@ type
|
||||
function CreateRecordValues(AParent : TPasElement): TRecordValues;
|
||||
Function IsCurTokenHint(out AHint : TPasMemberHint) : Boolean; overload;
|
||||
Function IsCurTokenHint: Boolean; overload;
|
||||
Function TokenIsCallingConvention(const S : String; out CC : TCallingConvention) : Boolean; virtual;
|
||||
Function TokenIsProcedureModifier(Parent : TPasElement; const S : String; Out PM : TProcedureModifier) : Boolean; virtual;
|
||||
Function TokenIsCallingConvention(const S: String; out CC : TCallingConvention) : Boolean; virtual;
|
||||
Function TokenIsProcedureModifier(Parent: TPasElement; const S: String; Out PM : TProcedureModifier): Boolean; virtual;
|
||||
Function TokenIsAnonymousProcedureModifier(Parent: TPasElement; S: String; Out PM: TProcedureModifier): Boolean; virtual;
|
||||
Function TokenIsProcedureTypeModifier(Parent : TPasElement; const S : String; Out PTM : TProcTypeModifier) : Boolean; virtual;
|
||||
Function CheckHint(Element : TPasElement; ExpectSemiColon : Boolean) : TPasMemberHints;
|
||||
function IsAnonymousProcAllowed(El: TPasElement): boolean; virtual;
|
||||
function ParseParams(AParent : TPasElement; ParamsKind: TPasExprKind; AllowFormatting : Boolean = False): TParamsExpr;
|
||||
function ParseExpIdent(AParent : TPasElement): TPasExpr;
|
||||
function ParseExprOperand(AParent : TPasElement): TPasExpr;
|
||||
function ParseExpIdent(AParent : TPasElement): TPasExpr; deprecated 'use ParseExprOperand instead'; // since fpc 3.3.1
|
||||
procedure DoParseClassType(AType: TPasClassType);
|
||||
function DoParseExpression(AParent: TPaselement;InitExpr: TPasExpr=nil; AllowEqual : Boolean = True): TPasExpr;
|
||||
function DoParseConstValueExpression(AParent: TPasElement): TPasExpr;
|
||||
@ -1241,6 +1244,21 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPasParser.TokenIsAnonymousProcedureModifier(Parent: TPasElement;
|
||||
S: String; out PM: TProcedureModifier): Boolean;
|
||||
begin
|
||||
S:=LowerCase(S);
|
||||
case S of
|
||||
'assembler':
|
||||
begin
|
||||
PM:=pmAssembler;
|
||||
exit(true);
|
||||
end;
|
||||
end;
|
||||
Result:=false;
|
||||
if Parent=nil then ;
|
||||
end;
|
||||
|
||||
function TPasParser.TokenIsProcedureTypeModifier(Parent: TPasElement;
|
||||
const S: String; out PTM: TProcTypeModifier): Boolean;
|
||||
begin
|
||||
@ -1291,6 +1309,17 @@ begin
|
||||
ExpectToken(tkSemiColon);
|
||||
end;
|
||||
|
||||
function TPasParser.IsAnonymousProcAllowed(El: TPasElement): boolean;
|
||||
begin
|
||||
while El is TPasExpr do
|
||||
El:=El.Parent;
|
||||
if not (El is TPasImplBlock) then
|
||||
exit(false); // only in statements
|
||||
while El is TPasImplBlock do
|
||||
El:=El.Parent;
|
||||
Result:=El is TProcedureBody; // needs a parent procedure
|
||||
end;
|
||||
|
||||
function TPasParser.CheckPackMode: TPackMode;
|
||||
|
||||
begin
|
||||
@ -2007,6 +2036,7 @@ begin
|
||||
begin
|
||||
repeat
|
||||
Expr:=DoParseExpression(Params);
|
||||
writeln('AAA1 TPasParser.ParseParams ',CurTokenString,' ',curtoken);
|
||||
if not Assigned(Expr) then
|
||||
ParseExcSyntaxError;
|
||||
Params.AddParam(Expr);
|
||||
@ -2081,7 +2111,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
|
||||
function TPasParser.ParseExprOperand(AParent: TPasElement): TPasExpr;
|
||||
|
||||
Function IsWriteOrStr(P : TPasExpr) : boolean;
|
||||
|
||||
@ -2109,7 +2139,7 @@ function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
|
||||
begin // self.Write(EscapeText(AText));
|
||||
optk:=CurToken;
|
||||
NextToken;
|
||||
b:=CreateBinaryExpr(AParent,Last, ParseExpIdent(AParent), TokenToExprOp(optk));
|
||||
b:=CreateBinaryExpr(AParent,Last, ParseExprOperand(AParent), TokenToExprOp(optk));
|
||||
if not Assigned(b.right) then
|
||||
begin
|
||||
b.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
|
||||
@ -2180,15 +2210,16 @@ var
|
||||
ISE: TInlineSpecializeExpr;
|
||||
ST: TPasSpecializeType;
|
||||
SrcPos, ScrPos: TPasSourcePos;
|
||||
ProcType: TProcType;
|
||||
|
||||
begin
|
||||
Result:=nil;
|
||||
CanSpecialize:=false;
|
||||
aName:='';
|
||||
case CurToken of
|
||||
tkString: Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString);
|
||||
tkChar: Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenText);
|
||||
tkNumber: Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
|
||||
tkString: Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenString);
|
||||
tkChar: Last:=CreatePrimitiveExpr(AParent,pekString,CurTokenText);
|
||||
tkNumber: Last:=CreatePrimitiveExpr(AParent,pekNumber,CurTokenString);
|
||||
tkIdentifier:
|
||||
begin
|
||||
CanSpecialize:=true;
|
||||
@ -2212,7 +2243,7 @@ begin
|
||||
if (CurToken=tkIdentifier) then
|
||||
begin
|
||||
SrcPos:=CurTokenPos;
|
||||
Bin:=CreateBinaryExpr(AParent,Last,ParseExpIdent(AParent),eopNone,SrcPos);
|
||||
Bin:=CreateBinaryExpr(AParent,Last,ParseExprOperand(AParent),eopNone,SrcPos);
|
||||
if not Assigned(Bin.right) then
|
||||
begin
|
||||
Bin.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
|
||||
@ -2230,6 +2261,27 @@ begin
|
||||
Last:=CreateSelfExpr(AParent);
|
||||
HandleSelf(Last);
|
||||
end;
|
||||
tkprocedure,tkfunction:
|
||||
begin
|
||||
if CurToken=tkprocedure then
|
||||
ProcType:=ptAnonymousProcedure
|
||||
else
|
||||
ProcType:=ptAnonymousFunction;
|
||||
if not IsAnonymousProcAllowed(AParent) then
|
||||
ParseExcExpectedIdentifier;
|
||||
ok:=false;
|
||||
try
|
||||
Result:=TProcedureExpr(CreateElement(TProcedureExpr,'',AParent,visPublic));
|
||||
TProcedureExpr(Result).Proc:=TPasAnonymousProcedure(ParseProcedureOrFunctionDecl(Result,ProcType));
|
||||
if CurToken=tkSemicolon then
|
||||
NextToken; // skip optional semicolon
|
||||
ok:=true;
|
||||
finally
|
||||
if not ok then
|
||||
Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
|
||||
end;
|
||||
exit; // do not allow postfix operators . ^. [] ()
|
||||
end;
|
||||
tkCaret:
|
||||
begin
|
||||
// is this still needed?
|
||||
@ -2329,6 +2381,11 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
|
||||
begin
|
||||
Result:=ParseExprOperand(AParent);
|
||||
end;
|
||||
|
||||
function TPasParser.OpLevel(t: TToken): Integer;
|
||||
begin
|
||||
case t of
|
||||
@ -2491,12 +2548,12 @@ begin
|
||||
if (CurToken=tkDot) then
|
||||
begin
|
||||
NextToken;
|
||||
x:=CreateBinaryExpr(AParent,x, ParseExpIdent(AParent), TokenToExprOp(tkDot));
|
||||
x:=CreateBinaryExpr(AParent,x, ParseExprOperand(AParent), TokenToExprOp(tkDot));
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
x:=ParseExpIdent(AParent);
|
||||
x:=ParseExprOperand(AParent);
|
||||
if not Assigned(x) then
|
||||
ParseExcSyntaxError;
|
||||
end;
|
||||
@ -4584,12 +4641,11 @@ end;
|
||||
|
||||
|
||||
function TPasParser.CheckProcedureArgs(Parent: TPasElement; Args: TFPList;
|
||||
Mandatory: Boolean): boolean;
|
||||
ProcType: TProcType): boolean;
|
||||
|
||||
begin
|
||||
NextToken;
|
||||
case CurToken of
|
||||
tkBraceOpen:
|
||||
if CurToken=tkBraceOpen then
|
||||
begin
|
||||
Result:=true;
|
||||
NextToken;
|
||||
@ -4598,18 +4654,34 @@ begin
|
||||
UngetToken;
|
||||
ParseArgList(Parent, Args, tkBraceClose);
|
||||
end;
|
||||
end;
|
||||
tkSemicolon,tkColon,tkof,tkis,tkIdentifier:
|
||||
begin
|
||||
Result:=false;
|
||||
if Mandatory then
|
||||
ParseExc(nParserExpectedLBracketColon,SParserExpectedLBracketColon)
|
||||
else
|
||||
UngetToken;
|
||||
end
|
||||
else
|
||||
ParseExcTokenError(';');
|
||||
end;
|
||||
begin
|
||||
Result:=false;
|
||||
case ProcType of
|
||||
ptOperator,ptClassOperator:
|
||||
ParseExc(nParserExpectedLBracketColon,SParserExpectedLBracketColon);
|
||||
ptAnonymousProcedure,ptAnonymousFunction:
|
||||
case CurToken of
|
||||
tkIdentifier, // e.g. procedure assembler
|
||||
tkbegin,tkvar,tkconst,tktype,tkprocedure,tkfunction:
|
||||
UngetToken;
|
||||
else
|
||||
ParseExcTokenError('begin');
|
||||
end;
|
||||
else
|
||||
case CurToken of
|
||||
tkSemicolon, // e.g. procedure;
|
||||
tkColon, // e.g. function: id
|
||||
tkof, // e.g. procedure of object
|
||||
tkis, // e.g. procedure is nested
|
||||
tkIdentifier: // e.g. procedure cdecl;
|
||||
UngetToken;
|
||||
else
|
||||
ParseExcTokenError(';');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPasParser.HandleProcedureModifier(Parent: TPasElement; pm: TProcedureModifier);
|
||||
@ -4800,20 +4872,22 @@ Var
|
||||
Tok : String;
|
||||
CC : TCallingConvention;
|
||||
PM : TProcedureModifier;
|
||||
Done: Boolean;
|
||||
ResultEl: TPasResultElement;
|
||||
OK,IsProc : Boolean;
|
||||
OK: Boolean;
|
||||
IsProc: Boolean; // true = procedure, false = procedure type
|
||||
IsAnonymProc: Boolean;
|
||||
PTM: TProcTypeModifier;
|
||||
ModCount: Integer;
|
||||
ModTokenCount: Integer;
|
||||
LastToken: TToken;
|
||||
|
||||
begin
|
||||
// Element must be non-nil. Removed all checks for not-nil.
|
||||
// If it is nil, the following fails anyway.
|
||||
CheckProcedureArgs(Element,Element.Args,ProcType in [ptOperator,ptClassOperator]);
|
||||
CheckProcedureArgs(Element,Element.Args,ProcType);
|
||||
IsProc:=Parent is TPasProcedure;
|
||||
IsAnonymProc:=IsProc and (ProcType in [ptAnonymousProcedure,ptAnonymousFunction]);
|
||||
case ProcType of
|
||||
ptFunction,ptClassFunction:
|
||||
ptFunction,ptClassFunction,ptAnonymousFunction:
|
||||
begin
|
||||
NextToken;
|
||||
if CurToken = tkColon then
|
||||
@ -4882,13 +4956,13 @@ begin
|
||||
else
|
||||
UnGetToken;
|
||||
end;
|
||||
ModCount:=0;
|
||||
ModTokenCount:=0;
|
||||
Repeat
|
||||
inc(ModCount);
|
||||
// Writeln(modcount, curtokentext);
|
||||
inc(ModTokenCount);
|
||||
// Writeln(ModTokenCount, curtokentext);
|
||||
LastToken:=CurToken;
|
||||
NextToken;
|
||||
if (ModCount<=3) and (CurToken = tkEqual) and not (Parent is TPasProcedure) then
|
||||
if (CurToken = tkEqual) and not IsProc and (ModTokenCount<=3) then
|
||||
begin
|
||||
// for example: const p: procedure = nil;
|
||||
UngetToken;
|
||||
@ -4899,6 +4973,7 @@ begin
|
||||
begin
|
||||
if LastToken=tkSemicolon then
|
||||
ParseExcSyntaxError;
|
||||
continue;
|
||||
end
|
||||
else if TokenIsCallingConvention(CurTokenString,cc) then
|
||||
begin
|
||||
@ -4917,11 +4992,18 @@ begin
|
||||
NextToken; // remove offset
|
||||
end;
|
||||
end;
|
||||
ExpectTokens([tkSemicolon,tkEqual]);
|
||||
if CurToken=tkEqual then
|
||||
UngetToken;
|
||||
if IsProc then
|
||||
ExpectTokens([tkSemicolon])
|
||||
else
|
||||
begin
|
||||
ExpectTokens([tkSemicolon,tkEqual]);
|
||||
if CurToken=tkEqual then
|
||||
UngetToken;
|
||||
end;
|
||||
end
|
||||
else if IsProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
|
||||
else if IsAnonymProc and TokenIsAnonymousProcedureModifier(Parent,CurTokenString,PM) then
|
||||
HandleProcedureModifier(Parent,PM)
|
||||
else if IsProc and not IsAnonymProc and TokenIsProcedureModifier(Parent,CurTokenString,PM) then
|
||||
HandleProcedureModifier(Parent,PM)
|
||||
else if TokenIsProcedureTypeModifier(Parent,CurTokenString,PTM) then
|
||||
HandleProcedureTypeModifier(Element,PTM)
|
||||
@ -4930,16 +5012,22 @@ begin
|
||||
Tok:=UpperCase(CurTokenString);
|
||||
NextToken;
|
||||
If (tok<>'NAME') then
|
||||
Element.Hints:=Element.Hints+[hLibrary]
|
||||
begin
|
||||
if hLibrary in Element.Hints then
|
||||
ParseExcSyntaxError;
|
||||
Element.Hints:=Element.Hints+[hLibrary];
|
||||
end
|
||||
else
|
||||
begin
|
||||
NextToken; // Should be export name string.
|
||||
NextToken; // Should be "export name astring".
|
||||
ExpectToken(tkSemicolon);
|
||||
end;
|
||||
end
|
||||
else if DoCheckHint(Element) then
|
||||
else if (not IsAnonymProc) and DoCheckHint(Element) then
|
||||
// deprecated,platform,experimental,library, unimplemented etc
|
||||
ConsumeSemi
|
||||
else if (CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0) then
|
||||
else if (CurToken=tkIdentifier) and (not IsAnonymProc)
|
||||
and (CompareText(CurTokenText,'alias')=0) then
|
||||
begin
|
||||
ExpectToken(tkColon);
|
||||
ExpectToken(tkString);
|
||||
@ -4959,44 +5047,48 @@ begin
|
||||
begin
|
||||
// ToDo: read FPC's [] modifiers, e.g. [public,alias:'']
|
||||
repeat
|
||||
NextToken
|
||||
NextToken;
|
||||
if CurToken in [tkSquaredBraceOpen,tkSemicolon] then
|
||||
CheckToken(tkSquaredBraceClose);
|
||||
until CurToken = tkSquaredBraceClose;
|
||||
ExpectToken(tkSemicolon);
|
||||
end;
|
||||
end
|
||||
else
|
||||
CheckToken(tkSemicolon);
|
||||
Done:=(CurToken=tkSemiColon);
|
||||
if Done then
|
||||
begin
|
||||
NextToken;
|
||||
Done:=Not ((Curtoken=tkSquaredBraceOpen) or
|
||||
TokenIsProcedureModifier(Parent,CurtokenString,PM) or
|
||||
TokenIsProcedureTypeModifier(Parent,CurtokenString,PTM) or
|
||||
IsCurTokenHint() or
|
||||
TokenIsCallingConvention(CurTokenString,cc) or
|
||||
(CurToken=tkIdentifier) and (CompareText(CurTokenText,'alias')=0));
|
||||
{$ifdef VerbosePasParser}
|
||||
DumpCurToken('Done '+IntToStr(Ord(Done)));
|
||||
{$endif}
|
||||
UngetToken;
|
||||
// not a modifier/hint/calling convention
|
||||
if LastToken=tkSemicolon then
|
||||
begin
|
||||
UngetToken;
|
||||
if IsAnonymProc and (ModTokenCount<=1) then
|
||||
ParseExcSyntaxError;
|
||||
break;
|
||||
end
|
||||
else if IsAnonymProc then
|
||||
begin
|
||||
UngetToken;
|
||||
break;
|
||||
end
|
||||
else
|
||||
begin
|
||||
CheckToken(tkSemicolon);
|
||||
continue;
|
||||
end;
|
||||
end;
|
||||
|
||||
// Writeln('Done: ',TokenInfos[Curtoken],' ',CurtokenString);
|
||||
Until Done;
|
||||
if DoCheckHint(Element) then // deprecated,platform,experimental,library, unimplemented etc
|
||||
ConsumeSemi;
|
||||
// Writeln('Done: ',TokenInfos[Curtoken],' ',CurtokenString);
|
||||
Until false;
|
||||
if (ProcType in [ptOperator,ptClassOperator]) and (Parent is TPasOperator) then
|
||||
TPasOperator(Parent).CorrectName;
|
||||
Engine.FinishScope(stProcedureHeader,Element);
|
||||
if (Parent is TPasProcedure)
|
||||
if IsProc
|
||||
and (not TPasProcedure(Parent).IsForward)
|
||||
and (not TPasProcedure(Parent).IsExternal)
|
||||
and ((Parent.Parent is TImplementationSection)
|
||||
or (Parent.Parent is TProcedureBody))
|
||||
or (Parent.Parent is TProcedureBody)
|
||||
or IsAnonymProc)
|
||||
then
|
||||
ParseProcedureBody(Parent);
|
||||
if Parent is TPasProcedure then
|
||||
if IsProc then
|
||||
Engine.FinishScope(stProcedure,Parent);
|
||||
end;
|
||||
|
||||
@ -5257,6 +5349,7 @@ procedure TPasParser.ParseProcBeginBlock(Parent: TProcedureBody);
|
||||
var
|
||||
BeginBlock: TPasImplBeginBlock;
|
||||
SubBlock: TPasImplElement;
|
||||
Proc: TPasProcedure;
|
||||
begin
|
||||
BeginBlock := TPasImplBeginBlock(CreateElement(TPasImplBeginBlock, '', Parent));
|
||||
Parent.Body := BeginBlock;
|
||||
@ -5273,7 +5366,11 @@ begin
|
||||
ExpectToken(tkend);
|
||||
end;
|
||||
until false;
|
||||
ExpectToken(tkSemicolon);
|
||||
Proc:=Parent.Parent as TPasProcedure;
|
||||
if Proc.GetProcTypeEnum in [ptAnonymousProcedure,ptAnonymousFunction] then
|
||||
NextToken
|
||||
else
|
||||
ExpectToken(tkSemicolon);
|
||||
// writeln('TPasParser.ParseProcBeginBlock ended ',curtokenstring);
|
||||
end;
|
||||
|
||||
@ -5974,12 +6071,15 @@ begin
|
||||
ptDestructor : Result:=TPasDestructor;
|
||||
ptOperator : Result:=TPasOperator;
|
||||
ptClassOperator : Result:=TPasClassOperator;
|
||||
ptAnonymousProcedure: Result:=TPasAnonymousProcedure;
|
||||
ptAnonymousFunction: Result:=TPasAnonymousFunction;
|
||||
else
|
||||
ParseExc(nParserUnknownProcedureType,SParserUnknownProcedureType,[Ord(ProcType)]);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement; ProcType: TProcType;AVisibility : TPasMemberVisibility = VisDefault): TPasProcedure;
|
||||
function TPasParser.ParseProcedureOrFunctionDecl(Parent: TPasElement;
|
||||
ProcType: TProcType; AVisibility: TPasMemberVisibility): TPasProcedure;
|
||||
|
||||
function ExpectProcName: string;
|
||||
|
||||
@ -6023,9 +6123,8 @@ var
|
||||
IsTokenBased , ok: Boolean;
|
||||
|
||||
begin
|
||||
If (Not (ProcType in [ptOperator,ptClassOperator])) then
|
||||
Name:=ExpectProcName
|
||||
else
|
||||
case ProcType of
|
||||
ptOperator,ptClassOperator:
|
||||
begin
|
||||
NextToken;
|
||||
IsTokenBased:=Curtoken<>tkIdentifier;
|
||||
@ -6037,14 +6136,19 @@ begin
|
||||
ParseExc(nErrUnknownOperatorType,SErrUnknownOperatorType,[CurTokenString]);
|
||||
Name:=OperatorNames[Ot];
|
||||
end;
|
||||
ptAnonymousProcedure,ptAnonymousFunction:
|
||||
Name:='';
|
||||
else
|
||||
Name:=ExpectProcName;
|
||||
end;
|
||||
PC:=GetProcedureClass(ProcType);
|
||||
Parent:=CheckIfOverLoaded(Parent,Name);
|
||||
if Name<>'' then
|
||||
Parent:=CheckIfOverLoaded(Parent,Name);
|
||||
Result:=TPasProcedure(CreateElement(PC,Name,Parent,AVisibility));
|
||||
ok:=false;
|
||||
try
|
||||
if Not (ProcType in [ptFunction, ptClassFunction, ptOperator, ptClassOperator]) then
|
||||
Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result))
|
||||
else
|
||||
case ProcType of
|
||||
ptFunction, ptClassFunction, ptOperator, ptClassOperator, ptAnonymousFunction:
|
||||
begin
|
||||
Result.ProcType := CreateFunctionType('', 'Result', Result, False, CurTokenPos);
|
||||
if (ProcType in [ptOperator, ptClassOperator]) then
|
||||
@ -6054,6 +6158,9 @@ begin
|
||||
TPasOperator(Result).CorrectName;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
Result.ProcType := TPasProcedureType(CreateElement(TPasProcedureType, '', Result));
|
||||
end;
|
||||
ParseProcedureOrFunctionHeader(Result, Result.ProcType, ProcType, False);
|
||||
Result.Hints:=Result.ProcType.Hints;
|
||||
Result.HintMessage:=Result.ProcType.HintMessage;
|
||||
|
||||
@ -32,7 +32,7 @@ type
|
||||
TSrcMarker = record
|
||||
Kind: TSrcMarkerKind;
|
||||
Filename: string;
|
||||
Row: integer;
|
||||
Row: cardinal;
|
||||
StartCol, EndCol: integer; // token start, end column
|
||||
Identifier: string;
|
||||
Next: PSrcMarker;
|
||||
@ -447,6 +447,25 @@ type
|
||||
Procedure TestProc_ImplicitCalls;
|
||||
Procedure TestProc_Absolute;
|
||||
|
||||
// anonymous procs
|
||||
// ToDo: fppas2js: check "is TPasFunction", ".FuncType", "parent is TPasProcedureBody"
|
||||
Procedure TestAnonymousProc_Assign;
|
||||
// ToDo: does Delphi allow/require semicolon in assign?
|
||||
Procedure TestAnonymousProc_Arg;
|
||||
// ToDo: does Delphi allow/require semicolon in arg?
|
||||
// ToDo: does Delphi allow calling directly?: function(i: word):word begin end(3)
|
||||
Procedure TestAnonymousProc_EqualFail;
|
||||
// ToDo: does Delphi allow ano proc in const?
|
||||
Procedure TestAnonymousProc_ConstFail;
|
||||
// ToDo: does Delphi allow assembler or calling conventions?
|
||||
Procedure TestAnonymousProc_Assembler;
|
||||
Procedure TestAnonymousProc_NameFail;
|
||||
Procedure TestAnonymousProc_StatementFail;
|
||||
Procedure TestAnonymousProc_Typecast;// ToDo
|
||||
// ToDo: ano in with
|
||||
// ToDo: ano in nested
|
||||
// ToDo: ano in ano
|
||||
|
||||
// record
|
||||
Procedure TestRecord;
|
||||
Procedure TestRecordVariant;
|
||||
@ -1411,7 +1430,7 @@ var
|
||||
DeclEl:=TPasAliasType(El).DestType;
|
||||
ResolverEngine.UnmangleSourceLineNumber(DeclEl.SourceLinenumber,LabelLine,LabelCol);
|
||||
if (aLabel^.Filename=DeclEl.SourceFilename)
|
||||
and (aLabel^.Row=LabelLine)
|
||||
and (integer(aLabel^.Row)=LabelLine)
|
||||
and (aLabel^.StartCol<=LabelCol)
|
||||
and (aLabel^.EndCol>=LabelCol) then
|
||||
exit; // success
|
||||
@ -1491,8 +1510,8 @@ begin
|
||||
if (Marker<>nil) then
|
||||
begin
|
||||
if Item.SourcePos.Row<>Marker^.Row then continue;
|
||||
if (Item.SourcePos.Column<Marker^.StartCol)
|
||||
or (Item.SourcePos.Column>Marker^.EndCol) then continue;
|
||||
if (integer(Item.SourcePos.Column)<Marker^.StartCol)
|
||||
or (integer(Item.SourcePos.Column)>Marker^.EndCol) then continue;
|
||||
end;
|
||||
// found
|
||||
FResolverGoodMsgs.Add(Item);
|
||||
@ -7135,6 +7154,137 @@ begin
|
||||
'begin']);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAnonymousProc_Assign;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TFunc = reference to function(x: word): word;',
|
||||
'var Func: TFunc;',
|
||||
'procedure DoIt(a: word);',
|
||||
'begin',
|
||||
' Func:=function(b:word): word',
|
||||
' begin',
|
||||
' Result:=a+b;',
|
||||
' exit(b);',
|
||||
' exit(Result);',
|
||||
' end;',
|
||||
' a:=3;',// test semicolon
|
||||
'end;',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAnonymousProc_Arg;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TProc = reference to procedure;',
|
||||
' TFunc = reference to function(x: word): word;',
|
||||
'procedure DoMore(f,g: TProc);',
|
||||
'begin',
|
||||
'end;',
|
||||
'procedure DoIt(f: TFunc);',
|
||||
'begin',
|
||||
' DoIt(function(b:word): word',
|
||||
' begin',
|
||||
' Result:=1+b;',
|
||||
' end;);',
|
||||
' DoMore(procedure begin end;, procedure begin end);',
|
||||
'end;',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAnonymousProc_EqualFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TFunc = reference to function(x: word): word;',
|
||||
'procedure DoIt(f: TFunc);',
|
||||
'var w: word;',
|
||||
'begin',
|
||||
' if w=function(b:word): word',
|
||||
' begin',
|
||||
' Result:=1+b;',
|
||||
' end; then ;',
|
||||
'end;',
|
||||
'begin']);
|
||||
CheckResolverException('Incompatible types: got "Procedure/Function" expected "Word"',nIncompatibleTypesGotExpected);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAnonymousProc_ConstFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TProc = reference to procedure;',
|
||||
'const',
|
||||
' p: TProc = procedure begin end;',
|
||||
'begin']);
|
||||
CheckParserException('Identifier expected at token "procedure" in file afile.pp at line 5 column 14',nParserExpectedIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAnonymousProc_Assembler;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TProc = reference to procedure;',
|
||||
'procedure DoIt(p: TProc);',
|
||||
'begin',
|
||||
' p:=procedure assembler; asm end;',
|
||||
' p:=procedure() assembler; asm end;',
|
||||
'end;',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAnonymousProc_NameFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TProc = reference to procedure;',
|
||||
'procedure DoIt(p: TProc);',
|
||||
'begin',
|
||||
' p:=procedure Bla() begin end;',
|
||||
'end;',
|
||||
'begin']);
|
||||
CheckParserException(SParserSyntaxError,nParserSyntaxError);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAnonymousProc_StatementFail;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'procedure DoIt;',
|
||||
'begin',
|
||||
' procedure () begin end;',
|
||||
'end;',
|
||||
'begin']);
|
||||
CheckParserException(SParserSyntaxError,nParserSyntaxError);
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAnonymousProc_Typecast;
|
||||
begin
|
||||
exit;
|
||||
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TProc = reference to procedure(w: word);',
|
||||
'procedure DoIt(p: TProc);',
|
||||
'begin',
|
||||
' p:=TProc(procedure(b: byte) begin end);',
|
||||
' p:=TProc(procedure(b: byte) begin end;);',
|
||||
'end;',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestRecord;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user