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

fcl-passrc: parser: use operator position for TBinaryExpr

Browse Source 
git-svn-id: trunk@37245 -
This commit is contained in:
Mattias Gaertner 2017-09-18 08:29:48 +00:00
parent e709afc543
commit b2796c13b6
6 changed files with 112 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -299,7 +299,8 @@ type
function CreateElement(AClass: TPTreeElement; const AName: String; AParent: TPasElement; AVisibility: TPasMemberVisibility; const ASrcPos: TPasSourcePos): TPasElement;overload;
function CreatePrimitiveExpr(AParent: TPasElement; AKind: TPasExprKind; const AValue: String): TPrimitiveExpr;
function CreateBoolConstExpr(AParent: TPasElement; AKind: TPasExprKind; const ABoolValue : Boolean): TBoolConstExpr;
function CreateBinaryExpr(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode): TBinaryExpr;
function CreateBinaryExpr(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode): TBinaryExpr; overload;
function CreateBinaryExpr(AParent : TPasElement; xleft, xright: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos): TBinaryExpr; overload;
procedure AddToBinaryExprChain(var ChainFirst: TPasExpr;
Element: TPasExpr; AOpCode: TExprOpCode);
procedure AddParamsToBinaryExprChain(var ChainFirst: TPasExpr;
@ -307,7 +308,8 @@ type
{$IFDEF VerbosePasParser}
procedure WriteBinaryExprChain(Prefix: string; First, Last: TPasExpr);
{$ENDIF}
function CreateUnaryExpr(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode): TUnaryExpr;
function CreateUnaryExpr(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode): TUnaryExpr; overload;
function CreateUnaryExpr(AParent : TPasElement; AOperand: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos): TUnaryExpr; overload;
function CreateArrayValues(AParent : TPasElement): TArrayValues;
function CreateFunctionType(const AName, AResultName: String; AParent: TPasElement;
UseParentAsResultParent: Boolean; const NamePos: TPasSourcePos): TPasFunctionType;
@ -2190,14 +2192,20 @@ begin
end;
function TPasParser.DoParseExpression(AParent : TPaselement;InitExpr: TPasExpr; AllowEqual : Boolean = True): TPasExpr;
type
TOpStackItem = record
Token: TToken;
SrcPos: TPasSourcePos;
end;
var
expstack : TFPList;
opstack : array of TToken;
opstackTop: integer;
pcount : Integer;
ExpStack : TFPList;
OpStack : array of TOpStackItem;
OpStackTop: integer;
PrefixCnt : Integer;
x : TPasExpr;
i : Integer;
tempop : TToken;
TempOp : TToken;
NotBinary : Boolean;
const
@ -2210,31 +2218,38 @@ const
function PopExp: TPasExpr; inline;
begin
if expstack.Count>0 then begin
Result:=TPasExpr(expstack[expstack.Count-1]);
expstack.Delete(expstack.Count-1);
if ExpStack.Count>0 then begin
Result:=TPasExpr(ExpStack[ExpStack.Count-1]);
ExpStack.Delete(ExpStack.Count-1);
end else
Result:=nil;
end;
procedure PushOper(token: TToken); inline;
procedure PushOper(Token: TToken);
begin
inc(opstackTop);
if opstackTop=length(opstack) then
SetLength(opstack,length(opstack)*2+4);
opstack[opstackTop]:=token;
inc(OpStackTop);
if OpStackTop=length(OpStack) then
SetLength(OpStack,length(OpStack)*2+4);
OpStack[OpStackTop].Token:=Token;
OpStack[OpStackTop].SrcPos:=CurTokenPos;
end;
function PeekOper: TToken; inline;
begin
if opstackTop>=0 then Result:=opstack[opstackTop]
if OpStackTop>=0 then Result:=OpStack[OpStackTop].Token
else Result:=tkEOF;
end;
function PopOper: TToken; inline;
function PopOper(out SrcPos: TPasSourcePos): TToken;
begin
Result:=PeekOper;
if Result<>tkEOF then dec(opstackTop);
if Result=tkEOF then
SrcPos:=DefPasSourcePos
else
begin
SrcPos:=OpStack[OpStackTop].SrcPos;
dec(OpStackTop);
end;
end;
procedure PopAndPushOperator;
@ -2243,22 +2258,24 @@ const
xright : TPasExpr;
xleft : TPasExpr;
bin : TBinaryExpr;
SrcPos: TPasSourcePos;
begin
t:=PopOper;
t:=PopOper(SrcPos);
xright:=PopExp;
xleft:=PopExp;
if t=tkDotDot then
begin
bin:=CreateBinaryExpr(AParent,xleft,xright,eopNone);
bin:=CreateBinaryExpr(AParent,xleft,xright,eopNone,SrcPos);
bin.Kind:=pekRange;
end
else
bin:=CreateBinaryExpr(AParent,xleft,xright,TokenToExprOp(t));
expstack.Add(bin);
bin:=CreateBinaryExpr(AParent,xleft,xright,TokenToExprOp(t),SrcPos);
ExpStack.Add(bin);
end;
Var
AllowedBinaryOps : Set of TToken;
SrcPos: TPasSourcePos;
begin
AllowedBinaryOps:=BinaryOP;
@ -2266,13 +2283,13 @@ begin
Exclude(AllowedBinaryOps,tkEqual);
//DumpCurToken('Entry',iaIndent);
Result:=nil;
expstack := TFPList.Create;
SetLength(opstack,4);
opstackTop:=-1;
ExpStack := TFPList.Create;
SetLength(OpStack,4);
OpStackTop:=-1;
try
repeat
NotBinary:=True;
pcount:=0;
PrefixCnt:=0;
if not Assigned(InitExpr) then
begin
// the first part of the expression has been parsed externally.
@ -2291,7 +2308,7 @@ begin
while CurToken in PrefixSym do
begin
PushOper(CurToken);
inc(pcount);
inc(PrefixCnt);
NextToken;
end;
@ -2311,6 +2328,7 @@ begin
x:=CreateUnaryExpr(AParent,x, TokenToExprOp(tkCaret));
NextToken;
end;
// ToDo: move dot below []
// for expressions like (TObject(m)).Free;
if (x<>Nil) and (CurToken=tkDot) then
begin
@ -2329,34 +2347,35 @@ begin
end;
if not Assigned(x) then
ParseExcSyntaxError;
expstack.Add(x);
ExpStack.Add(x);
for i:=1 to pcount do
for i:=1 to PrefixCnt do
begin
tempop:=PopOper;
x:=popexp;
if (tempop=tkMinus) and (x.Kind=pekRange) then
TempOp:=PopOper(SrcPos);
x:=PopExp;
if (TempOp=tkMinus) and (x.Kind=pekRange) then
begin
TBinaryExpr(x).Left:=CreateUnaryExpr(x, TBinaryExpr(x).left, eopSubtract);
expstack.Add(x);
TBinaryExpr(x).Left:=CreateUnaryExpr(x, TBinaryExpr(x).left,
eopSubtract, SrcPos);
ExpStack.Add(x);
end
else
expstack.Add(CreateUnaryExpr(AParent, x, TokenToExprOp(tempop) ));
ExpStack.Add(CreateUnaryExpr(AParent, x, TokenToExprOp(TempOp), SrcPos));
end;
end
else
begin
expstack.Add(InitExpr);
ExpStack.Add(InitExpr);
InitExpr:=nil;
end;
if (CurToken in AllowedBinaryOPs) then
begin
// Adjusting order of the operations
NotBinary:=False;
tempop:=PeekOper;
while (opstackTop>=0) and (OpLevel(tempop)>=OpLevel(CurToken)) do begin
TempOp:=PeekOper;
while (OpStackTop>=0) and (OpLevel(TempOp)>=OpLevel(CurToken)) do begin
PopAndPushOperator;
tempop:=PeekOper;
TempOp:=PeekOper;
end;
PushOper(CurToken);
NextToken;
@ -2366,14 +2385,14 @@ begin
if not NotBinary then ParseExcExpectedIdentifier;
while opstackTop>=0 do PopAndPushOperator;
while OpStackTop>=0 do PopAndPushOperator;
// only 1 expression should be on the stack, at the end of the correct expression
if expstack.Count<>1 then
// only 1 expression should be on the OpStack, at the end of the correct expression
if ExpStack.Count<>1 then
ParseExcSyntaxError;
if expstack.Count=1 then
if ExpStack.Count=1 then
begin
Result:=TPasExpr(expstack[0]);
Result:=TPasExpr(ExpStack[0]);
Result.Parent:=AParent;
end;
@ -2384,11 +2403,11 @@ begin
DumpCurtoken('Exiting (Result: "'+Result.GetDeclaration(true)+'") ',iaUndent);}
if not Assigned(Result) then begin
// expression error!
for i:=0 to expstack.Count-1 do
TPasExpr(expstack[i]).Release;
for i:=0 to ExpStack.Count-1 do
TPasExpr(ExpStack[i]).Release;
end;
SetLength(opstack,0);
expstack.Free;
SetLength(OpStack,0);
ExpStack.Free;
end;
end;
@ -6037,7 +6056,10 @@ function TPasParser.CreateElement(AClass: TPTreeElement; const AName: String;
AParent: TPasElement; AVisibility: TPasMemberVisibility;
const ASrcPos: TPasSourcePos): TPasElement;
begin
Result := Engine.CreateElement(AClass, AName, AParent, AVisibility, ASrcPos);
if (ASrcPos.Row=0) and (ASrcPos.FileName='') then
Result := Engine.CreateElement(AClass, AName, AParent, AVisibility, CurSourcePos)
else
Result := Engine.CreateElement(AClass, AName, AParent, AVisibility, ASrcPos);
end;
function TPasParser.CreatePrimitiveExpr(AParent: TPasElement;
@ -6059,7 +6081,14 @@ end;
function TPasParser.CreateBinaryExpr(AParent: TPasElement; xleft,
xright: TPasExpr; AOpCode: TExprOpCode): TBinaryExpr;
begin
Result:=TBinaryExpr(CreateElement(TBinaryExpr,'',AParent));
Result:=CreateBinaryExpr(AParent,xleft,xright,AOpCode,CurSourcePos);
end;
function TPasParser.CreateBinaryExpr(AParent: TPasElement; xleft,
xright: TPasExpr; AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos
): TBinaryExpr;
begin
Result:=TBinaryExpr(CreateElement(TBinaryExpr,'',AParent,ASrcPos));
Result.OpCode:=AOpCode;
Result.Kind:=pekBinary;
if xleft<>nil then
@ -6187,7 +6216,13 @@ end;
function TPasParser.CreateUnaryExpr(AParent: TPasElement; AOperand: TPasExpr;
AOpCode: TExprOpCode): TUnaryExpr;
begin
Result:=TUnaryExpr(CreateElement(TUnaryExpr,'',AParent,CurTokenPos));
Result:=CreateUnaryExpr(AParent,AOperand,AOpCode,CurTokenPos);
end;
function TPasParser.CreateUnaryExpr(AParent: TPasElement; AOperand: TPasExpr;
AOpCode: TExprOpCode; const ASrcPos: TPasSourcePos): TUnaryExpr;
begin
Result:=TUnaryExpr(CreateElement(TUnaryExpr,'',AParent,ASrcPos));
Result.Kind:=pekUnary;
Result.Operand:=AOperand;
Result.Operand.Parent:=Result;

2
packages/fcl-passrc/src/pscanner.pp
View File

@ -493,6 +493,8 @@ type
FileName: String;
Row, Column: Cardinal;
end;
const
DefPasSourcePos: TPasSourcePos = (Filename:''; Row:0; Column:0);
type
{ TPascalScanner }

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

@ -6954,7 +6954,7 @@ begin
Add(' Some: longint;');
Add(' end;');
Add('begin');
CheckResolverException('Duplicate identifier "Some" at afile.pp(5,9)',nDuplicateIdentifier);
CheckResolverException('Duplicate identifier "Some" at afile.pp(5,5)',nDuplicateIdentifier);
end;
procedure TTestResolver.TestClass_ReintroducePrivateVar;

4
packages/pastojs/src/fppas2js.pp
View File

@ -1119,8 +1119,8 @@ type
ForLoop: TPasImplForLoop;
LoopVar: TPasElement;
FoundLoop: boolean;
LoopVarWrite: boolean; // true if first acces of LoopVar after loop is a write
LoopVarRead: boolean; // true if first acces of LoopVar after loop is a read
LoopVarWrite: boolean; // true if first access of LoopVar after loop is a write
LoopVarRead: boolean; // true if first access of LoopVar after loop is a read
end;
PForLoopFindData = ^TForLoopFindData;
procedure ForLoop_OnProcBodyElement(El: TPasElement; arg: pointer);

2
packages/pastojs/tests/tcmodules.pas
View File

@ -9289,7 +9289,7 @@ begin
Add(' Id: longint;');
Add(' end;');
Add('begin');
SetExpectedPasResolverError('Duplicate identifier "Id" at test1.pp(6,7)',nDuplicateIdentifier);
SetExpectedPasResolverError('Duplicate identifier "Id" at test1.pp(6,5)',nDuplicateIdentifier);
ConvertProgram;
end;

23
packages/pastojs/tests/tcsrcmap.pas
View File

@ -56,6 +56,7 @@ type
procedure TestEmptyProgram;
procedure TestEmptyUnit;
procedure TestIf;
procedure TestFor;
end;
implementation
@ -91,13 +92,14 @@ begin
end;
procedure TCustomTestSrcMap.CheckSrcMap(const aTitle: string);
{$IFDEF VerbosePas2JS}
var
i: Integer;
{$ENDIF}
begin
{$IFDEF VerbosePas2JS}
writeln('TCustomTestSrcMap.CheckSrcMap ',aTitle);
{$ENDIF}
for i:=0 to SrcMap.Count-1 do
{for i:=0 to SrcMap.Count-1 do
begin
write('TCustomTestSrcMap.CheckSrcMap i=',i,' Gen=',
SrcMap[i].GeneratedLine,',',SrcMap[i].GeneratedColumn);
@ -105,10 +107,12 @@ begin
if SrcMap[i].SrcFileIndex>0 then
write(SrcMap.SourceFiles[SrcMap[i].SrcFileIndex],',');
writeln(SrcMap[i].SrcLine,',',SrcMap[i].SrcColumn);
end;
end;}
for i:=1 to JSSource.Count do
WriteSrcMapLine(i);
writeln('......012345678901234567890123456789012345678901234567890123456789');
WriteSources(Filename,1,1);
{$ENDIF}
end;
procedure TCustomTestSrcMap.WriteSrcMapLine(GeneratedLine: integer);
@ -234,6 +238,19 @@ begin
CheckSrcMap('TestEmptyProgram');
end;
procedure TTestSrcMap.TestFor;
begin
StartProgram(false);
Add([
'var Runner, i: longint;',
'begin',
' for Runner := 1000 + 2000 to 3000 do',
' inc(i);',
'']);
ConvertProgram;
CheckSrcMap('TestEmptyProgram');
end;
Initialization
RegisterTests([TTestSrcMap]);