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

fcl-passrc: fixed parsing (expr).name()

Browse Source 
git-svn-id: trunk@41225 -
This commit is contained in:
Mattias Gaertner 2019-02-04 16:49:07 +00:00
parent bf1af93938
commit 9a878f99db
3 changed files with 62 additions and 95 deletions
packages/fcl-passrc
src
pasresolver.pppparser.pp
tests
tcexprparser.pas

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

@ -13184,23 +13184,25 @@ begin
Value:=nil;
end;
end
{$ifdef FPC_HAS_CPSTRING}
else if (bt=btAnsiString) or ((bt=btString) and (BaseTypeString=btAnsiString)) then
begin
// ansistring(unicodestring)
Result:=TResEvalString.CreateValue(
fExprEvaluator.GetRawByteString(TResEvalUTF16(Value).S,CP_ACP,Params));
end
else if (bt=btUnicodeString) or ((bt=btString) and (BaseTypeString=btUnicodeString)) then
begin
// unicodestring(unicodestring)
Result:=Value;
Value:=nil;
end
else if bt=btRawByteString then
begin
// rawbytestring(unicodestring)
Result:=TResEvalString.CreateValue(
fExprEvaluator.GetRawByteString(TResEvalUTF16(Value).S,CP_NONE,Params));
end
{$endif}
else if (bt=btUnicodeString) or ((bt=btString) and (BaseTypeString=btUnicodeString)) then
begin
// unicodestring(unicodestring)
Result:=Value;
Value:=nil;
end;
revkExternal:
exit;

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

@ -2250,7 +2250,11 @@ begin
end;
tkfalse, tktrue: Last:=CreateBoolConstExpr(AParent,pekBoolConst, CurToken=tktrue);
tknil: Last:=CreateNilExpr(AParent);
tkSquaredBraceOpen: Last:=ParseParams(AParent,pekSet);
tkSquaredBraceOpen:
begin
Last:=ParseParams(AParent,pekSet);
UngetToken;
end;
tkinherited:
begin
//inherited; inherited function
@ -2306,6 +2310,18 @@ begin
end;
Last:=CreatePrimitiveExpr(AParent,pekString, '^'+CurTokenText);
end;
tkBraceOpen:
begin
NextToken;
Last:=DoParseExpression(AParent);
if not Assigned(Last) then
ParseExcSyntaxError;
if (CurToken<>tkBraceClose) then
begin
Last.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
CheckToken(tkBraceClose);
end;
end
else
ParseExcExpectedIdentifier;
end;
@ -2314,13 +2330,7 @@ begin
ok:=false;
ISE:=nil;
try
if Last.Kind<>pekSet then NextToken;
if not (Last.Kind in [pekNumber,pekString,pekSet,pekIdent,pekSelf,pekNil]) then
begin
ok:=true;
exit;
end;
NextToken;
Func:=Last;
repeat
case CurToken of
@ -2509,8 +2519,6 @@ const
Var
AllowedBinaryOps : Set of TToken;
SrcPos: TPasSourcePos;
ArrParams: TParamsExpr;
begin
AllowedBinaryOps:=BinaryOP;
if Not AllowEqual then
@ -2536,62 +2544,12 @@ begin
inc(PrefixCnt);
NextToken;
end;
if (CurToken = tkBraceOpen) then
begin
NextToken;
x:=DoParseExpression(AParent);
if not Assigned(x) then
ParseExcSyntaxError;
if (CurToken<>tkBraceClose) then
begin
x.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
CheckToken(tkBraceClose);
end;
NextToken;
repeat
case CurToken of
tkCaret:
begin
// for expressions like (ppdouble)^^;
x:=CreateUnaryExpr(AParent,x, TokenToExprOp(tkCaret));
NextToken;
end;
tkBraceOpen:
begin
// for expressions like (a+b)(0);
ArrParams:=ParseParams(AParent,pekFuncParams,False);
ArrParams.Value:=x;
x.Parent:=ArrParams;
x:=ArrParams;
end;
tkSquaredBraceOpen:
begin
// for expressions like (PChar(a)+10)[0];
ArrParams:=ParseParams(AParent,pekArrayParams,False);
ArrParams.Value:=x;
x.Parent:=ArrParams;
x:=ArrParams;
end;
tkDot:
begin
// for expressions like (TObject(m)).Free;
NextToken;
x:=CreateBinaryExpr(AParent,x, ParseExprOperand(AParent), TokenToExprOp(tkDot));
end
else
break;
end;
until false;
end
else
begin
x:=ParseExprOperand(AParent);
if not Assigned(x) then
ParseExcSyntaxError;
end;
// parse operand
x:=ParseExprOperand(AParent);
if not Assigned(x) then
ParseExcSyntaxError;
ExpStack.Add(x);
// apply prefixes
for i:=1 to PrefixCnt do
begin
TempOp:=PopOper(SrcPos);
@ -4254,17 +4212,8 @@ begin
if (CurToken=tkAbsolute) then
begin
Result:=True;
ExpectIdentifier;
Location:=CurTokenText;
AbsoluteExpr:=CreatePrimitiveExpr(Parent,pekIdent,CurTokenText);
NextToken;
While CurToken=tkDot do
begin
ExpectIdentifier;
Location:=Location+'.'+CurTokenText;
AbsoluteExpr:=CreateBinaryExpr(Parent,AbsoluteExpr,CreatePrimitiveExpr(Parent,pekIdent,CurTokenText),eopSubIdent);
NextToken;
end;
Location:=ReadDottedIdentifier(Parent,AbsoluteExpr,true);
UnGetToken;
end
else
@ -5212,20 +5161,9 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
Param: TPasExpr;
SrcPos: TPasSourcePos;
begin
ExpectIdentifier;
Result := CurTokenString;
Expr := CreatePrimitiveExpr(aParent,pekIdent,CurTokenString);
// read .subident.subident...
repeat
NextToken;
if CurToken <> tkDot then break;
SrcPos:=CurTokenPos;
ExpectIdentifier;
Result := Result + '.' + CurTokenString;
AddToBinaryExprChain(Expr,CreatePrimitiveExpr(aParent,pekIdent,CurTokenString),
eopSubIdent,SrcPos);
until false;
NextToken;
// read ident.subident...
Result:=ReadDottedIdentifier(aParent,Expr,true);
// read optional array index
if CurToken <> tkSquaredBraceOpen then

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

