3
\$\begingroup\$

To enable unit testing in the VBA IDE I'm using https://github.com/rubberduck-vba/Rubberduck.

I've created a class and a custom collection class to work with structural members I need to filter. The following are specific members of the collection class and their intended use.

  • UniqueWidths: Used to obtain the unique widths of the members put into the collection.
  • WithAWidthOf: Return a subset of the contained Sections that are of the specified width.
  • FirstAdded: Obtain the first Section that was added.

I have tried to test each member to check for unintended behavior. Are there any tests that I could be using that I've not presently thought of.

Where it's used SectionShapes.hssHollowStructuralSection is a fully qualified enumeration member.

'Section class
Option Explicit

Private Type THelper
    Name As String
    Width As Double
    Weight As Double
    Depth As Double
    Shape As SectionShapes
End Type

Private this As THelper

Public Sub Init(ByVal Name As String, ByVal Width As Double, ByVal Weight As Double, ByVal Depth As Double, ByVal Shape As SectionShapes)
    With this
        .Name = Name
        .Width = Width
        .Weight = Weight
        .Depth = Depth
        .Shape = Shape
    End With
End Sub

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

Public Property Get Width() As Double
    Width = this.Width
End Property

Public Property Get Weight() As Double
    Weight = this.Weight
End Property

Public Property Let Weight(ByVal RHS As Double)  'Allows weight penalty to be applied
    this.Weight = RHS
End Property

Public Property Get Depth() As Double
    Depth = this.Depth
End Property

Public Property Get Shape() As SectionShapes
    Shape = this.Shape
End Property

'Sections collection class
Option Explicit

Private Type THelper
    dictSections As Dictionary
    collSections As Collection
End Type

Private this As THelper

Private Sub Class_Initialize()
    Set this.collSections = New Collection
    Set this.dictSections = New Dictionary
End Sub

Public Property Get Section(ByVal value As Section) As Section
    Section = this.dictSections(value.Name)
End Property

Public Sub Add(ByVal value As Section)
    this.dictSections.Add value.Name, value
    this.collSections.Add value, value.Name
End Sub

Public Property Get NewEnum() As IUnknown
    Set NewEnum = this.collSections.[_NewEnum]
End Property

Public Property Get Exists(ByVal value As Section) As Boolean
    Exists = this.dictSections.Exists(value.Name)
End Property

Public Property Get Widths() As Dictionary
    Set Widths = New Dictionary
    Dim sectionWidth As Section
    For Each sectionWidth In this.collSections
        If Not Widths.Exists(sectionWidth.Name) Then
            Widths.Add sectionWidth.Name, sectionWidth.Width
        End If
    Next
End Property

Public Property Get UniqueWidths() As Dictionary
    Set UniqueWidths = New Dictionary
    Dim checkWidth As Section
    For Each checkWidth In this.collSections
        If Not UniqueWidths.Exists(checkWidth.Width) Then
            UniqueWidths.Add checkWidth.Width, checkWidth.Width
        End If
    Next
End Property

Public Property Get Weights() As Dictionary
    Set Weights = New Dictionary
    Dim sectionWeight As Section
    For Each sectionWeight In this.collSections
        If Not Weights.Exists(sectionWeight.Weight) Then
            Weights.Add sectionWeight.Name, sectionWeight.Weight
        End If
    Next
End Property

Public Property Get FirstAdded() As Section
    Set FirstAdded = this.collSections.Item(1)
End Property

Public Property Get Count() As Long
    Count = this.dictSections.Count
End Property

Public Property Get WithAWidthOf(ByVal value As Double) As Sections
    Set WithAWidthOf = New Sections

    Dim checkSection As Section
    For Each checkSection In this.collSections
        If checkSection.Width = value Then
            WithAWidthOf.Add checkSection
        End If
    Next
End Property

Section Tests

'@TestMethod
Public Sub Name_Getter()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Section
    Set sut = New Section
    sut.Init "HSS20 x 12 x 5/8", 12, 127.37, 20, SectionShapes.hssHollowStructuralSection

    'Act:

    'Assert:
    Assert.AreEqual "HSS20 x 12 x 5/8", sut.Name

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

