rubberduck-vba / Rubberduck

Every programmer needs a rubberduck. COM add-in for the VBA & VB6 IDE (VBE).
https://rubberduckvba.com
GNU General Public License v3.0
1.91k stars 299 forks source link

Non-compilable code breaks the parser #504

Closed daFreeMan closed 9 years ago

daFreeMan commented 9 years ago

The following code, in a standard module in a PowerPoint presentation, seems to break the parser, yet produces no visible error messages. I don't have a debug version running, so I don't get a parse log.

Option Explicit

Dim PPTObj As New Class1

Public Sub NameSlides()
Dim Slide As Slide
Dim Name As String

  For Each Slide In ActivePresentation.Slides
    On Error GoTo eh
    Name = Right(Slide.Shapes("SlideName").TextFrame.TextRange, Len(Slide.Shapes("SlideName").TextFrame.TextRange) - InStr(1, Slide.Shapes("SlideName").TextFrame.TextRange, " "))
    If Slide.Name <> Name Then
      Slide.Name = Name
    End If
  Next
  Exit Sub

eh:
  Slide.Select
  MsgBox "This slide has no name defined"

End Sub

Public Sub UpdateAllLinks()

Dim SL As Slide
Dim SH As Shape

  For Each SL In ActivePresentation.Slides
    For Each SH In SL.Shapes
      If SH.Type = msoLinkedOLEObject Then
        SH.LinkFormat.Update
      End If
    Next
  Next

  MsgBox "Click 'OK' to close this box." & vbCrLf & "Then press the 'Esc' key", Title:="Update Complete"

End Sub

Private Sub RedirectLinks()

  Dim Source As String
  Dim Dest As String
  Dim Action As Integer
  If InStr(1, ActivePresentation.Path, "Dev\") > 1 Then
    Action = MsgBox("Changing pointers to PRODUCTION", vbOKCancel)
    Source = "Dev\"
    Dest = vbNull
  Else
    Action = MsgBox("Changing pointers to DEVELOPMENT", vbOKCancel)
    Source = "Templates\"
    Dest = "Dev\Templates\"
  End If

  If Action = vbOK Then
    Dim SL As Slide
    Dim SH As Shape
    Dim Top As Double
    Dim Left As Double
    Dim Width As Double
    Dim Height As Double
    For Each SL In ActivePresentation.Slides
      SL.Select
      For Each SH In SL.Shapes
        SH.Select
        If SH.Type = msoLinkedOLEObject Then                                 'when we find a linked one
          Top = SH.Top
          Left = SH.Left
          Width = SH.Width
          Height = SH.Height
          SH.LinkFormat.SourceFullName = Replace(SH.LinkFormat.SourceFullName, Source, Dest)
          SH.Top = Top
          SH.Left = Left
          SH.Height = Height
          SH.Width = Width
        End If
      Next
    Next
  End If

  If InStr(1, Dest, "dev") > 0 Then
    Action = MsgBox("About to OVER WRITE the Dev copy with this one." & vbCrLf & "Click 'Cancel' to prevent this and save manually", vbOKCancel, "OVER WRITE WARNING!!")
  Else
    Action = MsgBox("About to OVER WRITE the PRODUCTION copy with this one." & vbCrLf & "Click 'Cancel' to prevent this and save manually", vbOKCancel, "OVER WRITE WARNING!!")
    End If
  End If

  If Action = vbOK Then
    ActivePresentation.SaveAs Replace(ActivePresentation.Path, Source, Dest) & ActivePresentation.Name
  End If

End Sub

Public Function UNCpath(ByVal DrivePath As String) As String

Dim nwork As Object
Dim NDrives As Object
Dim i As Long

  Set nwork = CreateObject("WScript.Network")
  Set NDrives = nwork.EnumNetworkDrives

  For i = 0 To NDrives.Count - 1 Step 2
    If NDrives.Item(i) <> vbNull And InStr(1, DrivePath, NDrives.Item(i), 1) > 0 Then
      UNCpath = Replace(DrivePath, NDrives.Item(i), NDrives.Item(i + 1))
      Exit For
    End If
  Next

End Function

And no, I don't recall why I declare PPTObj As New Class1 - this is a bug report, not a code review!

retailcoder commented 9 years ago

Turns out Dim is illegal outside a procedure scope, that code doesn't compile - RD assumes your code compiles... what happens if you replace Dim with Private?

rubberduck203 commented 9 years ago

this is a bug report, not a code review!


Turns out Dim is illegal outside a procedure scope, that code doesn't compile - RD assumes your code compiles... what happens if you replace Dim with Private?

Looks like it is... =;)-