@ -111,6 +111,7 @@ type
Procedure TestADotBDotC;
Procedure TestADotBBracketC;
Procedure TestSelfDotBBracketC;
Procedure TestAasBDotCBracketFuncParams;
Procedure TestRange;
Procedure TestBracketsTotal;
Procedure TestBracketsLeft;
@ -1289,6 +1290,32 @@ begin
AssertExpression('first param c',p.Params[0],pekIdent,'c');
end;
procedure TTestExpressions.TestAasBDotCBracketFuncParams;
var
P: TParamsExpr;
B, AsExpr: TBinaryExpr;
begin
ParseExpression('(a as b).c(d)');
P:=TParamsExpr(AssertExpression('FuncParams',TheExpr,pekFuncParams,TParamsExpr));
AssertEquals('length(p.Params)',length(p.Params),1);
AssertExpression('first param d',p.Params[0],pekIdent,'d');
B:=TBinaryExpr(AssertExpression('Upper Binary identifier',P.Value,pekBinary,TBinaryExpr));
AssertEquals('dot c expr',eopSubIdent,B.OpCode);
TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
AssertExpression('dot c',b.right,pekIdent,'c');
AsExpr:=TBinaryExpr(AssertExpression('lower binary identifier',B.left,pekBinary,TBinaryExpr));
AssertEquals('AS expr',eopAs,AsExpr.OpCode);
TAssert.AssertSame('AsExpr.left.parent=AsExpr',AsExpr,AsExpr.left.Parent);
TAssert.AssertSame('AsExpr.right.parent=AsExpr',AsExpr,AsExpr.right.Parent);
AssertExpression('left AS a',AsExpr.left,pekIdent,'a');
AssertExpression('right AS b',AsExpr.right,pekIdent,'b');
end;
initialization
RegisterTest(TTestExpressions);