'@TestMethod
Public Sub Depth_Getter()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Section
    Set sut = New Section
    sut.Init "HSS20 x 12 x 5/8", 12, 127.37, 20, SectionShapes.hssHollowStructuralSection

    'Act:

    'Assert:
    Assert.AreEqual CDbl(20), sut.Depth

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

'@TestMethod
Public Sub Weight_Getter()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Section
    Set sut = New Section
    sut.Init "HSS20 x 12 x 5/8", 12, 127.37, 20, SectionShapes.hssHollowStructuralSection

    'Act:

    'Assert:
    Assert.AreEqual 127.37, sut.Weight

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

'@TestMethod
Public Sub Width_Getter()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Section
    Set sut = New Section
    sut.Init "HSS20 x 12 x 5/8", 12, 127.37, 20, SectionShapes.hssHollowStructuralSection

    'Act:

    'Assert:
    Assert.AreEqual CDbl(12), sut.Width

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

'@TestMethod
Public Sub Shape_Getter()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Section
    Set sut = New Section
    sut.Init "HSS20 x 12 x 5/8", 12, 127.37, 20, SectionShapes.hssHollowStructuralSection

    'Act:

    'Assert:
    Assert.AreEqual SectionShapes.hssHollowStructuralSection, sut.Shape

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

Sections collection tests

'@TestMethod
Public Sub Count()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Sections
    Set sut = New Sections

    Dim width7first As Section
    Set width7first = New Section
    width7first.Init "HSS9 x 7 x 3/16", 7, 19.63, 9, SectionShapes.hssHollowStructuralSection

    Dim width7second As Section
    Set width7second = New Section
    width7second.Init "HSS7 x 7 x 3/8", 7, 32.58, 7, SectionShapes.hssHollowStructuralSection

    Dim width7third As Section
    Set width7third = New Section
    width7third.Init "A1085-HSS9 x 7 x 5/8", 7, 59.32, 9, SectionShapes.hssHollowStructuralSection

    Dim width8 As Section
    Set width8 = New Section
    width8.Init "A1085-HSS16 x 8 x 1/2", 8, 76.07, 16, SectionShapes.hssHollowStructuralSection

    sut.Add width7first
    sut.Add width7second
    sut.Add width7third
    sut.Add width8

    'Act:

    'Assert:
    Assert.AreEqual CLng(4), sut.Count

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

'@TestMethod
Public Sub UniqueWidths_Count()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Sections
    Set sut = New Sections

    Dim width7first As Section
    Set width7first = New Section
    width7first.Init "HSS9 x 7 x 3/16", 7, 19.63, 9, SectionShapes.hssHollowStructuralSection

    Dim width7second As Section
    Set width7second = New Section
    width7second.Init "HSS7 x 7 x 3/8", 7, 32.58, 7, SectionShapes.hssHollowStructuralSection

    Dim width7third As Section
    Set width7third = New Section
    width7third.Init "A1085-HSS9 x 7 x 5/8", 7, 59.32, 9, SectionShapes.hssHollowStructuralSection

    Dim width8 As Section
    Set width8 = New Section
    width8.Init "A1085-HSS16 x 8 x 1/2", 8, 76.07, 16, SectionShapes.hssHollowStructuralSection

    sut.Add width7first
    sut.Add width7second
    sut.Add width7third
    sut.Add width8

    'Act:

    'Assert:
    Assert.AreEqual CLng(2), sut.UniqueWidths.Count

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

'@TestMethod
Public Sub FirstAdded_IsFirstAdded()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Sections
    Set sut = New Sections

    Dim FirstAdded As Section
    Set FirstAdded = New Section
    FirstAdded.Init "HSS12 x 12 x 5/8", 12, 93.34, 12, SectionShapes.hssHollowStructuralSection

    Dim secondAdded As Section
    Set secondAdded = New Section
    secondAdded.Init "HSS14 x 10 x 5/16", 10, 48.86, 14, SectionShapes.hssHollowStructuralSection

    sut.Add FirstAdded
    sut.Add secondAdded
    'Act:

    'Assert:
    Assert.AreSame FirstAdded, sut.FirstAdded

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

