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

* Fix some bordercases for if..then (bug ID 30717)

Browse Source 
git-svn-id: trunk@34882 -
This commit is contained in:
michael 2016-11-12 22:47:14 +00:00
parent 62e8807ebd
commit 58d0239558
2 changed files with 49 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -3910,6 +3910,16 @@ begin
//if .. then while .. do smt else .. //if .. then while .. do smt else ..
CloseBlock; CloseBlock;
UngetToken; UngetToken;
end else if (CurBlock is TPasImplForLoop) then
begin
//if .. then for .. do smt else ..
CloseBlock;
UngetToken;
end else if (CurBlock is TPasImplWithDo) then
begin
//if .. then with .. do smt else ..
CloseBlock;
UngetToken;
end else if (CurBlock is TPasImplRaise) then end else if (CurBlock is TPasImplRaise) then
begin begin
//if .. then Raise Exception else .. //if .. then Raise Exception else ..
@ -4173,7 +4183,7 @@ begin
El:=TPasImplRaise(CreateElement(TPasImplRaise,'',CurBlock)); El:=TPasImplRaise(CreateElement(TPasImplRaise,'',CurBlock));
CreateBlock(TPasImplRaise(El)); CreateBlock(TPasImplRaise(El));
NextToken; NextToken;
If Curtoken in [tkEnd,tkSemicolon] then If Curtoken in [tkElse,tkEnd,tkSemicolon] then
UnGetToken UnGetToken
else else
begin begin

38
packages/fcl-passrc/tests/tcstatements.pas
View File

@ -63,6 +63,9 @@ Type
Procedure TestIfElse; Procedure TestIfElse;
Procedure TestIfElseBlock; Procedure TestIfElseBlock;
Procedure TestIfSemiColonElseError; Procedure TestIfSemiColonElseError;
procedure TestIfforElseBlock;
procedure TestIfRaiseElseBlock;
procedure TestIfWithBlock;
Procedure TestNestedIf; Procedure TestNestedIf;
Procedure TestNestedIfElse; Procedure TestNestedIfElse;
Procedure TestWhile; Procedure TestWhile;
@ -583,6 +586,41 @@ begin
AssertEquals('begin end block',TPasImplBeginBlock,I.ElseBranch.ClassType); AssertEquals('begin end block',TPasImplBeginBlock,I.ElseBranch.ClassType);
end; end;
procedure TTestStatementParser.TestIfforElseBlock;
Var
I : TPasImplIfElse;
begin
TestStatement(['if a then','for X := 1 downto 0 do Writeln(X)','else', 'for X := 0 to 1 do Writeln(X)']);
I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
AssertEquals('For statement',TPasImplForLoop,I.ifBranch.ClassType);
AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
end;
procedure TTestStatementParser.TestIfRaiseElseBlock;
Var
I : TPasImplIfElse;
begin
TestStatement(['if a then','raise','else', 'for X := 0 to 1 do Writeln(X)']);
I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
AssertEquals('For statement',TPasImplRaise,I.ifBranch.ClassType);
AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
end;
procedure TTestStatementParser.TestIfWithBlock;
Var
I : TPasImplIfElse;
begin
TestStatement(['if a then','with b do something','else', 'for X := 0 to 1 do Writeln(X)']);
I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
AssertEquals('For statement',TPasImplWithDo,I.ifBranch.ClassType);
AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
end;
procedure TTestStatementParser.TestIfSemiColonElseError; procedure TTestStatementParser.TestIfSemiColonElseError;
begin begin