4
\$\begingroup\$

Context

This post will be related to the code request I asked for, some time ago. I would like to focus this time not strictly on the implementation of the SourceControl module, but rather on the Unit Tests.

Link to the previous question can be found here.

Note: I used : symbol on purpose, to shorten the length of code just for this review. Normally, I would avoid this practice.

Dependencies

To start working with this code you do need to add following references to your VB Project

  • Microsoft Scripting Runtime
  • Microsoft Visual Basic for Application Extensibility 5.3
  • Rubberduck COM add-in

Game plan

Plan here is to insert a set unit tests into my project which will test my SourceControl.GetProjectComponents method. Mentioned method, should returns a Collection of VBProject's components which can be exported.

The difficulty arise when I'd try to create an instance of either VBIDE.VBProject, VBIDE.VBComponents, VBIDE.VBComponent, VBIDE.CodeModule because of run-time error -2147221164 Class not registered.

So, I decided to create wrappers around these classes which also implements one of four interfaces: IVBProject, IVBComponents, IVBComponent or IVBCodeModule.

Based on these interfaces then, I was able to create Fake classes using which, I could actually test my code. Below you can find the class diagram of the solution.

Class diagram

enter image description here

Under the hood

There will be a lot of code to examine today, but relatively large part of it is code which handles interface implementations which are just calls to the actual implementation methods. These lines can be simply ignored for the most part.

SourceControl.bas

'@Folder("SourceControl")
Option Explicit

Private Const ModuleName As String = "SourceControl"

' Path to the folder where components will be saved.
Private pExportFolderPath As String

' Indicates if empty components should be exported or not.
Private pExportEmptyComponents As Boolean


Public Property Get ExportEmptyComponents() As Boolean
    ExportEmptyComponents = pExportEmptyComponents
End Property


Public Property Let ExportEmptyComponents(ByVal Value As Boolean)
    pExportEmptyComponents = Value
End Property


Public Function GetProjectComponents(ByVal Source As IVBProject) As Collection '<IVBComponent>

    Const MethodName = "ExportProjectComponents"

    If Source.Protection = vbext_pp_locked Then
        Errors.OnInvalidOperation "Source.Protection", _
                                  "The VBA project, in this workbook is protected. " & _
                                  "Therefore, it is not possible to export the components. " & _
                                  "Unlock your VBA project and try again. " & ModuleName & "." & MethodName
    End If

    Dim Output As New Collection '<IVBComponent>
    Dim Cmp As IVBComponent
    For Each Cmp In GetExportableComponents(Source.VBComponents)
        Output.Add Cmp
    Next Cmp
    Set GetProjectComponents = Output

End Function


Private Function GetExportableComponents(ByVal Source As IVBComponents) As Collection '<IVBComponent>

    Dim Output As New Collection
    Dim Cmp As IVBComponent
    For Each Cmp In Source.NewEnum
        If IsExportable(Cmp) Then
            Output.Add Cmp
        End If
    Next Cmp

    Set GetExportableComponents = Output
    Set Cmp = Nothing
    Set Output = Nothing

End Function


Private Function IsExportable(ByVal Component As IVBComponent) As Boolean

    ' Check if component is on the list of exportable components.
    If ArrayExt.Exists(Component.ComponentType, ExportableComponentsTypes) = False Then
        IsExportable = False
        Exit Function
    End If

    If IsComponentEmpty(Component.CodeModule) = False Then
        IsExportable = True
        Exit Function
    End If

    If pExportEmptyComponents = True Then
        IsExportable = True
        Exit Function
    End If

    IsExportable = False

End Function


Private Property Get ExportableComponentsTypes() As Variant
    ExportableComponentsTypes = Array(vbext_ct_ClassModule, vbext_ct_MSForm, vbext_ct_StdModule, vbext_ct_Document)
End Property


' Indicates if component is empty by checking number of code lines.
' Files, which contains just Option Explicit will be counted as empty.
Private Function IsComponentEmpty(ByVal Source As ICodeModule) As Boolean

    If Source.CountOfLines < 2 Then
        IsComponentEmpty = True

    ElseIf Source.CountOfLines = 2 Then
        Dim Ln1 As String: Ln1 = Source.Lines(1, 1)
        Dim Ln2 As String: Ln2 = Source.Lines(2, 1)

        IsComponentEmpty = (VBA.LCase$(Ln1) = "option explicit" And Ln2 = vbNullString)

    Else
        IsComponentEmpty = False
    End If

