paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-15 17:49: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; end;
var var
Last,func, Expr: TPasExpr; Last, Func, Expr: TPasExpr;
prm : TParamsExpr; Params: TParamsExpr;
b : TBinaryExpr; Bin: TBinaryExpr;
ok, CanSpecialize: Boolean; ok, CanSpecialize: Boolean;
aName: String; aName: String;
ISE: TInlineSpecializeExpr; ISE: TInlineSpecializeExpr;
@ -2075,7 +2075,7 @@ begin
else else
Last:=CreatePrimitiveExpr(AParent,pekIdent,aName); Last:=CreatePrimitiveExpr(AParent,pekIdent,aName);
end; end;
tkfalse, tktrue: Last:=CreateBoolConstExpr(Aparent,pekBoolConst, CurToken=tktrue); tkfalse, tktrue: Last:=CreateBoolConstExpr(AParent,pekBoolConst, CurToken=tktrue);
tknil: Last:=CreateNilExpr(AParent); tknil: Last:=CreateNilExpr(AParent);
tkSquaredBraceOpen: Last:=ParseParams(AParent,pekSet); tkSquaredBraceOpen: Last:=ParseParams(AParent,pekSet);
tkinherited: tkinherited:
@ -2086,13 +2086,14 @@ begin
if (CurToken=tkIdentifier) then if (CurToken=tkIdentifier) then
begin begin
SrcPos:=CurTokenPos; SrcPos:=CurTokenPos;
b:=CreateBinaryExpr(AParent,Last, DoParseExpression(AParent), eopNone,SrcPos); Bin:=CreateBinaryExpr(AParent,Last,ParseExpIdent(AParent),eopNone,SrcPos);
if not Assigned(b.right) then if not Assigned(Bin.right) then
begin begin
b.Release; Bin.Release;
ParseExcExpectedIdentifier; ParseExcExpectedIdentifier;
end; end;
Last:=b; Result:=Bin;
exit;
end; end;
UngetToken; UngetToken;
end; end;
@ -2120,12 +2121,12 @@ begin
end; end;
Result:=Last; Result:=Last;
func:=Last;
if Last.Kind<>pekSet then NextToken; if Last.Kind<>pekSet then NextToken;
if not (Last.Kind in [pekNumber,pekString,pekSet,pekIdent,pekSelf,pekNil]) then if not (Last.Kind in [pekNumber,pekString,pekSet,pekIdent,pekSelf,pekNil]) then
exit; exit;
Func:=Last;
ok:=false; ok:=false;
ISE:=nil; ISE:=nil;
try try
@ -2140,7 +2141,7 @@ begin
aName:=aName+'.'+CurTokenString; aName:=aName+'.'+CurTokenString;
expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString); expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
AddToBinaryExprChain(Result,expr,eopSubIdent,ScrPos); AddToBinaryExprChain(Result,expr,eopSubIdent,ScrPos);
func:=expr; Func:=expr;
NextToken; NextToken;
end end
else else
@ -2152,11 +2153,11 @@ begin
tkBraceOpen,tkSquaredBraceOpen: tkBraceOpen,tkSquaredBraceOpen:
begin begin
if CurToken=tkBraceOpen then if CurToken=tkBraceOpen then
prm:=ParseParams(AParent,pekFuncParams,IsWriteOrStr(func)) Params:=ParseParams(AParent,pekFuncParams,IsWriteOrStr(Func))
else else
prm:=ParseParams(AParent,pekArrayParams); Params:=ParseParams(AParent,pekArrayParams);
if not Assigned(prm) then Exit; if not Assigned(Params) then Exit;
AddParamsToBinaryExprChain(Result,prm); AddParamsToBinaryExprChain(Result,Params);
CanSpecialize:=false; CanSpecialize:=false;
end; end;
tkCaret: tkCaret:

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

@ -434,6 +434,7 @@ type
Procedure TestClassCallInheritedWithParamsAbstractFail; Procedure TestClassCallInheritedWithParamsAbstractFail;
Procedure TestClassCallInheritedConstructor; Procedure TestClassCallInheritedConstructor;
Procedure TestClassCallInheritedNested; Procedure TestClassCallInheritedNested;
Procedure TestClassCallInheritedAs;
Procedure TestClassAssignNil; Procedure TestClassAssignNil;
Procedure TestClassAssign; Procedure TestClassAssign;
Procedure TestClassNilAsParam; Procedure TestClassNilAsParam;
@ -6864,6 +6865,28 @@ begin
ParseProgram; ParseProgram;
end; 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; procedure TTestResolver.TestClassAssignNil;
begin begin
StartProgram(false); StartProgram(false);