Add support for Resume <label>. Fixes #7646

vbnc/vbnc/source/Parser/Parser.vb

@@ -5074,11 +5074,19 @@ Public Class Parser
 
     Private Function ParseResumeStatement(ByVal Parent As ParsedObject) As ResumeStatement
         Dim m_IsResumeNext As Boolean
+        Dim m_TargetLabel As Token? = Nothing
+        Dim m_TargetLocation As Span? = Nothing
 
         tm.AcceptIfNotInternalError(KS.Resume)
-        m_IsResumeNext = tm.Accept(KS.Next)
+        If tm.Accept(KS.Next) Then
+            m_IsResumeNext = True
+        ElseIf tm.CurrentToken.IsIdentifier OrElse tm.CurrentToken.IsIntegerLiteral Then
+            m_TargetLabel = tm.CurrentToken
+            m_TargetLocation = tm.CurrentLocation
+            tm.NextToken()
+        End If
 
-        Return New ResumeStatement(Parent, m_IsResumeNext)
+        Return New ResumeStatement(Parent, m_IsResumeNext, m_TargetLabel, m_TargetLocation)
     End Function
 
     ''' <summary>

vbnc/vbnc/source/Statements/ResumeStatement.vb

@@ -20,10 +20,15 @@ Public Class ResumeStatement
     Inherits Statement
 
     Private m_IsResumeNext As Boolean
+    Private m_TargetLabel As Token?
+    Private m_TargetLocation As Span?
+    Private m_TargetLabelDeclaration As LabelDeclarationStatement
 
-    Sub New(ByVal Parent As ParsedObject, ByVal IsResumeNext As Boolean)
+    Sub New(ByVal Parent As ParsedObject, ByVal IsResumeNext As Boolean, TargetLabel As Token?, TargetLocation As Span?)
         MyBase.New(Parent)
         m_IsResumeNext = IsResumeNext
+        m_TargetLabel = TargetLabel
+        m_TargetLocation = TargetLocation
     End Sub
 
     Public Overrides Function ResolveTypeReferences() As Boolean
@@ -55,15 +60,19 @@ Public Class ResumeStatement
         Emitter.EmitThrow(Info)
 
         Emitter.MarkLabel(Info, ResumeOK)
-        'Load the instruction switch index
-        Emitter.EmitLoadVariable(Info, block.VB_CurrentInstruction)
-        'Increment the instruction pointer if it is a Resume Next statement
-        If m_IsResumeNext Then
-            Emitter.EmitLoadI4Value(Info, 1)
-            Emitter.EmitAdd(Info, Compiler.TypeCache.System_Int32)
+        If m_TargetLabelDeclaration IsNot Nothing Then
+            Emitter.EmitBranchOrLeave(Info, m_TargetLabelDeclaration.GetLabel(Info), Me, m_TargetLabelDeclaration)
+        Else
+            'Load the instruction switch index
+            Emitter.EmitLoadVariable(Info, block.VB_CurrentInstruction)
+            'Increment the instruction pointer if it is a Resume Next statement
+            If m_IsResumeNext Then
+                Emitter.EmitLoadI4Value(Info, 1)
+                Emitter.EmitAdd(Info, Compiler.TypeCache.System_Int32)
+            End If
+            'If everything is ok, jump to the instruction switch (adding one to the instruction if necessary)
+            Emitter.EmitLeave(Info, block.UnstructuredResumeHandler)
         End If
-        'If everything is ok, jump to the instruction switch (adding one to the instruction if necessary)
-        Emitter.EmitLeave(Info, block.UnstructuredResumeHandler)
 
         Return result
     End Function
@@ -77,6 +86,14 @@ Public Class ResumeStatement
         block.HasUnstructuredExceptionHandling = True
         block.HasResume = True
 
+        If m_TargetLabel.HasValue Then
+            m_TargetLabelDeclaration = FindFirstParent(Of CodeBlock)().FindLabel(m_TargetLabel.Value)
+            If m_TargetLabelDeclaration Is Nothing Then
+                result = Report.ShowMessage(Messages.VBNC30132, m_TargetLocation.Value, m_TargetLabel.Value.Identifier) AndAlso result
+            End If
+        End If
+
         Return True
     End Function
 End Class
+

vbnc/vbnc/tests/Bugs/bug-7646.vb

@@ -0,0 +1,18 @@
+Module Module1
+    Function Main() As Integer
+        On Error GoTo HandleErrors
+
+        Console.WriteLine("Throwing exception")
+        Throw New Exception()
+
+ExitHere:
+        Console.WriteLine("In resume label")
+        Return 0
+
+HandleErrors:
+        Console.WriteLine("In error handler")
+        Resume ExitHere
+
+        Return 1
+    End Function
+End Module

vbnc/vbnc/tests/Errors/30132-1.vb

@@ -0,0 +1,27 @@
+Module Module1
+    Sub TestVB6()
+        On Error GoTo HandleErrors
+
+
+        ' Do something in here that
+        ' might raise an error.
+
+ExitHere:
+        ' Perform cleanup code here.
+        ' Disregard errors in this
+        ' cleanup code.
+        On Error Resume Next
+        ' Perform cleanup code.
+        Exit Sub
+
+HandleErrors:
+        Select Case Err.Number
+            ' Add cases for each
+            ' error number you want to trap.
+            Case Else
+                ' Add "last-ditch" error handler.
+                Console.WriteLine("Error: " & Err.Description)
+        End Select
+        Resume ExitHere2
+    End Sub
+End Module

vbnc/vbnc/tests/tests.xml

@@ -24631,4 +24631,11 @@
 		<file>Bugs\bug-7616.vb</file>
 		<error line="6" number="30321" message="'Case' cannot follow a 'Case Else' in the same 'Select' statement." />
 	</test>
+	<test id="3159" name="bug-7646" target="exe" mytype="empty">
+		<file>Bugs\bug-7646.vb</file>
+	</test>
+	<test id="3160" name="30132-1" expectedexitcode="1">
+		<file>Errors\30132-1.vb</file>
+		<error line="25" number="30132" message="Label 'ExitHere2' is not defined." />
+	</test>
 </rt>