End Function


' Exports and saves project's components, from Source to the location which is specified in Path argument.
' If target path does not exists or if path does not points to a folder, throw an OnDirectoryNotFound.
' Param
' Source: Collection <IVBComponent>
Public Sub ExportProjectComponents(ByVal Source As Collection, ByVal Path As String)

    Const MethodName = "ExportProjectComponents"

    With New FileSystemObject
        If .FolderExists(Path) = False Then
            Errors.OnDirectoryNotFound "Path", ModuleName & "." & MethodName
        End If
    End With

    pExportFolderPath = Path
    NormalizePath

    Dim Cmp As IVBComponent
    For Each Cmp In Source
        ExportComponent Cmp
    Next Cmp

End Sub


' To avoid problems with saving components, add backslash
' at the end of folder path.
Private Sub NormalizePath()

    If pExportFolderPath Like "*\" = False Then
        pExportFolderPath = pExportFolderPath & "\"
    End If

End Sub


Private Sub ExportComponent(ByVal Component As IVBComponent)

    Dim FileName As String: FileName = GetComponentFileName(Component)
    Component.Export GetExportPath(FileName)

End Sub


Private Function GetComponentFileName(ByVal Component As IVBComponent) As String
    GetComponentFileName = Component.Name & "." & ComponentTypeToExtension.Item(Component.ComponentType)
End Function


Private Function GetExportPath(ByVal FileName As String) As String
    GetExportPath = pExportFolderPath & FileName
End Function


Private Property Get ComponentTypeToExtension() As Scripting.Dictionary '<vbext_ComponentType, String>

    Dim Output As New Dictionary '<vbext_ComponentType, String>
    With Output
        .Add vbext_ct_ClassModule, "cls"
        .Add vbext_ct_MSForm, "frm"
        .Add vbext_ct_StdModule, "bas"
        .Add vbext_ct_Document, "doccls"
        .Add vbext_ct_ActiveXDesigner, "ocx"
    End With

    Set ComponentTypeToExtension = Output

End Property

This is a section where you will find all the tests.

SourceControlTests.bas

Option Explicit
Option Private Module

'@TestModule
'@Folder("Tests")

Private Assert As Object
Private Fakes As Object

Private Const VBComponentName1 As String = "NewName1"
Private Const VBComponentName2 As String = "NewName2"
Private Const VBComponentName3 As String = "NewName3"


'@ModuleInitialize
Private Sub ModuleInitialize()
    'this method runs once per module.
    Set Assert = CreateObject("Rubberduck.AssertClass")
    Set Fakes = CreateObject("Rubberduck.FakesProvider")
End Sub


'@ModuleCleanup
Private Sub ModuleCleanup()
    'this method runs once per module.
    Set Assert = Nothing
    Set Fakes = Nothing
End Sub


'@TestInitialize
Private Sub TestInitialize()
    'this method runs before every test in the module.
End Sub


'@TestCleanup
Private Sub TestCleanup()
    'this method runs after every test in the module.
End Sub


'@TestMethod("GetProjectComponents")
Private Sub GetExportComponentsWhenCodeModuleHaveMoreThanOneLineOfCodeTest()
    On Error GoTo TestFail

    'Arrange:
    Dim Fake As FakeVBProject
    Set Fake = GetFakeVBProject
    SourceControl.ExportEmptyComponents = False

    'Act:
    Dim Actual As Collection
    Set Actual = SourceControl.GetProjectComponents(Fake)

    'Assert:
    Assert.AreEqual CLng(1), Actual.Count
    Assert.AreEqual VBComponentName3, Actual.Item(1).Name

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description

End Sub


Private Function GetFakeVBProject() As FakeVBProject

    Dim Output As New FakeVBProject
    With Output.VBComponents
        .Add vbext_ct_ClassModule
        .Add vbext_ct_ClassModule
        .Add vbext_ct_ClassModule

        .Item(1).Name = VBComponentName1

        .Item(2).CodeModule.AddFromString "AAA"
        .Item(2).Name = VBComponentName2

        .Item(3).CodeModule.AddFromString "AAA" & vbNewLine & "BBB"
        .Item(3).Name = VBComponentName3
    End With

    Set GetFakeVBProject = Output