daFreeMan commented 9 years ago

Odd, the only compile error I got was here:

  If InStr(1, Dest, "dev") > 0 Then
    Action = MsgBox("About to OVER WRITE the Dev copy with this one." & vbCrLf & "Click 'Cancel' to prevent this and save manually", vbOKCancel, "OVER WRITE WARNING!!")
  Else
    Action = MsgBox("About to OVER WRITE the PRODUCTION copy with this one." & vbCrLf & "Click 'Cancel' to prevent this and save manually", vbOKCancel, "OVER WRITE WARNING!!")
    End If
  End If

If you can imagine, one IF with two End Ifs doesn't work well.

Running Office 2010, I don't get a compile error with that global Dim. However, changing the Dim to Private unbreaks the parser.

rubberduck203 commented 9 years ago

Actually, Dim at the module level seems to be totally legit @retailcoder.

Option Explicit

Dim PPTObj As New Collection
rubberduck203 commented 9 years ago

Running Office 2010, I don't get a compile error with that global Dim. However, changing the Dim to Private unbreaks the parser.

Houston, we have a problem.

retailcoder commented 9 years ago

Ok, I'm lost here.

image

daFreeMan commented 9 years ago

@retailcoder - Try it in PowerPoint instead of Excel.

Wouldn't think it should matter, but...

retailcoder commented 9 years ago

Ok so I copied the code into a new module, and get this parser log:

2015-05-18 09:36:39.2320 ERROR Parser encountered a syntax error in VBAProject.Module1, line 87. Content: ' End If'

Rubberduck.Parsing.Symbols.SyntaxErrorException: extraneous input 'End If' expecting {END_SUB, NEWLINE} at Rubberduck.Parsing.Symbols.ExceptionErrorListener.SyntaxError(IRecognizer recognizer, IToken offendingSymbol, Int32 line, Int32 charPositionInLine, String msg, RecognitionException e) in c:\Users\Mathieu\Source\Repos\Rubberduck\Rubberduck.Parsing\Symbols\ExceptionErrorListener.cs:line 10 at Antlr4.Runtime.ProxyErrorListener`1.SyntaxError(IRecognizer recognizer, Symbol offendingSymbol, Int32 line, Int32 charPositionInLine, String msg, RecognitionException e) at Antlr4.Runtime.Parser.NotifyErrorListeners(IToken offendingToken, String msg, RecognitionException e) at Antlr4.Runtime.DefaultErrorStrategy.Sync(Parser recognizer) at Rubberduck.Parsing.Grammar.VBAParser.subStmt() in c:\Users\Mathieu\Source\Repos\Rubberduck\Rubberduck.Parsing\Grammar\VBAParser.cs:line 9249 at Rubberduck.Parsing.Grammar.VBAParser.moduleBodyElement() in c:\Users\Mathieu\Source\Repos\Rubberduck\Rubberduck.Parsing\Grammar\VBAParser.cs:line 1287 at Rubberduck.Parsing.Grammar.VBAParser.moduleBody() in c:\Users\Mathieu\Source\Repos\Rubberduck\Rubberduck.Parsing\Grammar\VBAParser.cs:line 1172 at Rubberduck.Parsing.Grammar.VBAParser.module() in c:\Users\Mathieu\Source\Repos\Rubberduck\Rubberduck.Parsing\Grammar\VBAParser.cs:line 409 at Rubberduck.Parsing.Grammar.VBAParser.startRule() in c:\Users\Mathieu\Source\Repos\Rubberduck\Rubberduck.Parsing\Grammar\VBAParser.cs:line 218 at Rubberduck.Parsing.VBA.RubberduckParser.Parse(String code, TokenStreamRewriter& outRewriter) in c:\Users\Mathieu\Source\Repos\Rubberduck\Rubberduck.Parsing\VBA\RubberduckParser.cs:line 82 at Rubberduck.Parsing.VBA.RubberduckParser.Parse(VBComponent component) in c:\Users\Mathieu\Source\Repos\Rubberduck\Rubberduck.Parsing\VBA\RubberduckParser.cs:line 101

retailcoder commented 9 years ago

Ok I played with your code a bit, and it all boils down to this extraneous End If in the above parser log. Once I removed that extra End If I could parse without problems:

image

Problem in chair, not in duck

-- Houston

:wink: