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

fcl-passrc: parser: fixed (a.b).c

Browse Source 
git-svn-id: trunk@40870 -
This commit is contained in:
Mattias Gaertner 2019-01-16 13:40:23 +00:00
parent 38f158bb69
commit 4f04f23479
3 changed files with 646 additions and 444 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

File diff suppressed because it is too large Load Diff

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

@ -341,8 +341,6 @@ type
function CreateBinaryExpr(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos): TBinaryExpr; overload;
procedure AddToBinaryExprChain(var ChainFirst: TPasExpr;
Element: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos);
procedure AddParamsToBinaryExprChain(var ChainFirst: TPasExpr;
Params: TParamsExpr);
{$IFDEF VerbosePasParser}
procedure WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr);
{$ENDIF}
@ -2355,9 +2353,9 @@ begin
if CurToken in [tkIdentifier,tktrue,tkfalse,tkself] then // true and false are sub identifiers as well
begin
aName:=aName+'.'+CurTokenString;
expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
AddToBinaryExprChain(Result,expr,eopSubIdent,ScrPos);
Func:=expr;
Expr:=CreatePrimitiveExpr(AParent,pekIdent,CurTokenString);
AddToBinaryExprChain(Result,Expr,eopSubIdent,ScrPos);
Func:=Expr;
NextToken;
end
else
@ -2373,14 +2371,18 @@ begin
else
Params:=ParseParams(AParent,pekArrayParams);
if not Assigned(Params) then Exit;
AddParamsToBinaryExprChain(Result,Params);
Params.Value:=Result;
Result.Parent:=Params;
Result:=Params;
CanSpecialize:=false;
Func:=nil;
end;
tkCaret:
begin
Result:=CreateUnaryExpr(AParent,Result,TokenToExprOp(CurToken));
NextToken;
CanSpecialize:=false;
Func:=nil;
end;
tkLessThan:
begin
@ -2402,6 +2404,7 @@ begin
CanSpecialize:=false;
NextToken;
end;
Func:=nil;
end
else
break;
@ -2568,26 +2571,40 @@ begin
CheckToken(tkBraceClose);
end;
NextToken;
// for expressions like (ppdouble)^^;
while (CurToken=tkCaret) do
begin
x:=CreateUnaryExpr(AParent,x, TokenToExprOp(tkCaret));
NextToken;
end;
// for expressions like (PChar(a)+10)[0];
if (CurToken=tkSquaredBraceOpen) then
begin
ArrParams:=ParseParams(AParent,pekArrayParams,False);
ArrParams.Value:=x;
x.Parent:=ArrParams;
x:=ArrParams;
end;
// for expressions like (TObject(m)).Free;
if (CurToken=tkDot) then
begin
NextToken;
x:=CreateBinaryExpr(AParent,x, ParseExprOperand(AParent), TokenToExprOp(tkDot));
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
@ -5221,7 +5238,9 @@ function TPasParser.ParseProperty(Parent: TPasElement; const AName: String;
Result := Result + '[';
Params:=TParamsExpr(CreateElement(TParamsExpr,'',aParent));
Params.Kind:=pekArrayParams;
AddParamsToBinaryExprChain(Expr,Params);
Params.Value:=Expr;
Expr.Parent:=Params;
Expr:=Params;
NextToken;
case CurToken of
tkChar: Param:=CreatePrimitiveExpr(aParent,pekString, CurTokenText);
@ -7042,37 +7061,6 @@ begin
end;
end;
procedure TPasParser.AddParamsToBinaryExprChain(var ChainFirst: TPasExpr;
Params: TParamsExpr);
// append Params to chain, using the last(right) element as Params.Value
var
Bin: TBinaryExpr;
begin
if Params.Value<>nil then
ParseExcSyntaxError;
if ChainFirst=nil then
ParseExcSyntaxError;
if ChainFirst is TBinaryExpr then
begin
Bin:=TBinaryExpr(ChainFirst);
if Bin.left=nil then
ParseExcSyntaxError;
if Bin.right=nil then
ParseExcSyntaxError;
Params.Value:=Bin.right;
Params.Value.Parent:=Params;
Bin.right:=Params;
Params.Parent:=Bin;
end
else
begin
Params.Value:=ChainFirst;
Params.Parent:=ChainFirst.Parent;
ChainFirst.Parent:=Params;
ChainFirst:=Params;
end;
end;
{$IFDEF VerbosePasParser}
{AllowWriteln}
procedure TPasParser.WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr

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

@ -96,14 +96,19 @@ type
Procedure TestBinaryLessThanEqual;
Procedure TestBinaryLargerThan;
Procedure TestBinaryLargerThanEqual;
procedure TestBinaryFullIdent;
procedure TestBinarySubIdent;
Procedure TestArrayElement;
Procedure TestArrayElementrecord;
Procedure TestArrayElementRecord;
Procedure TestArrayElement2Dims;
Procedure TestFunctionCall;
Procedure TestFunctionCall2args;
Procedure TestFunctionCallNoArgs;
Procedure ParseStrWithFormatFullyQualified;
Procedure TestSubIdentStrWithFormat;
Procedure TestAPlusCallB;
Procedure TestAPlusBBracketFuncParams;
Procedure TestAPlusBBracketArrayParams;
Procedure TestAPlusBBracketDotC;
Procedure TestADotBDotC;
Procedure TestRange;
Procedure TestBracketsTotal;
Procedure TestBracketsLeft;
@ -257,7 +262,7 @@ begin
AssertExpression('Simple identifier',theExpr,pekIdent,'b');
end;
procedure TTestExpressions.TestBinaryFullIdent;
procedure TTestExpressions.TestBinarySubIdent;
begin
DeclareVar('integer','a');
DeclareVar('record x,y : integer; end','b');
@ -282,7 +287,7 @@ begin
AssertExpression('Simple identifier',p.params[0],pekNumber,'1');
end;
procedure TTestExpressions.TestArrayElementrecord;
procedure TTestExpressions.TestArrayElementRecord;
Var
P : TParamsExpr;
@ -290,14 +295,15 @@ Var
begin
DeclareVar('record a : array[1..2] of integer; end ','b');
ParseExpression('b.a[1]');
B:=AssertExpression('Binary of record',TheExpr,pekBinary,TBinaryExpr) as TBinaryExpr;
AssertEquals('Name is Subident',eopSubIdent,B.Opcode);
AssertExpression('Name of array',B.Left,pekIdent,'b');
P:=TParamsExpr(AssertExpression('Simple identifier',B.right,pekArrayParams,TParamsExpr));
AssertExpression('Name of array',P.Value,pekIdent,'a');
P:=TParamsExpr(AssertExpression('Array Param',TheExpr,pekArrayParams,TParamsExpr));
TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
AssertEquals('One dimension',1,Length(P.params));
AssertExpression('Simple identifier',P.params[0],pekNumber,'1');
B:=TBinaryExpr(AssertExpression('Binary of record',P.Value,pekBinary,TBinaryExpr));
AssertEquals('Name is Subident',eopSubIdent,B.Opcode);
AssertExpression('Name of array',B.Left,pekIdent,'b');
AssertExpression('Name of array',B.right,pekIdent,'a');
TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
end;
@ -1124,7 +1130,7 @@ begin
AssertNotNull('Have left',AOperand);
end;
Procedure TTestExpressions.ParseStrWithFormatFullyQualified;
procedure TTestExpressions.TestSubIdentStrWithFormat;
Var
P : TParamsExpr;
@ -1134,12 +1140,113 @@ 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');
P:=TParamsExpr(AssertExpression('Params',TheExpr,pekFuncParams,TParamsExpr));
TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
AssertEquals('2 argument',2,Length(p.params));
AssertExpression('Simple identifier',p.params[0],pekIdent,'i');
AssertExpression('Simple identifier',p.params[1],pekIdent,'a');
TAssert.AssertSame('P.params[0].parent=P',P,P.params[0].Parent);
TAssert.AssertSame('P.params[1].parent=P',P,P.params[1].Parent);
B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
AssertExpression('Name of unit',B.left,pekIdent,'system');
AssertExpression('Name of function',B.right,pekIdent,'str');
TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
end;
procedure TTestExpressions.TestAPlusCallB;
var
B: TBinaryExpr;
P: TParamsExpr;
begin
DeclareVar('string','a');
DeclareVar('integer','b');
ParseExpression('a+b(1)');
B:=TBinaryExpr(AssertExpression('Binary identifier',TheExpr,pekBinary,TBinaryExpr));
AssertExpression('left a',B.left,pekIdent,'a');
TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
P:=TParamsExpr(AssertExpression('Params',B.right,pekFuncParams,TParamsExpr));
TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
AssertEquals('1 argument',1,Length(p.params));
AssertExpression('param 1',p.params[0],pekNumber,'1');
end;
procedure TTestExpressions.TestAPlusBBracketFuncParams;
var
P: TParamsExpr;
B: TBinaryExpr;
begin
DeclareVar('string','a');
DeclareVar('integer','b');
ParseExpression('(a+b)(1)');
P:=TParamsExpr(AssertExpression('Params',TheExpr,pekFuncParams,TParamsExpr));
TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
AssertEquals('1 argument',1,Length(p.params));
AssertExpression('param 1',p.params[0],pekNumber,'1');
B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
AssertExpression('left a',B.left,pekIdent,'a');
AssertExpression('right b',B.right,pekIdent,'b');
end;
procedure TTestExpressions.TestAPlusBBracketArrayParams;
var
B: TBinaryExpr;
P: TParamsExpr;
begin
DeclareVar('string','a');
DeclareVar('integer','b');
ParseExpression('(a+b)[1]');
P:=TParamsExpr(AssertExpression('Params',TheExpr,pekArrayParams,TParamsExpr));
TAssert.AssertSame('P.value.parent=P',P,P.Value.Parent);
AssertEquals('1 argument',1,Length(p.params));
AssertExpression('param 1',p.params[0],pekNumber,'1');
B:=TBinaryExpr(AssertExpression('Binary identifier',P.Value,pekBinary,TBinaryExpr));
TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
AssertExpression('left a',B.left,pekIdent,'a');
AssertExpression('right b',B.right,pekIdent,'b');
end;
procedure TTestExpressions.TestAPlusBBracketDotC;
var
B, PlusB: TBinaryExpr;
begin
DeclareVar('string','a');
DeclareVar('integer','b');
ParseExpression('(a+b).c');
B:=TBinaryExpr(AssertExpression('Binary identifier',TheExpr,pekBinary,TBinaryExpr));
AssertEquals('().',eopSubIdent,B.OpCode);
TAssert.AssertSame('B.left.parent=B',B,B.left.Parent);
TAssert.AssertSame('B.right.parent=B',B,B.right.Parent);
AssertExpression('right c',B.right,pekIdent,'c');
PlusB:=TBinaryExpr(AssertExpression('Binary identifier',B.left,pekBinary,TBinaryExpr));
TAssert.AssertSame('PlusB.left.parent=PlusB',PlusB,PlusB.left.Parent);
TAssert.AssertSame('PlusB.right.parent=PlusB',PlusB,PlusB.right.Parent);
AssertExpression('left a',PlusB.left,pekIdent,'a');
AssertExpression('right b',PlusB.right,pekIdent,'b');
end;
procedure TTestExpressions.TestADotBDotC;
var
B, SubB: TBinaryExpr;
begin
ParseExpression('a.b.c');
B:=TBinaryExpr(AssertExpression('Binary identifier',TheExpr,pekBinary,TBinaryExpr));
AssertEquals('dot 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('right c',B.right,pekIdent,'c');
SubB:=TBinaryExpr(AssertExpression('Binary identifier',B.left,pekBinary,TBinaryExpr));
TAssert.AssertSame('PlusB.left.parent=PlusB',SubB,SubB.left.Parent);
TAssert.AssertSame('PlusB.right.parent=PlusB',SubB,SubB.right.Parent);
AssertExpression('left a',SubB.left,pekIdent,'a');
AssertExpression('right b',SubB.right,pekIdent,'b');
end;
initialization