End Function


'@TestMethod("GetProjectComponents")
Private Sub GetExportComponentsWithExportEmptyComponentsEnabledTest()
    On Error GoTo TestFail

    'Arrange:
    Dim Fake As FakeVBProject
    Set Fake = GetFakeVBProject
    SourceControl.ExportEmptyComponents = True

    'Act:
    Dim Actual As Collection
    Set Actual = SourceControl.GetProjectComponents(Fake)

    'Assert:
    Assert.AreEqual CLng(3), Actual.Count

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description

End Sub


'@TestMethod("ExportComponents")
Private Sub GetExportComponentsThrowsInvalidOperationWhenVBProjectIsLocked()

    Const ExpectedError As Long = CustomErrorCode.OnInvalidOperation
    On Error GoTo TestFail

    'Arrange:
    Dim Fake As FakeVBProject
    Set Fake = GetFakeVBProject
    Fake.Protection = vbext_ProjectProtection.vbext_pp_locked

    'Act:
    SourceControl.GetProjectComponents Fake

Assert:
    Assert.Fail "Expected error was not raised"

TestExit:
    Exit Sub
TestFail:
    If Err.Number = ExpectedError Then
        Resume TestExit
    Else
        Resume Assert
    End If

End Sub


'@TestMethod("ExportProjectComponents")
Private Sub ExportProjectComponents()
    Const ExpectedError As Long = CustomErrorCode.OnDirectoryNotFound
    On Error GoTo TestFail

    'Arrange:
    'Act:
    SourceControl.ExportProjectComponents New Collection, vbNullString

Assert:
    Assert.Fail "Expected error was not raised"

TestExit:
    Exit Sub
TestFail:
    If Err.Number = ExpectedError Then
        Resume TestExit
    Else
        Resume Assert
    End If
End Sub

IVBProject.cls

'@Folder("SourceControl")
Option Explicit

Public Property Get Protection() As vbext_ProjectProtection: End Property
Public Property Get VBComponents() As IVBComponents: End Property

VBProjectWrapper.cls

'@Folder("SourceControl")
Option Explicit

Implements IVBProject

Private pProject As VbProject


Public Sub Init(ByVal Project As VBIDE.VbProject)
    Set pProject = Project
End Sub


Public Property Get Protection() As vbext_ProjectProtection
    Protection = pProject.Protection
End Property


Public Property Get VBComponents() As IVBComponents

    Dim Output As New VBComponentsWrapper
    Output.Init pProject.VBComponents
    Set VBComponents = Output

End Property


Private Property Get IVBProject_Protection() As vbext_ProjectProtection: IVBProject_Protection = Protection: End Property
Private Property Get IVBProject_VBComponents() As IVBComponents: Set IVBProject_VBComponents = VBComponents: End Property

IVBComponents.cls

'@Folder("SourceControl")
Option Explicit

Public Property Get NewEnum() As IUnknown: End Property
Public Sub Add(ByVal Item As vbext_ComponentType): End Sub

VBComponentsWrapper.cls

'@Folder("SourceControl")
Option Explicit

Implements IVBComponents

Private pComponents As VBIDE.VBComponents


Public Sub Init(ByVal Components As VBIDE.VBComponents)
    Set pComponents = Components
End Sub


Public Property Get NewEnum() As IUnknown

    Dim Output As New Collection '<IVBComponent>
    Dim Cmp As VBIDE.VBComponent
    For Each Cmp In pComponents
        Output.Add ConvertToIVBComponent(Cmp)
    Next Cmp
    Set NewEnum = Output

End Property


Private Function ConvertToIVBComponent(ByVal Cmp As VBIDE.VBComponent) As IVBComponent

    Dim Output As New VBComponentWrapper
    Output.Init Cmp
    Set ConvertToIVBComponent = Output

End Function


Public Sub Add(ByVal Item As vbext_ComponentType)
    pComponents.Add Item
End Sub


Private Property Get IVBComponents_NewEnum() As IUnknown: Set IVBComponents_NewEnum = NewEnum: End Property
Private Sub IVBComponents_Add(ByVal Item As vbext_ComponentType): Me.Add Item: End Sub