'@TestMethod
Public Sub FirstAdded_IsNotFirstAdded()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Sections
    Set sut = New Sections

    Dim FirstAdded As Section
    Set FirstAdded = New Section
    FirstAdded.Init "HSS12 x 12 x 5/8", 12, 93.34, 12, SectionShapes.hssHollowStructuralSection

    Dim secondAdded As Section
    Set secondAdded = New Section
    secondAdded.Init "HSS14 x 10 x 5/16", 10, 48.86, 14, SectionShapes.hssHollowStructuralSection

    sut.Add FirstAdded
    sut.Add secondAdded
    'Act:

    'Assert:
    Assert.AreNotSame secondAdded, sut.FirstAdded

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

'@TestMethod
Public Sub WithAWithOf_ResultsMatch()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Sections
    Set sut = New Sections

    Dim width7first As Section
    Set width7first = New Section
    width7first.Init "HSS9 x 7 x 3/16", 7, 19.63, 9, SectionShapes.hssHollowStructuralSection

    Dim width7second As Section
    Set width7second = New Section
    width7second.Init "HSS7 x 7 x 3/8", 7, 32.58, 7, SectionShapes.hssHollowStructuralSection

    Dim width7third As Section
    Set width7third = New Section
    width7third.Init "A1085-HSS9 x 7 x 5/8", 7, 59.32, 9, SectionShapes.hssHollowStructuralSection

    Dim width8 As Section
    Set width8 = New Section
    width8.Init "A1085-HSS16 x 8 x 1/2", 8, 76.07, 16, SectionShapes.hssHollowStructuralSection

    sut.Add width7first
    sut.Add width8
    sut.Add width7second
    sut.Add width7third

    'Act:

    'Assert:
    Assert.AreEqual CLng(3), sut.WithAWidthOf(CDbl(7)).Count

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

'@TestMethod
Public Sub WithAWithOf_ReturnsNoResults()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Sections
    Set sut = New Sections

    Dim width7first As Section
    Set width7first = New Section
    width7first.Init "HSS9 x 7 x 3/16", 7, 19.63, 9, SectionShapes.hssHollowStructuralSection

    Dim width7second As Section
    Set width7second = New Section
    width7second.Init "HSS7 x 7 x 3/8", 7, 32.58, 7, SectionShapes.hssHollowStructuralSection

    Dim width7third As Section
    Set width7third = New Section
    width7third.Init "A1085-HSS9 x 7 x 5/8", 7, 59.32, 9, SectionShapes.hssHollowStructuralSection

    Dim width8 As Section
    Set width8 = New Section
    width8.Init "A1085-HSS16 x 8 x 1/2", 8, 76.07, 16, SectionShapes.hssHollowStructuralSection

    sut.Add width7first
    sut.Add width8
    sut.Add width7second
    sut.Add width7third

    'Act:

    'Assert:
    Assert.AreEqual CLng(0), sut.WithAWidthOf(CDbl(0)).Count

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

'@TestMethod
Public Sub Weights_Items()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Sections
    Set sut = New Sections

    Dim width7first As Section
    Set width7first = New Section
    width7first.Init "HSS9 x 7 x 3/16", 7, 19.63, 9, SectionShapes.hssHollowStructuralSection

    Dim width7second As Section
    Set width7second = New Section
    width7second.Init "HSS7 x 7 x 3/8", 7, 32.58, 7, SectionShapes.hssHollowStructuralSection

    Dim width7third As Section
    Set width7third = New Section
    width7third.Init "A1085-HSS9 x 7 x 5/8", 7, 59.32, 9, SectionShapes.hssHollowStructuralSection

    Dim width8 As Section
    Set width8 = New Section
    width8.Init "A1085-HSS16 x 8 x 1/2", 8, 76.07, 16, SectionShapes.hssHollowStructuralSection

    sut.Add width7first
    sut.Add width8
    sut.Add width7second
    sut.Add width7third

    'Act:

    'Assert:
    Assert.SequenceEquals Array(19.63, 76.07, 32.58, 59.32), sut.Weights.Items

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

