Skip to content
14 changes: 14 additions & 0 deletions Tests/ACLibDeclarationDictCore/DeclarationDictTestCodemodule.cls
Original file line number Diff line number Diff line change
Expand Up @@ -104,6 +104,20 @@ End Sub

Private Static Sub MyStaticSub(Optional ByVal Reset As Boolean = False)
Static Counter2 As Integer
End Sub

Private Sub TestPullrequest8_LineLabels()

On Error GoTo ErrHandler


ExitHere:
Exit Sub

ErrHandler:



End Sub

'---------------------------
Expand Down
46 changes: 45 additions & 1 deletion Tests/ACLibDeclarationDictCore/DeclarationDictTests.cls
Original file line number Diff line number Diff line change
Expand Up @@ -63,6 +63,24 @@ Public Sub ImportCode_InsertCodeLine_CheckKeys(ByVal Code As String, ByVal Expec

End Sub

'AccUnit:Row("Dim Abc(1) As String", "Abc")
'AccUnit:Row("Dim Abc(1 To 2) As String", "Abc")
'AccUnit: Row("Dim Abc(1, 2) As String", "Abc")
'AccUnit: Row("Dim Abc(1, 2, 3) As String", "Abc")
'AccUnit:Row("ReDim Abc(x, y) As String", "Abc")
'AccUnit:Row("ReDim Abc(x, y, z) As String", "Abc")
Public Sub ImportCode_Issue4_MultiDimArrayDeclaration(ByVal Code As String, ByVal Expected As String)

Dim Actual As String

m_DeclDict.ImportCode Code
Actual = Join(m_DeclDict.WordsDict.Keys, "|")

Assert.That Actual, Iz.EqualTo(Expected)

End Sub


'AccUnit:Row("Private Function Func1() As String" & Environment.NewLine & Environment.NewLine & " Dim X as String, Y As Long", "Func1|X|Y")
'AccUnit:Row(Environment.NewLine & " Private abc " & Environment.NewLine & " Public X as String, Y As Long", "abc|X|Y")
'AccUnit:Row("Private Function Func1() As String ' _" & Environment.NewLine & " Dim X as String, Y As Long", "Func1")
Expand All @@ -78,6 +96,31 @@ Public Sub ImportCode_InsertCodeLines_CheckKeys(ByVal Code As String, ByVal Expe

End Sub

'AccUnit:Row("Dim SomeFuncVar As Integer ' the next line should not be ignored" & Environment.NewLine & "Dim AnotherFuncVar As String", "SomeFuncVar|AnotherFuncVar")
Public Sub ImportCode_Issue3_RemovingCommentCorruptsLineEndings(ByVal Code As String, ByVal Expected As String)

Dim Actual As String

m_DeclDict.ImportCode Code
Actual = Join(m_DeclDict.WordsDict.Keys, "|")

Assert.That Actual, Iz.EqualTo(Expected)

End Sub

'AccUnit:Row(Environment.NewLine & "ExitHere:" & Environment.NewLine & "Dim Abc As String", "ExitHere|Abc")
'AccUnit:Row(Environment.NewLine & "ExitHere: Dim Abc As String", "ExitHere|Abc")
Public Sub ImportCode_Pullrequest8_LineLabel(ByVal Code As String, ByVal Expected As String)

Dim Actual As String

m_DeclDict.ImportCode Code
Actual = Join(m_DeclDict.WordsDict.Keys, "|")

Assert.That Actual, Iz.EqualTo(Expected)

End Sub

'AccUnit:Row("Private Declare PtrSafe Sub Sleep Lib ""kernel32"" (ByVal dwMilliseconds As LongPtr)", "Sleep|dwMilliseconds")
'AccUnit:Row("Private Declare PtrSafe Function CopyMemory Lib ""kernel32"" Alias ""RtlMoveMemory""(ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long) As Long", "CopyMemory|Destination|Source|Length")
Public Sub ImportCode_API_CheckKeys(ByVal Code As String, ByVal Expected As String)
Expand Down Expand Up @@ -164,7 +207,8 @@ Public Sub ImportClassCodeModule_CheckKeysExists()
"PropertySet", "ObjRef", _
"TestMe", _
"VariableParams", "Args", _
"MyStaticSub", "Reset", "Counter2")
"MyStaticSub", "Reset", "Counter2", _
"TestPullrequest8_LineLabels", "ExitHere", "ErrHandler")


m_DeclDict.ImportVBComponent CurrentVbProject.VBComponents("DeclarationDictTestCodemodule")
Expand Down
21 changes: 18 additions & 3 deletions source/modules/DeclarationDict.cls
Original file line number Diff line number Diff line change
Expand Up @@ -162,7 +162,9 @@ Public Sub ImportVBComponent(ByVal VBComponent2Import As VBComponent)
End Sub

Public Sub ImportCodeModule(ByVal CodeModule2Import As CodeModule)
ImportCode CodeModule2Import.Lines(1, CodeModule2Import.CountOfLines)
If CodeModule2Import.CountOfLines > 0 Then
ImportCode CodeModule2Import.Lines(1, CodeModule2Import.CountOfLines)
End If
End Sub

Public Sub ImportCode(ByVal Code As String)
Expand Down Expand Up @@ -217,13 +219,17 @@ Private Function PrepareCode(ByVal Code As String, ByVal RegEx As RegExp) As Str

' remove comments
'.Pattern = "'(.*)[\r\n]"
.Pattern = "'(.*)(?:[\r\n]|$)"
Code = .Replace(Code, "")
.Pattern = "'(.*)([\r\n]|$)"
Code = .Replace(Code, "$2")

#If DebugPrintEnabled Then
DebugPrint Code, True, "PrepareCode- after remove comments"
#End If

' treat line labels as dim (but not line numbers)
.Pattern = "([\r\n]|^)([^0-9\r\n]\S*):(\s|[\r\n]|$)"
Code = .Replace(Code, "$1Dim $2:$3")

' dim a as String: a = 5 => insert line break
.Pattern = "(\:\s)"
Code = .Replace(Code, vbNewLine)
Expand Down Expand Up @@ -305,6 +311,15 @@ Private Sub AddWordFromDeclaration(ByRef Declarations As String, ByVal IsProcedu
Declarations = Replace(Declarations, " ", " ")
Loop

If Not IsProcedure And Not IsEnumTypeBlock Then
Do While Declarations Like "*(*,*)*"
' prevent multi-dimensional Dim from transforming into new declarations (might be numeric)
Pos = InStr(1, Declarations, "(")
PosX = InStr(Pos, Declarations, ")")
Declarations = Left(Declarations, Pos - 1) & " " & Mid(Declarations, PosX + 1)
Loop
End If

DeclArray = Split(Trim(Declarations), ",")

For i = LBound(DeclArray) To UBound(DeclArray)
Expand Down