IVBComponent.cls

'@Folder("SourceControl")
Option Explicit

Public Property Get ComponentType() As vbext_ComponentType: End Property
Public Property Get CodeModule() As ICodeModule: End Property
Public Property Get Name() As String: End Property
Public Sub Export(ByVal Path As String): End Sub

VBComponentWrapper.cls

'@Folder("SourceControl")
Option Explicit

Implements IVBComponent

Private pComponent As VBIDE.VBComponent


Public Sub Init(ByVal Component As VBIDE.VBComponent)
    Set pComponent = Component
End Sub


Public Property Get ComponentType() As vbext_ComponentType
    ComponentType = pComponent.Type
End Property


Public Property Get CodeModule() As ICodeModule

    Dim Output As New CodeModuleWrapper
    Output.Init pComponent.CodeModule
    Set CodeModule = Output

End Property


Public Sub Export(ByVal Path As String)
    pComponent.Export Path
End Sub


Public Property Get Name() As String
    Name = pComponent.Name
End Property


Private Property Get IVBComponent_ComponentType() As vbext_ComponentType: IVBComponent_ComponentType = ComponentType: End Property
Private Property Get IVBComponent_CodeModule() As ICodeModule: Set IVBComponent_CodeModule = CodeModule: End Property
Private Property Get IVBComponent_Name() As String: IVBComponent_Name = Name: End Property
Private Sub IVBComponent_Export(ByVal Path As String): Export Path: End Sub

ICodeModule.cls

'@Folder("SourceControl")
Option Explicit

Public Property Get CountOfLines() As Long: End Property
Public Function Lines(ByVal StartLine As Long, ByVal Count As Long) As String: End Function

VBCodeModuleWrapper.cls

'@Folder("SourceControl")
Option Explicit

Implements ICodeModule

Private pCodeModule As VBIDE.CodeModule


Public Sub Init(ByVal CodeModule As VBIDE.CodeModule)
    Set pCodeModule = CodeModule
End Sub


Public Property Get CountOfLines() As Long
    CountOfLines = pCodeModule.CountOfLines
End Property


Public Function Lines(ByVal StartLine As Long, ByVal Count As Long) As String
    Lines = pCodeModule.Lines(StartLine, Count)
End Function


Private Property Get ICodeModule_CountOfLines() As Long: ICodeModule_CountOfLines = CountOfLines: End Property
Private Function ICodeModule_Lines(ByVal StartLine As Long, ByVal Count As Long) As String: ICodeModule_Lines = Lines(StartLine, Count): End Function

FakeVBProject.cls

'@Folder("Tests.Fakes")
Option Explicit

Implements IVBProject

Private pVBComponents As New FakeVBComponents
Private pProtection As vbext_ProjectProtection


Public Property Get Protection() As vbext_ProjectProtection
    Protection = pProtection
End Property


Public Property Let Protection(ByVal Value As vbext_ProjectProtection)
    pProtection = Value
End Property


Public Property Get VBComponents() As FakeVBComponents
    Set VBComponents = pVBComponents
End Property

Private Property Get IVBProject_Protection() As vbext_ProjectProtection: IVBProject_Protection = Protection: End Property
Private Property Get IVBProject_VBComponents() As IVBComponents: Set IVBProject_VBComponents = VBComponents: End Property

FakeVBComponents.cls

'@Folder("Tests.Fakes")
Option Explicit

Implements IVBComponents

Private pVBComponents As New Collection '<IVBComponent>


Public Property Get NewEnum() As IUnknown
    Set NewEnum = pVBComponents
End Property


Public Sub Add(ByVal Item As vbext_ComponentType)

    Dim Component As New FakeVBComponent
    With Component
        .ComponentType = Item
        .Name = "Name" & pVBComponents.Count
    End With
    pVBComponents.Add Component

End Sub


Public Function Item(ByVal Index As Long) As FakeVBComponent
    Set Item = pVBComponents.Item(Index)
End Function

Private Property Get IVBComponents_NewEnum() As IUnknown: Set IVBComponents_NewEnum = NewEnum: End Property
Private Sub IVBComponents_Add(ByVal Item As vbext_ComponentType): Me.Add Item: End Sub

FakeVBComponent.cls

'@Folder("Tests.Fakes")
Option Explicit