'@TestMethod
Public Sub Weights_Keys()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Sections
    Set sut = New Sections

    Dim width7first As Section
    Set width7first = New Section
    width7first.Init "HSS9 x 7 x 3/16", 7, 19.63, 9, SectionShapes.hssHollowStructuralSection

    Dim width7second As Section
    Set width7second = New Section
    width7second.Init "HSS7 x 7 x 3/8", 7, 32.58, 7, SectionShapes.hssHollowStructuralSection

    Dim width7third As Section
    Set width7third = New Section
    width7third.Init "A1085-HSS9 x 7 x 5/8", 7, 59.32, 9, SectionShapes.hssHollowStructuralSection

    Dim width8 As Section
    Set width8 = New Section
    width8.Init "A1085-HSS16 x 8 x 1/2", 8, 76.07, 16, SectionShapes.hssHollowStructuralSection

    sut.Add width7first
    sut.Add width8
    sut.Add width7second
    sut.Add width7third

    'Act:

    'Assert:
    Assert.SequenceEquals Array("HSS9 x 7 x 3/16", _
                                "A1085-HSS16 x 8 x 1/2", _
                                "HSS7 x 7 x 3/8", _
                                "A1085-HSS9 x 7 x 5/8"), sut.Weights.Keys

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

'@TestMethod
Public Sub DoesExist()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Sections
    Set sut = New Sections

    Dim width7first As Section
    Set width7first = New Section
    width7first.Init "HSS9 x 7 x 3/16", 7, 19.63, 9, SectionShapes.hssHollowStructuralSection

    Dim width7second As Section
    Set width7second = New Section
    width7second.Init "HSS7 x 7 x 3/8", 7, 32.58, 7, SectionShapes.hssHollowStructuralSection

    Dim width7third As Section
    Set width7third = New Section
    width7third.Init "A1085-HSS9 x 7 x 5/8", 7, 59.32, 9, SectionShapes.hssHollowStructuralSection

    Dim width8 As Section
    Set width8 = New Section
    width8.Init "A1085-HSS16 x 8 x 1/2", 8, 76.07, 16, SectionShapes.hssHollowStructuralSection

    sut.Add width7first
    sut.Add width8
    sut.Add width7second
    sut.Add width7third

    'Act:

    'Assert:
    Assert.IsTrue sut.Exists(width7second)

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

'@TestMethod
Public Sub DoesNotExist()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Sections
    Set sut = New Sections

    Dim width7first As Section
    Set width7first = New Section
    width7first.Init "HSS9 x 7 x 3/16", 7, 19.63, 9, SectionShapes.hssHollowStructuralSection

    Dim width7second As Section
    Set width7second = New Section
    width7second.Init "HSS7 x 7 x 3/8", 7, 32.58, 7, SectionShapes.hssHollowStructuralSection

    Dim width7third As Section
    Set width7third = New Section
    width7third.Init "A1085-HSS9 x 7 x 5/8", 7, 59.32, 9, SectionShapes.hssHollowStructuralSection

    Dim width8 As Section
    Set width8 = New Section
    width8.Init "A1085-HSS16 x 8 x 1/2", 8, 76.07, 16, SectionShapes.hssHollowStructuralSection

    sut.Add width7first
    sut.Add width8
    sut.Add width7second
    sut.Add width7third

    Dim notFound As Section
    Set notFound = New Section
    notFound.Init "nope", 0, 0, 0, SectionShapes.hssHollowStructuralSection

    'Act:

    'Assert:
    Assert.IsFalse sut.Exists(notFound)

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

Public Sub IteratorSucceeds()
    On Error GoTo TestFail

    'Arrange:
    Dim sut As Sections
    Set sut = New Sections

    Dim width7first As Section
    Set width7first = New Section
    width7first.Init "HSS9 x 7 x 3/16", 7, 19.63, 9, SectionShapes.hssHollowStructuralSection

    Dim width7second As Section
    Set width7second = New Section
    width7second.Init "HSS7 x 7 x 3/8", 7, 32.58, 7, SectionShapes.hssHollowStructuralSection

    Dim width7third As Section
    Set width7third = New Section
    width7third.Init "A1085-HSS9 x 7 x 5/8", 7, 59.32, 9, SectionShapes.hssHollowStructuralSection

    Dim width8 As Section
    Set width8 = New Section
    width8.Init "A1085-HSS16 x 8 x 1/2", 8, 76.07, 16, SectionShapes.hssHollowStructuralSection

    sut.Add width7first
    sut.Add width8
    sut.Add width7second
    sut.Add width7third

    Dim checkSection As Section
    For Each checkSection In sut
        Debug.Print checkSection.Name
    Next

    'Act:

    'Assert:
    Assert.Succeed

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

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Browse other questions tagged or ask your own question.