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

* Patch from Mattias Gaertner, fixing unita.classb.doit test

Browse Source 
git-svn-id: trunk@34237 -
This commit is contained in:
michael 2016-07-30 16:49:10 +00:00
parent f08d136290
commit 4707099c5b
2 changed files with 88 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
packages/fcl-passrc/src/pastree.pp
View File

@ -178,6 +178,8 @@ type
constructor CreateRange(AParent : TPasElement; xleft, xright: TPasExpr); overload;
function GetDeclaration(full : Boolean) : string; override;
destructor Destroy; override;
class procedure AddToChain(var ChainFirst, ChainLast: TPasExpr;
Element: TPasExpr; AParent : TPasElement; AOpCode: TExprOpCode);
end;
TPrimitiveExpr = class(TPasExpr)
@ -3531,7 +3533,7 @@ end;
{ TBinaryExpr }
function TBinaryExpr.GetDeclaration(Full : Boolean):AnsiString;
function TBinaryExpr.GetDeclaration(full: Boolean): string;
function OpLevel(op: TPasExpr): Integer;
begin
case op.OpCode of
@ -3578,14 +3580,18 @@ constructor TBinaryExpr.Create(AParent : TPasElement; xleft,xright:TPasExpr; AOp
begin
inherited Create(AParent,pekBinary, AOpCode);
left:=xleft;
left.Parent:=Self;
right:=xright;
right.Parent:=Self;
end;
constructor TBinaryExpr.CreateRange(AParent : TPasElement; xleft,xright:TPasExpr);
begin
inherited Create(AParent,pekRange, eopNone);
left:=xleft;
left.Parent:=Self;
right:=xright;
right.Parent:=Self;
end;
destructor TBinaryExpr.Destroy;
@ -3595,6 +3601,48 @@ begin
inherited Destroy;
end;
class procedure TBinaryExpr.AddToChain(var ChainFirst, ChainLast: TPasExpr;
Element: TPasExpr; AParent: TPasElement; AOpCode: TExprOpCode);
procedure RaiseInternal;
begin
raise Exception.Create('TBinaryExpr.AddToChain: internal error');
end;
var
Last: TBinaryExpr;
begin
if Element=nil then
exit
else if ChainFirst=nil then
begin
// empty chain => simply add element, no need to create TBinaryExpr
if (ChainLast<>nil) then
RaiseInternal;
ChainFirst:=Element;
ChainLast:=Element;
end
else if ChainLast is TBinaryExpr then
begin
// add a new TBinaryExpr at the end of the chain
Last:=TBinaryExpr(ChainLast);
if (Last.left=nil) or (Last.right=nil) then
// chain not yet full => inconsistency
RaiseInternal;
Last.right:=TBinaryExpr.Create(AParent,Last.right,Element,AOpCode);
Last.right.Parent:=last;
ChainLast:=Last;
end
else
begin
// one element => create a TBinaryExpr with two elements
if ChainFirst<>ChainLast then
RaiseInternal;
ChainLast:=TBinaryExpr.Create(AParent,ChainLast,Element,AOpCode);
ChainFirst:=ChainLast;
end;
end;
{ TParamsExpr }
Function TParamsExpr.GetDeclaration(Full: Boolean) : Ansistring;

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

@ -1337,55 +1337,55 @@ end;
function TPasParser.ParseExpIdent(AParent : TPasElement):TPasExpr;
var
x : TPasExpr;
Last , Expr: TPasExpr;
prm : TParamsExpr;
u : TUnaryExpr;
b : TBinaryExpr;
optk : TToken;
ok: Boolean;
begin
Result:=nil;
case CurToken of
tkString: x:=TPrimitiveExpr.Create(AParent,pekString, CurTokenString);
tkChar: x:=TPrimitiveExpr.Create(AParent,pekString, CurTokenText);
tkNumber: x:=TPrimitiveExpr.Create(AParent,pekNumber, CurTokenString);
tkIdentifier: x:=TPrimitiveExpr.Create(AParent,pekIdent, CurTokenText);
tkfalse, tktrue: x:=TBoolConstExpr.Create(Aparent,pekBoolConst, CurToken=tktrue);
tknil: x:=TNilExpr.Create(Aparent);
tkSquaredBraceOpen: x:=ParseParams(AParent,pekSet);
tkString: Last:=TPrimitiveExpr.Create(AParent,pekString, CurTokenString);
tkChar: Last:=TPrimitiveExpr.Create(AParent,pekString, CurTokenText);
tkNumber: Last:=TPrimitiveExpr.Create(AParent,pekNumber, CurTokenString);
tkIdentifier: Last:=TPrimitiveExpr.Create(AParent,pekIdent, CurTokenText);
tkfalse, tktrue: Last:=TBoolConstExpr.Create(Aparent,pekBoolConst, CurToken=tktrue);
tknil: Last:=TNilExpr.Create(Aparent);
tkSquaredBraceOpen: Last:=ParseParams(AParent,pekSet);
tkinherited:
begin
//inherited; inherited function
x:=TInheritedExpr.Create(AParent);
Last:=TInheritedExpr.Create(AParent);
NextToken;
if (CurToken=tkIdentifier) then
begin
b:=TBinaryExpr.Create(AParent,x, DoParseExpression(AParent), eopNone);
b:=TBinaryExpr.Create(AParent,Last, DoParseExpression(AParent), eopNone);
if not Assigned(b.right) then
begin
B.Free;
Exit; // error
end;
x:=b;
Last:=b;
UngetToken;
end
else
UngetToken;
end;
tkself: begin
//x:=TPrimitiveExpr.Create(AParent,pekString, CurTokenText); //function(self);
x:=TSelfExpr.Create(AParent);
//Last:=TPrimitiveExpr.Create(AParent,pekString, CurTokenText); //function(self);
Last:=TSelfExpr.Create(AParent);
NextToken;
if CurToken = tkDot then
begin // self.Write(EscapeText(AText));
optk:=CurToken;
NextToken;
b:=TBinaryExpr.Create(AParent,x, ParseExpIdent(AParent), TokenToExprOp(optk));
b:=TBinaryExpr.Create(AParent,Last, ParseExpIdent(AParent), TokenToExprOp(optk));
if not Assigned(b.right) then
begin
B.Free;
Exit; // error
end;
x:=b;
Last:=b;
end;
UngetToken;
end;
@ -1396,7 +1396,7 @@ begin
UngetToken;
ParseExcExpectedIdentifier;
end;
x:=TPrimitiveExpr.Create(AParent,pekString, '@'+CurTokenText);
Last:=TPrimitiveExpr.Create(AParent,pekString, '@'+CurTokenText);
end;
tkCaret: begin
// ^A..^_ characters. See #16341
@ -1405,23 +1405,27 @@ begin
UngetToken;
ParseExcExpectedIdentifier;
end;
x:=TPrimitiveExpr.Create(AParent,pekString, '^'+CurTokenText);
Last:=TPrimitiveExpr.Create(AParent,pekString, '^'+CurTokenText);
end;
else
ParseExcExpectedIdentifier;
end;
if x.Kind<>pekSet then NextToken;
Result:=Last;
if Last.Kind<>pekSet then NextToken;
ok:=false;
try
if x.Kind=pekIdent then
if Last.Kind=pekIdent then
begin
while CurToken in [tkDot] do
begin
NextToken;
if CurToken=tkIdentifier then
begin
b:=TBinaryExpr.Create(AParent,x, TPrimitiveExpr.Create(AParent,pekIdent, CurTokenText), eopSubIdent);
TBinaryExpr.AddToChain(Result,Last,
TPrimitiveExpr.Create(AParent,pekIdent, CurTokenText), AParent, eopSubIdent);
NextToken;
end
else
@ -1429,7 +1433,6 @@ begin
UngetToken;
ParseExcExpectedIdentifier;
end;
x:=b;
end;
while CurToken in [tkBraceOpen, tkSquaredBraceOpen, tkCaret] do
case CurToken of
@ -1437,20 +1440,22 @@ begin
begin
prm:=ParseParams(AParent,pekFuncParams);
if not Assigned(prm) then Exit;
prm.Value:=x;
x:=prm;
prm.Value:=Last;
Result:=prm;
Last:=prm;
end;
tkSquaredBraceOpen:
begin
prm:=ParseParams(AParent,pekArrayParams);
if not Assigned(prm) then Exit;
prm.Value:=x;
x:=prm;
prm.Value:=Last;
Result:=prm;
Last:=prm;
end;
tkCaret:
begin
u:=TUnaryExpr.Create(AParent,x, TokenToExprOp(CurToken));
x:=u;
Result:=TUnaryExpr.Create(AParent,Result,TokenToExprOp(CurToken));
Last:=Result;
NextToken;
end;
end;
@ -1459,19 +1464,16 @@ begin
begin
optk:=CurToken;
NextToken;
b:=TBinaryExpr.Create(AParent,x, ParseExpIdent(AParent), TokenToExprOp(optk));
if not Assigned(b.right) then
begin
b.free;
Expr:=ParseExpIdent(AParent);
if Expr=nil then
Exit; // error
end;
x:=b;
TBinaryExpr.AddToChain(Result,Last,Expr,AParent,TokenToExprOp(optk));
end;
end;
Result:=x;
ok:=true;
finally
if not Assigned(Result) then x.Free;
if not ok then
FreeAndNil(Result);
end;
end;