mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-19 12:19:25 +02:00
* Fix some bordercases for if..then (bug ID 30717)
git-svn-id: trunk@34882 -
This commit is contained in:
parent
62e8807ebd
commit
58d0239558
@ -3910,6 +3910,16 @@ begin
|
||||
//if .. then while .. do smt else ..
|
||||
CloseBlock;
|
||||
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
|
||||
begin
|
||||
//if .. then Raise Exception else ..
|
||||
@ -4173,7 +4183,7 @@ begin
|
||||
El:=TPasImplRaise(CreateElement(TPasImplRaise,'',CurBlock));
|
||||
CreateBlock(TPasImplRaise(El));
|
||||
NextToken;
|
||||
If Curtoken in [tkEnd,tkSemicolon] then
|
||||
If Curtoken in [tkElse,tkEnd,tkSemicolon] then
|
||||
UnGetToken
|
||||
else
|
||||
begin
|
||||
|
@ -63,6 +63,9 @@ Type
|
||||
Procedure TestIfElse;
|
||||
Procedure TestIfElseBlock;
|
||||
Procedure TestIfSemiColonElseError;
|
||||
procedure TestIfforElseBlock;
|
||||
procedure TestIfRaiseElseBlock;
|
||||
procedure TestIfWithBlock;
|
||||
Procedure TestNestedIf;
|
||||
Procedure TestNestedIfElse;
|
||||
Procedure TestWhile;
|
||||
@ -583,6 +586,41 @@ begin
|
||||
AssertEquals('begin end block',TPasImplBeginBlock,I.ElseBranch.ClassType);
|
||||
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;
|
||||
|
||||
begin
|
||||
|
Loading…
Reference in New Issue
Block a user