paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 00:09:25 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: fixed parsing inherited name as

Browse Source 
git-svn-id: trunk@37720 -
This commit is contained in:
Mattias Gaertner 2017-12-12 12:45:52 +00:00
parent a3a7285df4
commit 87d020c07b
2 changed files with 39 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
packages/fcl-passrc/src/pparser.pp
View File

@ -2046,9 +2046,9 @@ function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
end;
var
Last,func, Expr: TPasExpr;
prm : TParamsExpr;
b : TBinaryExpr;
Last, Func, Expr: TPasExpr;
Params: TParamsExpr;
Bin: TBinaryExpr;
ok, CanSpecialize: Boolean;
aName: String;
ISE: TInlineSpecializeExpr;
@ -2075,7 +2075,7 @@ begin
else
Last:=CreatePrimitiveExpr(AParent,pekIdent,aName);
end;
tkfalse, tktrue: Last:=CreateBoolConstExpr(Aparent,pekBoolConst, CurToken=tktrue);
tkfalse, tktrue: Last:=CreateBoolConstExpr(AParent,pekBoolConst, CurToken=tktrue);
tknil: Last:=CreateNilExpr(AParent);
tkSquaredBraceOpen: Last:=ParseParams(AParent,pekSet);
tkinherited:
@ -2086,13 +2086,14 @@ begin
if (CurToken=tkIdentifier) then
begin
SrcPos:=CurTokenPos;
b:=CreateBinaryExpr(AParent,Last, DoParseExpression(AParent), eopNone,SrcPos);
if not Assigned(b.right) then
Bin:=CreateBinaryExpr(AParent,Last,ParseExpIdent(AParent),eopNone,SrcPos);
if not Assigned(Bin.right) then
begin
b.Release;
Bin.Release;
ParseExcExpectedIdentifier;
end;
Last:=b;
Result:=Bin;
exit;
end;
UngetToken;
end;
@ -2120,12 +2121,12 @@ begin
end;
Result:=Last;
func:=Last;
if Last.Kind<>pekSet then NextToken;
if not (Last.Kind in [pekNumber,pekString,pekSet,pekIdent,pekSelf,pekNil]) then
exit;
Func:=Last;
ok:=false;
ISE:=nil;
try
@ -2140,7 +2141,7 @@ begin
aName:=aName+'.'+CurTokenString;
expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
AddToBinaryExprChain(Result,expr,eopSubIdent,ScrPos);
func:=expr;
Func:=expr;
NextToken;
end
else
@ -2152,11 +2153,11 @@ begin
tkBraceOpen,tkSquaredBraceOpen:
begin
if CurToken=tkBraceOpen then
prm:=ParseParams(AParent,pekFuncParams,IsWriteOrStr(func))
Params:=ParseParams(AParent,pekFuncParams,IsWriteOrStr(Func))
else
prm:=ParseParams(AParent,pekArrayParams);
if not Assigned(prm) then Exit;
AddParamsToBinaryExprChain(Result,prm);
Params:=ParseParams(AParent,pekArrayParams);
if not Assigned(Params) then Exit;
AddParamsToBinaryExprChain(Result,Params);
CanSpecialize:=false;
end;
tkCaret:

23
packages/fcl-passrc/tests/tcresolver.pas
View File

@ -434,6 +434,7 @@ type
Procedure TestClassCallInheritedWithParamsAbstractFail;
Procedure TestClassCallInheritedConstructor;
Procedure TestClassCallInheritedNested;
Procedure TestClassCallInheritedAs;
Procedure TestClassAssignNil;
Procedure TestClassAssign;
Procedure TestClassNilAsParam;
@ -6864,6 +6865,28 @@ begin
ParseProgram;
end;
procedure TTestResolver.TestClassCallInheritedAs;
begin
StartProgram(false);
Add([
'type',
' TObject = class',
' function GetSome: TObject; virtual;',
' end;',
' TBird = class',
' function GetIt: TBird;',
' end;',
'function TObject.GetSome: TObject;',
'begin',
'end;',
'function TBird.GetIt: TBird;',
'begin',
' Result:=inherited GetSome as TBird;',
'end;',
'begin']);
ParseProgram;
end;
procedure TTestResolver.TestClassAssignNil;
begin
StartProgram(false);