Implements IVBComponent

Private pName As String
Private pComponentType As vbext_ComponentType
Private pCodeModule As New FakeCodeModule


Public Property Get ComponentType() As vbext_ComponentType
    ComponentType = vbext_ct_ClassModule
End Property


Public Property Let ComponentType(ByVal Value As vbext_ComponentType)
    pComponentType = Value
End Property


Public Property Get CodeModule() As FakeCodeModule
    Set CodeModule = pCodeModule
End Property


Public Sub Export(ByVal Path As String)

    Errors.OnInvalidOperation vbNullString, _
                              "FakeVBComponent does not support exporting code modules. " & _
                              "FakeVBComponent.Export"

End Sub


Public Property Get Name() As String
    Name = pName
End Property


Public Property Let Name(ByVal Value As String)
    pName = Value
End Property

Private Property Get IVBComponent_ComponentType() As vbext_ComponentType: IVBComponent_ComponentType = ComponentType: End Property
Private Property Get IVBComponent_CodeModule() As ICodeModule: Set IVBComponent_CodeModule = CodeModule: End Property
Private Property Get IVBComponent_Name() As String: IVBComponent_Name = Name: End Property
Private Sub IVBComponent_Export(ByVal Path As String): Export Path: End Sub

FakeCodeModule.cls

'@Folder("Tests.Fakes")
Option Explicit

Implements ICodeModule

Private pCode As String

Public Property Get CountOfLines() As Long

    If pCode = vbNullString Then
        CountOfLines = 0
        Exit Property
    End If

    CountOfLines = UBound(VBA.Split(pCode, vbNewLine)) + 1

End Property


Public Function Lines(ByVal StartLine As Long, ByVal Count As Long) As String

    ' If there is only one line to grab we can just take StartLine
    ' and leave method.
    If Count = 1 Then
        Lines = VBA.Split(pCode, vbNewLine)(StartLine - 1)
        Exit Function
    End If

    Dim SplittedLines As Variant
    SplittedLines = VBA.Split(pCode, vbNewLine)

    Dim LinesCount As Long
    Dim Ndx As Long: Ndx = StartLine - 1
    For LinesCount = 1 To Count
        Lines = Lines & SplittedLines(Ndx)
        Ndx = Ndx + 1
    Next LinesCount

End Function


Public Sub AddFromString(ByVal Text As String)
    pCode = pCode & Text
End Sub

Private Property Get ICodeModule_CountOfLines() As Long: ICodeModule_CountOfLines = CountOfLines: End Property
Private Function ICodeModule_Lines(ByVal StartLine As Long, ByVal Count As Long) As String: ICodeModule_Lines = Lines(StartLine, Count): End Function

Miscellaneous

Errors.bas

'@Folder("Errors")
Option Private Module
Option Explicit


' The error that is thrown when a method call is invalid for the
' object's current state.
Public Sub OnInvalidOperation(ByVal ParamName As String, ByVal Message As String)

    Err.Raise CustomErrorCode.OnInvalidOperation, , _
              "An error of type InvalidOperationException was thrown." & vbNewLine & vbNewLine & _
              "Additional information: " & Message & vbNewLine & vbNewLine & _
              "Parameter: " & ParamName

End Sub


' The error that is thrown when a file or directory cannot be found.
Public Sub OnDirectoryNotFound(ByVal ParamName As String, ByVal Message As String)

    Err.Raise CustomErrorCode.OnDirectoryNotFound, , _
              "An error of type DirectoryNotFoundException was thrown." & vbNewLine & vbNewLine & _
              "Additional information: " & Message & vbNewLine & vbNewLine & _
              "Parameter: " & ParamName

End Sub

ArrayExt.bas

'@Folder("Helper")
Option Explicit


' Item parameter has to be a simple type.
' Arr has to have only one dimension.
Public Function Exists(ByVal Item As Variant, ByRef Arr As Variant) As Boolean
    Exists = (UBound(Filter(Arr, Item)) > -1)
End Function

CustomErrorCodeEnum.bas

'@Folder("SourceControl")
Option Explicit

Public Enum CustomErrorCode

    OnInvalidOperation = 515
    OnDirectoryNotFound = 520

End Enum`
\$\endgroup\$

0

Reset to default

You must log in to answer this question.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.