mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-22 16:29:31 +02:00
fcl-passrc: anonymous functions: with-block
git-svn-id: trunk@40518 -
This commit is contained in:
parent
7815ed4de1
commit
b0d7ba7e6f
@ -818,7 +818,7 @@ type
|
||||
|
||||
{ TPasInitialFinalizationScope - e.g. TInitializationSection, TFinalizationSection }
|
||||
|
||||
TPasInitialFinalizationScope = Class(TPasIdentifierScope)
|
||||
TPasInitialFinalizationScope = Class(TPasScope)
|
||||
public
|
||||
References: TPasScopeReferences; // created by TPasAnalyzer, not used by resolver
|
||||
function AddReference(El: TPasElement; Access: TPSRefAccess): TPasScopeReference;
|
||||
@ -1358,6 +1358,7 @@ type
|
||||
procedure AddArgument(El: TPasArgument); virtual;
|
||||
procedure AddFunctionResult(El: TPasResultElement); virtual;
|
||||
procedure AddExceptOn(El: TPasImplExceptOn); virtual;
|
||||
procedure AddWithDo(El: TPasImplWithDo); virtual;
|
||||
procedure ResolveImplBlock(Block: TPasImplBlock); virtual;
|
||||
procedure ResolveImplElement(El: TPasImplElement); virtual;
|
||||
procedure ResolveImplCaseOf(CaseOf: TPasImplCaseOf); virtual;
|
||||
@ -1416,6 +1417,7 @@ type
|
||||
procedure FinishMethodImplHeader(ImplProc: TPasProcedure); virtual;
|
||||
procedure FinishExceptOnExpr; virtual;
|
||||
procedure FinishExceptOnStatement; virtual;
|
||||
procedure FinishWithDo(El: TPasImplWithDo); virtual;
|
||||
procedure FinishDeclaration(El: TPasElement); virtual;
|
||||
procedure FinishVariable(El: TPasVariable); virtual;
|
||||
procedure FinishPropertyOfClass(PropEl: TPasProperty); virtual;
|
||||
@ -1654,6 +1656,7 @@ type
|
||||
procedure CheckFoundElement(const FindData: TPRFindData;
|
||||
Ref: TResolvedReference); virtual;
|
||||
function GetVisibilityContext: TPasElement;
|
||||
procedure BeginScope(ScopeType: TPasScopeType; El: TPasElement); override;
|
||||
procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); override;
|
||||
procedure FinishTypeAlias(var NewType: TPasType); override;
|
||||
function IsUnitIntfFinished(AModule: TPasModule): boolean;
|
||||
@ -1690,12 +1693,14 @@ type
|
||||
// scopes
|
||||
function CreateScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; virtual;
|
||||
procedure PopScope;
|
||||
procedure PopWithScope(El: TPasImplWithDo);
|
||||
procedure PushScope(Scope: TPasScope); overload;
|
||||
function PushScope(El: TPasElement; ScopeClass: TPasScopeClass): TPasScope; overload;
|
||||
function PushModuleDotScope(aModule: TPasModule): TPasModuleDotScope;
|
||||
function PushClassDotScope(var CurClassType: TPasClassType): TPasDotClassScope;
|
||||
function PushRecordDotScope(CurRecordType: TPasRecordType): TPasDotRecordScope;
|
||||
function PushEnumDotScope(CurEnumType: TPasEnumType): TPasDotEnumTypeScope;
|
||||
function PushWithExprScope(Expr: TPasExpr): TPasWithExprScope;
|
||||
procedure ResetSubScopes(out Depth: integer);
|
||||
procedure RestoreSubScopes(Depth: integer);
|
||||
function GetInheritedExprScope(ErrorEl: TPasElement): TPasProcedureScope;
|
||||
@ -5756,6 +5761,11 @@ begin
|
||||
PopScope;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.FinishWithDo(El: TPasImplWithDo);
|
||||
begin
|
||||
PopWithScope(El);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.FinishDeclaration(El: TPasElement);
|
||||
var
|
||||
C: TClass;
|
||||
@ -7560,86 +7570,25 @@ begin
|
||||
end;
|
||||
|
||||
procedure TPasResolver.ResolveImplWithDo(El: TPasImplWithDo);
|
||||
// Note: the expressions were already resolved during parsing
|
||||
// and the scopes were already stored in a TPasWithScope.
|
||||
// -> simply push them onto the scope stack
|
||||
var
|
||||
i, OldScopeCount: Integer;
|
||||
Expr, ErrorEl: TPasExpr;
|
||||
ExprResolved: TPasResolverResult;
|
||||
TypeEl: TPasType;
|
||||
i: Integer;
|
||||
WithScope: TPasWithScope;
|
||||
WithExprScope: TPasWithExprScope;
|
||||
ExprScope: TPasScope;
|
||||
OnlyTypeMembers, IsClassOf: Boolean;
|
||||
ClassEl: TPasClassType;
|
||||
ExprScope: TPasWithExprScope;
|
||||
begin
|
||||
OldScopeCount:=ScopeCount;
|
||||
WithScope:=TPasWithScope(CreateScope(El,TPasWithScope));
|
||||
if not (El.CustomData is TPasWithScope) then
|
||||
RaiseInternalError(20181210175349);
|
||||
WithScope:=TPasWithScope(El.CustomData);
|
||||
PushScope(WithScope);
|
||||
for i:=0 to El.Expressions.Count-1 do
|
||||
for i:=0 to WithScope.ExpressionScopes.Count-1 do
|
||||
begin
|
||||
Expr:=TPasExpr(El.Expressions[i]);
|
||||
ResolveExpr(Expr,rraRead);
|
||||
ComputeElement(Expr,ExprResolved,[rcSetReferenceFlags]);
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.ResolveImplWithDo ExprResolved=',GetResolverResultDbg(ExprResolved));
|
||||
{$ENDIF}
|
||||
ErrorEl:=Expr;
|
||||
TypeEl:=ExprResolved.LoTypeEl;
|
||||
// ToDo: use last element in Expr for error position
|
||||
if TypeEl=nil then
|
||||
RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
|
||||
[BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
|
||||
|
||||
OnlyTypeMembers:=false;
|
||||
IsClassOf:=false;
|
||||
if TypeEl.ClassType=TPasRecordType then
|
||||
begin
|
||||
ExprScope:=NoNil(TPasRecordType(TypeEl).CustomData) as TPasRecordScope;
|
||||
if ExprResolved.IdentEl is TPasType then
|
||||
// e.g. with TPoint do PointInCircle
|
||||
OnlyTypeMembers:=true;
|
||||
end
|
||||
else if TypeEl.ClassType=TPasClassType then
|
||||
begin
|
||||
ExprScope:=NoNil(TPasClassType(TypeEl).CustomData) as TPasClassScope;
|
||||
if ExprResolved.IdentEl is TPasType then
|
||||
// e.g. with TFPMemoryImage do FindHandlerFromExtension()
|
||||
OnlyTypeMembers:=true;
|
||||
end
|
||||
else if TypeEl.ClassType=TPasClassOfType then
|
||||
begin
|
||||
// e.g. with ImageClass do FindHandlerFromExtension()
|
||||
ClassEl:=ResolveAliasType(TPasClassOfType(TypeEl).DestType) as TPasClassType;
|
||||
ExprScope:=ClassEl.CustomData as TPasClassScope;
|
||||
OnlyTypeMembers:=true;
|
||||
IsClassOf:=true;
|
||||
end
|
||||
else
|
||||
RaiseMsg(20170216152007,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
|
||||
[GetElementTypeName(TypeEl)],ErrorEl);
|
||||
WithExprScope:=ScopeClass_WithExpr.Create;
|
||||
WithExprScope.WithScope:=WithScope;
|
||||
WithExprScope.Index:=i;
|
||||
WithExprScope.Expr:=Expr;
|
||||
WithExprScope.Scope:=ExprScope;
|
||||
if not (ExprResolved.IdentEl is TPasType) then
|
||||
Include(WithExprScope.Flags,wesfNeedTmpVar);
|
||||
if OnlyTypeMembers then
|
||||
Include(WithExprScope.Flags,wesfOnlyTypeMembers);
|
||||
if IsClassOf then
|
||||
Include(WithExprScope.Flags,wesfIsClassOf);
|
||||
if (not (rrfWritable in ExprResolved.Flags))
|
||||
and (ExprResolved.BaseType=btContext)
|
||||
and (ExprResolved.LoTypeEl.ClassType=TPasRecordType) then
|
||||
Include(WithExprScope.Flags,wesfConstParent);
|
||||
WithScope.ExpressionScopes.Add(WithExprScope);
|
||||
PushScope(WithExprScope);
|
||||
ExprScope:=TPasWithExprScope(WithScope.ExpressionScopes[i]);
|
||||
PushScope(ExprScope);
|
||||
end;
|
||||
ResolveImplElement(El.Body);
|
||||
CheckTopScope(ScopeClass_WithExpr);
|
||||
if TopScope<>WithScope.ExpressionScopes[WithScope.ExpressionScopes.Count-1] then
|
||||
RaiseInternalError(20160923102846);
|
||||
while ScopeCount>OldScopeCount do
|
||||
PopScope;
|
||||
PopWithScope(El);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.ResolveImplAsm(El: TPasImplAsmStatement);
|
||||
@ -7854,6 +7803,7 @@ begin
|
||||
ResolveRecordValues(TRecordValues(El));
|
||||
end
|
||||
else if ElClass=TProcedureExpr then
|
||||
// resolved by FinishScope(stProcedure)
|
||||
else
|
||||
RaiseNotYetImplemented(20170222184329,El);
|
||||
|
||||
@ -9372,14 +9322,34 @@ var
|
||||
CurEl: TPasElement;
|
||||
Identifier: TPasIdentifier;
|
||||
CurClassScope: TPasClassScope;
|
||||
C: TClass;
|
||||
begin
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.AddProcedure ',GetObjName(El));
|
||||
{$ENDIF}
|
||||
if not (TopScope is TPasIdentifierScope) then
|
||||
RaiseInvalidScopeForElement(20160922163522,El);
|
||||
// Note: El.ProcType is nil ! It is parsed later.
|
||||
ProcName:=El.Name;
|
||||
if El.Name<>'' then
|
||||
begin
|
||||
// named proc
|
||||
if not (TopScope is TPasIdentifierScope) then
|
||||
RaiseInvalidScopeForElement(20160922163522,El);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// anonymous proc
|
||||
C:=TopScope.ClassType;
|
||||
if (C=ScopeClass_InitialFinalization)
|
||||
or C.InheritsFrom(TPasProcedureScope)
|
||||
or (C=TPasWithScope)
|
||||
or (C=ScopeClass_WithExpr)
|
||||
or (C=TPasExceptOnScope)
|
||||
or (C=TPasForLoopScope) then
|
||||
// ok
|
||||
else
|
||||
RaiseInvalidScopeForElement(20181210173134,El);
|
||||
end;
|
||||
|
||||
// Note: El.ProcType is nil ! It is parsed later.
|
||||
HasDot:=Pos('.',ProcName)>1;
|
||||
if (not HasDot) and (ProcName<>'') then
|
||||
AddIdentifier(TPasIdentifierScope(TopScope),ProcName,El,pikProc);
|
||||
@ -9511,6 +9481,16 @@ begin
|
||||
PushScope(El,TPasExceptOnScope);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.AddWithDo(El: TPasImplWithDo);
|
||||
var
|
||||
WithScope: TPasWithScope;
|
||||
begin
|
||||
if TPasWithScope.FreeOnPop then
|
||||
RaiseInternalError(20181210162344);
|
||||
WithScope:=TPasWithScope(CreateScope(El,TPasWithScope));
|
||||
PushScope(WithScope);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.AddProcedureBody(El: TProcedureBody);
|
||||
begin
|
||||
if El=nil then ;
|
||||
@ -14166,6 +14146,8 @@ begin
|
||||
else if AClass=TPasMethodResolution then
|
||||
else if AClass=TPasImplExceptOn then
|
||||
AddExceptOn(TPasImplExceptOn(El))
|
||||
else if AClass=TPasImplWithDo then
|
||||
AddWithDo(TPasImplWithDo(El))
|
||||
else if AClass=TPasImplLabelMark then
|
||||
else if AClass=TPasOverloadedProc then
|
||||
else if (AClass=TInterfaceSection)
|
||||
@ -14759,6 +14741,15 @@ begin
|
||||
Result:=nil;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.BeginScope(ScopeType: TPasScopeType; El: TPasElement);
|
||||
begin
|
||||
case ScopeType of
|
||||
stWithExpr: PushWithExprScope(El as TPasExpr);
|
||||
else
|
||||
RaiseMsg(20181210163324,nNotYetImplemented,sNotYetImplemented+' BeginScope',[IntToStr(ord(ScopeType))],nil);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.FinishScope(ScopeType: TPasScopeType; El: TPasElement);
|
||||
begin
|
||||
if IsElementSkipped(El) then exit;
|
||||
@ -14772,6 +14763,7 @@ begin
|
||||
stProcedureHeader: FinishProcedureType(El as TPasProcedureType);
|
||||
stExceptOnExpr: FinishExceptOnExpr;
|
||||
stExceptOnStatement: FinishExceptOnStatement;
|
||||
stWithExpr: FinishWithDo(El as TPasImplWithDo);
|
||||
stDeclaration: FinishDeclaration(El);
|
||||
stAncestors: FinishAncestors(El as TPasClassType);
|
||||
stInitialFinalization: FinishInitialFinalization(El as TPasImplBlock);
|
||||
@ -15355,6 +15347,23 @@ begin
|
||||
FTopScope:=nil;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.PopWithScope(El: TPasImplWithDo);
|
||||
var
|
||||
WithScope: TPasWithScope;
|
||||
i: Integer;
|
||||
begin
|
||||
WithScope:=El.CustomData as TPasWithScope;
|
||||
for i:=WithScope.ExpressionScopes.Count-1 downto 0 do
|
||||
begin
|
||||
CheckTopScope(ScopeClass_WithExpr);
|
||||
if TopScope<>WithScope.ExpressionScopes[i] then
|
||||
RaiseInternalError(20160923102846);
|
||||
PopScope;
|
||||
end;
|
||||
CheckTopScope(TPasWithScope);
|
||||
PopScope;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.PushScope(Scope: TPasScope);
|
||||
begin
|
||||
if Scope=nil then
|
||||
@ -15454,6 +15463,84 @@ begin
|
||||
PushScope(Result);
|
||||
end;
|
||||
|
||||
function TPasResolver.PushWithExprScope(Expr: TPasExpr): TPasWithExprScope;
|
||||
var
|
||||
WithEl: TPasImplWithDo;
|
||||
WithScope: TPasWithScope;
|
||||
ExprResolved: TPasResolverResult;
|
||||
ErrorEl: TPasExpr;
|
||||
TypeEl: TPasType;
|
||||
OnlyTypeMembers, IsClassOf: Boolean;
|
||||
ExprScope: TPasIdentifierScope;
|
||||
ClassEl: TPasClassType;
|
||||
WithExprScope: TPasWithExprScope;
|
||||
begin
|
||||
if not (Expr.Parent is TPasImplWithDo) then
|
||||
RaiseInternalError(20181210163412,GetObjName(Expr.Parent));
|
||||
WithEl:=TPasImplWithDo(Expr.Parent);
|
||||
if not (WithEl.CustomData is TPasWithScope) then
|
||||
RaiseInternalError(20181210175526);
|
||||
WithScope:=TPasWithScope(WithEl.CustomData);
|
||||
|
||||
ResolveExpr(Expr,rraRead);
|
||||
ComputeElement(Expr,ExprResolved,[rcSetReferenceFlags]);
|
||||
{$IFDEF VerbosePasResolver}
|
||||
writeln('TPasResolver.PushWithExprScope ExprResolved=',GetResolverResultDbg(ExprResolved));
|
||||
{$ENDIF}
|
||||
ErrorEl:=Expr;
|
||||
TypeEl:=ExprResolved.LoTypeEl;
|
||||
// ToDo: use last element in Expr for error position
|
||||
if TypeEl=nil then
|
||||
RaiseMsg(20170216152004,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
|
||||
[BaseTypeNames[ExprResolved.BaseType]],ErrorEl);
|
||||
|
||||
OnlyTypeMembers:=false;
|
||||
IsClassOf:=false;
|
||||
if TypeEl.ClassType=TPasRecordType then
|
||||
begin
|
||||
ExprScope:=NoNil(TPasRecordType(TypeEl).CustomData) as TPasRecordScope;
|
||||
if ExprResolved.IdentEl is TPasType then
|
||||
// e.g. with TPoint do PointInCircle
|
||||
OnlyTypeMembers:=true;
|
||||
end
|
||||
else if TypeEl.ClassType=TPasClassType then
|
||||
begin
|
||||
ExprScope:=NoNil(TPasClassType(TypeEl).CustomData) as TPasClassScope;
|
||||
if ExprResolved.IdentEl is TPasType then
|
||||
// e.g. with TFPMemoryImage do FindHandlerFromExtension()
|
||||
OnlyTypeMembers:=true;
|
||||
end
|
||||
else if TypeEl.ClassType=TPasClassOfType then
|
||||
begin
|
||||
// e.g. with ImageClass do FindHandlerFromExtension()
|
||||
ClassEl:=ResolveAliasType(TPasClassOfType(TypeEl).DestType) as TPasClassType;
|
||||
ExprScope:=ClassEl.CustomData as TPasClassScope;
|
||||
OnlyTypeMembers:=true;
|
||||
IsClassOf:=true;
|
||||
end
|
||||
else
|
||||
RaiseMsg(20170216152007,nExprTypeMustBeClassOrRecordTypeGot,sExprTypeMustBeClassOrRecordTypeGot,
|
||||
[GetElementTypeName(TypeEl)],ErrorEl);
|
||||
WithExprScope:=ScopeClass_WithExpr.Create;
|
||||
WithExprScope.WithScope:=WithScope;
|
||||
WithExprScope.Index:=WithEl.Expressions.Count;
|
||||
WithExprScope.Expr:=Expr;
|
||||
WithExprScope.Scope:=ExprScope;
|
||||
if not (ExprResolved.IdentEl is TPasType) then
|
||||
Include(WithExprScope.Flags,wesfNeedTmpVar);
|
||||
if OnlyTypeMembers then
|
||||
Include(WithExprScope.Flags,wesfOnlyTypeMembers);
|
||||
if IsClassOf then
|
||||
Include(WithExprScope.Flags,wesfIsClassOf);
|
||||
if (not (rrfWritable in ExprResolved.Flags))
|
||||
and (ExprResolved.BaseType=btContext)
|
||||
and (ExprResolved.LoTypeEl.ClassType=TPasRecordType) then
|
||||
Include(WithExprScope.Flags,wesfConstParent);
|
||||
WithScope.ExpressionScopes.Add(WithExprScope);
|
||||
PushScope(WithExprScope);
|
||||
Result:=WithExprScope;
|
||||
end;
|
||||
|
||||
procedure TPasResolver.ResetSubScopes(out Depth: integer);
|
||||
// move all sub scopes from Scopes to SubScopes
|
||||
begin
|
||||
|
@ -1552,6 +1552,8 @@ begin
|
||||
end
|
||||
else if C=TInheritedExpr then
|
||||
UseInheritedExpr(TInheritedExpr(El))
|
||||
else if C=TProcedureExpr then
|
||||
UseProcedure(TProcedureExpr(El).Proc)
|
||||
else
|
||||
RaiseNotSupported(20170307085444,El);
|
||||
end;
|
||||
|
@ -171,6 +171,7 @@ type
|
||||
stResourceString, // e.g. TPasResString
|
||||
stProcedure, // also method, procedure, constructor, destructor, ...
|
||||
stProcedureHeader,
|
||||
stWithExpr, // calls BeginScope after parsing every WITH-expression
|
||||
stExceptOnExpr,
|
||||
stExceptOnStatement,
|
||||
stDeclaration, // e.g. a TPasProperty, TPasVariable, TPasArgument
|
||||
@ -212,6 +213,7 @@ type
|
||||
function CreateFunctionType(const AName, AResultName: String; AParent: TPasElement;
|
||||
UseParentAsResultParent: Boolean; const ASrcPos: TPasSourcePos): TPasFunctionType;
|
||||
function FindElement(const AName: String): TPasElement; virtual; abstract;
|
||||
procedure BeginScope(ScopeType: TPasScopeType; El: TPasElement); virtual;
|
||||
procedure FinishScope(ScopeType: TPasScopeType; El: TPasElement); virtual;
|
||||
procedure FinishTypeAlias(var aType: TPasType); virtual;
|
||||
function FindModule(const AName: String): TPasModule; virtual;
|
||||
@ -809,6 +811,13 @@ begin
|
||||
visDefault, ASrcPos));
|
||||
end;
|
||||
|
||||
procedure TPasTreeContainer.BeginScope(ScopeType: TPasScopeType; El: TPasElement
|
||||
);
|
||||
begin
|
||||
if ScopeType=stModule then ; // avoid compiler warning
|
||||
if El=nil then ;
|
||||
end;
|
||||
|
||||
procedure TPasTreeContainer.FinishScope(ScopeType: TPasScopeType;
|
||||
El: TPasElement);
|
||||
begin
|
||||
@ -4660,6 +4669,11 @@ begin
|
||||
tkIdentifier, // e.g. procedure assembler
|
||||
tkbegin,tkvar,tkconst,tktype,tkprocedure,tkfunction:
|
||||
UngetToken;
|
||||
tkColon:
|
||||
if ProcType=ptAnonymousFunction then
|
||||
UngetToken
|
||||
else
|
||||
ParseExcTokenError('begin');
|
||||
else
|
||||
ParseExcTokenError('begin');
|
||||
end;
|
||||
@ -5465,9 +5479,13 @@ var
|
||||
{$ENDIF}
|
||||
|
||||
function CloseBlock: boolean; // true if parent reached
|
||||
var C: TPasImplBlockClass;
|
||||
begin
|
||||
if CurBlock.ClassType=TPasImplExceptOn then
|
||||
Engine.FinishScope(stExceptOnStatement,CurBlock);
|
||||
C:=TPasImplBlockClass(CurBlock.ClassType);
|
||||
if C=TPasImplExceptOn then
|
||||
Engine.FinishScope(stExceptOnStatement,CurBlock)
|
||||
else if C=TPasImplWithDo then
|
||||
Engine.FinishScope(stWithExpr,CurBlock);
|
||||
CurBlock:=CurBlock.Parent as TPasImplBlock;
|
||||
Result:=CurBlock=Parent;
|
||||
end;
|
||||
@ -5719,11 +5737,12 @@ begin
|
||||
CheckSemicolon;
|
||||
SrcPos:=CurTokenPos;
|
||||
NextToken;
|
||||
El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
|
||||
Left:=DoParseExpression(CurBlock);
|
||||
//writeln(i,'WITH Expr="',Expr,'" Token=',CurTokenText);
|
||||
El:=TPasImplWithDo(CreateElement(TPasImplWithDo,'',CurBlock,SrcPos));
|
||||
TPasImplWithDo(El).AddExpression(Left);
|
||||
Left.Parent:=El;
|
||||
Engine.BeginScope(stWithExpr,Left);
|
||||
Left:=nil;
|
||||
CreateBlock(TPasImplWithDo(El));
|
||||
El:=nil;
|
||||
@ -5735,6 +5754,7 @@ begin
|
||||
Left:=DoParseExpression(CurBlock);
|
||||
//writeln(i,'WITH ...,Expr="',Expr,'" Token=',CurTokenText);
|
||||
TPasImplWithDo(CurBlock).AddExpression(Left);
|
||||
Engine.BeginScope(stWithExpr,Left);
|
||||
Left:=nil;
|
||||
until false;
|
||||
end;
|
||||
|
@ -457,15 +457,12 @@ type
|
||||
Procedure TestAnonymousProc_Assembler;
|
||||
Procedure TestAnonymousProc_NameFail;
|
||||
Procedure TestAnonymousProc_StatementFail;
|
||||
// ToDo: Delphi does not support calling directly: function(i: word):word begin end(3)
|
||||
// ToDo: Delphi does support calling with typecast: TFunc(function(i: word):word begin end)(3)
|
||||
Procedure TestAnonymousProc_Typecast;
|
||||
Procedure TestAnonymousProc_TypecastToResultFail;
|
||||
Procedure TestAnonymousProc_With; // ToDo
|
||||
// ToDo: ano in with (ano proc can access with scope)
|
||||
// ToDo: ano in except E: Exception do ..
|
||||
// ToDo: ano in nested
|
||||
// ToDo: ano in ano
|
||||
Procedure TestAnonymousProc_With;
|
||||
Procedure TestAnonymousProc_ExceptOn;
|
||||
Procedure TestAnonymousProc_Nested;
|
||||
// analyzer
|
||||
// ToDo: fppas2js: check "is TPasFunction", ".FuncType", "is TPasProcedureBody"
|
||||
|
||||
// record
|
||||
@ -7318,9 +7315,16 @@ begin
|
||||
Add([
|
||||
'type',
|
||||
' TProc = reference to procedure(w: word);',
|
||||
' TArr = array of word;',
|
||||
' TFuncArr = reference to function: TArr;',
|
||||
'procedure DoIt(p: TProc);',
|
||||
'var',
|
||||
' w: word;',
|
||||
' a: TArr;',
|
||||
'begin',
|
||||
' p:=TProc(procedure(b: smallint) begin end);',
|
||||
' a:=TFuncArr(function: TArr begin end)();',
|
||||
' w:=TFuncArr(function: TArr begin end)()[3];',
|
||||
'end;',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
@ -7342,27 +7346,89 @@ end;
|
||||
|
||||
procedure TTestResolver.TestAnonymousProc_With;
|
||||
begin
|
||||
exit;
|
||||
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TProc = reference to procedure(w: word);',
|
||||
' TObject = class end;',
|
||||
' TBird = class',
|
||||
' {#b_bool}b: boolean;',
|
||||
' {#bool}b: boolean;',
|
||||
' end;',
|
||||
'procedure DoIt({#i}i: longint);',
|
||||
'var',
|
||||
' {#p}p: TProc;',
|
||||
' {#b_bird}bi: TBird;',
|
||||
' {#bird}bird: TBird;',
|
||||
'begin',
|
||||
' with {@b_bird}bi do begin',
|
||||
' with {@bird}bird do',
|
||||
' {@p}p:=procedure({#w}w: word)',
|
||||
' begin',
|
||||
' {@b_bool}b:=true;',
|
||||
// ' {@b_bool}b:=({@w}w+{@i}i)>2;',
|
||||
' end; end;',
|
||||
' {@bool}b:=true;',
|
||||
' {@bool}b:=({@w}w+{@i}i)>2;',
|
||||
' end;',
|
||||
'end;',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAnonymousProc_ExceptOn;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TProc = reference to procedure;',
|
||||
' TObject = class end;',
|
||||
' Exception = class',
|
||||
' {#bool}b: boolean;',
|
||||
' end;',
|
||||
'procedure DoIt;',
|
||||
'var',
|
||||
' {#p}p: TProc;',
|
||||
'begin',
|
||||
' try',
|
||||
' except',
|
||||
' on {#E}E: Exception do',
|
||||
' {@p}p:=procedure',
|
||||
' begin',
|
||||
' {@E}E.{@bool}b:=true;',
|
||||
' end;',
|
||||
' end;',
|
||||
'end;',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
end;
|
||||
|
||||
procedure TTestResolver.TestAnonymousProc_Nested;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' TProc = reference to procedure;',
|
||||
' TObject = class',
|
||||
' i: byte;',
|
||||
' procedure DoIt;',
|
||||
' end;',
|
||||
'procedure TObject.DoIt;',
|
||||
'var',
|
||||
' {#p}p: TProc;',
|
||||
' procedure Sub;',
|
||||
' begin',
|
||||
' p:=procedure',
|
||||
' begin',
|
||||
' i:=3;',
|
||||
' Self.i:=4;',
|
||||
' p:=procedure',
|
||||
' procedure SubSub;',
|
||||
' begin',
|
||||
' i:=13;',
|
||||
' Self.i:=14;',
|
||||
' end;',
|
||||
' begin',
|
||||
' i:=13;',
|
||||
' Self.i:=14;',
|
||||
' end;',
|
||||
' end;',
|
||||
' end;',
|
||||
'begin',
|
||||
'end;',
|
||||
'begin']);
|
||||
ParseProgram;
|
||||
|
@ -72,6 +72,7 @@ type
|
||||
procedure TestM_NestedFuncResult;
|
||||
procedure TestM_Enums;
|
||||
procedure TestM_ProcedureType;
|
||||
procedure TestM_AnonymousProc;
|
||||
procedure TestM_Params;
|
||||
procedure TestM_Class;
|
||||
procedure TestM_ClassForward;
|
||||
@ -999,6 +1000,27 @@ begin
|
||||
AnalyzeProgram;
|
||||
end;
|
||||
|
||||
procedure TTestUseAnalyzer.TestM_AnonymousProc;
|
||||
begin
|
||||
StartProgram(false);
|
||||
Add([
|
||||
'type',
|
||||
' {#TProc_used}TProc = reference to procedure;',
|
||||
'procedure {#DoIt_used}DoIt;',
|
||||
'var',
|
||||
' {#p_used}p: TProc;',
|
||||
' {#i_used}i: longint;',
|
||||
'begin',
|
||||
' p:=procedure',
|
||||
' begin',
|
||||
' i:=3;',
|
||||
' end;',
|
||||
'end;',
|
||||
'begin',
|
||||
' DoIt;']);
|
||||
AnalyzeProgram;
|
||||
end;
|
||||
|
||||
procedure TTestUseAnalyzer.TestM_Params;
|
||||
begin
|
||||
StartProgram(false);
|
||||
|
@ -116,8 +116,7 @@ begin
|
||||
OrigSrc:=JSFile.Source;
|
||||
// compile, using .pcu files
|
||||
//for i:=0 to FileCount-1 do
|
||||
// writeln('AAA1 TCustomTestCLI_Precompile.CheckPrecompile ',i,' ',Files[i].Filename);
|
||||
|
||||
// writeln('TCustomTestCLI_Precompile.CheckPrecompile ',i,' ',Files[i].Filename);
|
||||
{$IFDEF VerbosePCUFiler}
|
||||
writeln('TTestCLI_Precompile.CheckPrecompile compile using pcu files==================');
|
||||
{$ENDIF}
|
||||
|
Loading…
Reference in New Issue
Block a user