fcl-passrc: parse if then goto

packages/fcl-passrc/src/pparser.pp

@@ -5989,7 +5989,11 @@ begin
 end;
 
 // Next token is start of (compound) statement
-// After parsing CurToken is on last token of statement
+// After parsing CurToken is on last token of statement, which might be the semicolon
+// For example:
+//  try..finally..end|
+//  DoSomething| else
+//  DoSomething;| NextStatement
 procedure TPasParser.ParseStatement(Parent: TPasImplBlock;
   out NewImplElement: TPasImplElement);
 var
@@ -6087,6 +6091,7 @@ var
   ImplRaise: TPasImplRaise;
   VarEl: TPasVariable;
   ImplExceptOn: TPasImplExceptOn;
+  ImplGoto: TPasImplGoto;
 
 begin
   NewImplElement:=nil;
@@ -6223,8 +6228,9 @@ begin
         CheckStatementCanStart;
         SrcPos:=CurTokenPos;
         ExpectTokens([tkIdentifier,tkNumber]);
-        El:=TPasImplGoto(CreateElement(TPasImplGoto,'',CurBlock,SrcPos));
-        TPasImplGoto(El).LabelName:=CurTokenString;
+        ImplGoto:=TPasImplGoto(CreateElement(TPasImplGoto,'',CurBlock,SrcPos));
+        CreateBlock(ImplGoto);
+        ImplGoto.LabelName:=CurTokenString;
         end;
       tkfor:
         begin
@@ -6431,12 +6437,15 @@ begin
         CreateBlock(ImplRaise);
         NextToken;
         If Curtoken in [tkElse,tkEnd,tkSemicolon,tkotherwise] then
+          // raise without object
           UnGetToken
         else
           begin
+          // raise with object
           ImplRaise.ExceptObject:=DoParseExpression(ImplRaise);
           if (CurToken=tkIdentifier) and (Uppercase(CurtokenString)='AT') then
             begin
+            // raise object at expr
             NextToken;
             ImplRaise.ExceptAddr:=DoParseExpression(ImplRaise);
             end;

packages/fcl-passrc/tests/tcstatements.pas

@@ -68,6 +68,7 @@ Type
     Procedure TestIfSemiColonElseError;
     procedure TestIfforElseBlock;
     procedure TestIfRaiseElseBlock;
+    procedure TestIfGotoElseBlock;
     procedure TestIfWithBlock;
     Procedure TestNestedIf;
     Procedure TestNestedIfElse;
@@ -108,6 +109,7 @@ Type
     Procedure TestRaise;
     Procedure TestRaiseEmpty;
     Procedure TestRaiseAt;
+    Procedure TestGoto;
     Procedure TestTryFinally;
     Procedure TestTryFinallyEmpty;
     Procedure TestTryFinallyNested;
@@ -660,7 +662,18 @@ 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('Raise statement',TPasImplRaise,I.ifBranch.ClassType);
+  AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
+end;
+
+procedure TTestStatementParser.TestIfGotoElseBlock;
+Var
+  I : TPasImplIfElse;
+begin
+  TestStatement(['if a then','goto bird','else', 'for X := 0 to 1 do Writeln(X)']);
+  I:=AssertStatement('If statement',TPasImplIfElse) as TPasImplIfElse;
+  AssertExpression('IF condition',I.ConditionExpr,pekIdent,'a');
+  AssertEquals('Goto statement',TPasImplGoto,I.ifBranch.ClassType);
   AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
 end;
 
@@ -671,7 +684,7 @@ 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('With statement',TPasImplWithDo,I.ifBranch.ClassType);
   AssertEquals('For statement',TPasImplForLoop,I.ElseBranch.ClassType);
 end;
 
@@ -1450,6 +1463,18 @@ begin
   AssertExpression('Expression object',R.ExceptAddr,pekIdent,'B');
 end;
 
+procedure TTestStatementParser.TestGoto;
+
+Var
+  R : TPasImplGoto;
+
+begin
+  TestStatement('Goto A;');
+  R:=AssertStatement('Goto statement',TPasImplGoto) as TPasImplGoto;
+  AssertEquals(0,R.Elements.Count);
+  AssertEquals('A',R.LabelName);
+end;
+
 procedure TTestStatementParser.TestTryFinally;
 
 Var