paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-16 03:49:08 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Fix bug #31523

Browse Source 
git-svn-id: trunk@35591 -
This commit is contained in:
michael 2017-03-15 14:20:18 +00:00
parent a4b096e9da
commit 3d95f39686
3 changed files with 28 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1587,7 +1587,7 @@ function TPasParser.ParseExpIdent(AParent: TPasElement): TPasExpr;
end; end;
var var
Last , Expr: TPasExpr; Last,func, Expr: TPasExpr;
prm : TParamsExpr; prm : TParamsExpr;
b : TBinaryExpr; b : TBinaryExpr;
optk : TToken; optk : TToken;
@ -1661,7 +1661,8 @@ begin
end; end;
Result:=Last; Result:=Last;
func:=Last;
if Last.Kind<>pekSet then NextToken; if Last.Kind<>pekSet then NextToken;
ok:=false; ok:=false;
@ -1673,8 +1674,9 @@ begin
NextToken; NextToken;
if CurToken in [tkIdentifier,tktrue,tkfalse] then // true and false are also identifiers if CurToken in [tkIdentifier,tktrue,tkfalse] then // true and false are also identifiers
begin begin
AddToBinaryExprChain(Result,Last, expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
CreatePrimitiveExpr(AParent,pekIdent,CurTokenString), eopSubIdent); AddToBinaryExprChain(Result,Last,expr,eopSubIdent);
func:=expr;
NextToken; NextToken;
end end
else else
@ -1683,12 +1685,12 @@ begin
ParseExcExpectedIdentifier; ParseExcExpectedIdentifier;
end; end;
end; end;
repeat repeat
case CurToken of case CurToken of
tkBraceOpen,tkSquaredBraceOpen: tkBraceOpen,tkSquaredBraceOpen:
begin begin
if CurToken=tkBraceOpen then if CurToken=tkBraceOpen then
prm:=ParseParams(AParent,pekFuncParams,isWriteOrStr(Last)) prm:=ParseParams(AParent,pekFuncParams,isWriteOrStr(func))
else else
prm:=ParseParams(AParent,pekArrayParams); prm:=ParseParams(AParent,pekArrayParams);
if not Assigned(prm) then Exit; if not Assigned(prm) then Exit;

19
packages/fcl-passrc/tests/tcexprparser.pas
View File

@ -103,6 +103,7 @@ type
Procedure TestFunctionCall; Procedure TestFunctionCall;
Procedure TestFunctionCall2args; Procedure TestFunctionCall2args;
Procedure TestFunctionCallNoArgs; Procedure TestFunctionCallNoArgs;
Procedure ParseStrWithFormatFullyQualified;
Procedure TestRange; Procedure TestRange;
Procedure TestBracketsTotal; Procedure TestBracketsTotal;
Procedure TestBracketsLeft; Procedure TestBracketsLeft;
@ -1031,6 +1032,24 @@ begin
AssertNotNull('Have left',AOperand); AssertNotNull('Have left',AOperand);
end; end;
Procedure TTestExpressions.ParseStrWithFormatFullyQualified;
Var
P : TParamsExpr;
B : TBinaryExpr;
begin
DeclareVar('string','a');
DeclareVar('integer','i');
ParseExpression('system.str(i:0:3,a)');
B:=TBinaryExpr(AssertExpression('Binary identifier',theExpr,pekBinary,TBinaryExpr));
P:=TParamsExpr(AssertExpression('Simple identifier',B.Right,pekFuncParams,TParamsExpr));
AssertExpression('Name of function',P.Value,pekIdent,'str');
AssertEquals('2 argument',2,Length(p.params));
AssertExpression('Simple identifier',p.params[0],pekIdent,'i');
AssertExpression('Simple identifier',p.params[1],pekIdent,'a');
end;
initialization initialization
RegisterTest(TTestExpressions); RegisterTest(TTestExpressions);

2
packages/fcl-passrc/tests/tcgenerics.pp
View File

@ -5,7 +5,7 @@ unit tcgenerics;
interface interface
uses uses
Classes, SysUtils, fpcunit, pparser, pastree, testregistry, tctypeparser; Classes, SysUtils, fpcunit, pastree, testregistry, tctypeparser;
Type Type