8
\$\begingroup\$

Summary

VB6 doesn't have a great selection of data structures to work with, so again I find myself creating my own. I have a need to dynamically generate a directory structure on the file system. The natural way to represent this is with a Tree, so I created my own.

There are three classes involved here:

  1. TreeNode - The heart and soul of the data structure.
  2. TreeNodes - A custom collection wrapper to hold nodes. This is iterable and is mainly used as a place to hold all of a TreeNode's child nodes.
  3. Tree - this class' only responsibility is to hold the root node of a Tree.

I considered that Tree may be kind of useless, but having a separate class to hold the root node greatly simplified having to keep track of whether or not a TreeNode was a root or not. I'm not sure this was the right decision. I didn't really look at other tree implementations prior to designing this. I wanted to see if I could "get it right" on my own.

Other Concerns:

  • Have I missed any potentially useful functionality that would be expected out of a Tree?
  • I used a collection as the internal datatype for TreeNodes. Would a dictionary have been better? If so, how?
  • Are the documentation attributes helpful?
  • Do I have reasonable test coverage here? Did I miss any edge cases?
  • Did I do anything dirty? It's all on topic, including the unit tests.

Tree

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Tree"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Type TTree
    Root As TreeNode
End Type

Private this As TTree

Public Property Get Root() As TreeNode
    Set Root = this.Root
End Property

Public Property Set Root(ByVal Value As TreeNode)
    Set this.Root = Value
End Property

Private Sub Class_Initialize()
    Set this.Root = New TreeNode
End Sub

TreeNode

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "TreeNode"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private Type TTreenode
    Name As String
    Value As Variant
    Children As TreeNodes
    Parent As TreeNode
End Type

Private this As TTreenode

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

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

Public Property Get Value() As Variant
    AssignUnknown Value, this.Value
End Property

Public Property Set Value(ByVal newValue As Variant)
    Set this.Value = newValue
End Property

Public Property Let Value(ByVal newValue As Variant)
    this.Value = newValue
End Property

Public Property Get Children() As TreeNodes
    Set Children = this.Children
End Property

Public Property Get Parent() As TreeNode
    Set Parent = this.Parent
End Property

Public Property Set Parent(ByVal Value As TreeNode)
    Set this.Parent = Value
End Property

' If the argument already has a Parent, AddChild creates a shallow copy of the node to be added.
Public Function AddChild(ByVal node As TreeNode) As TreeNode
Attribute AddChild.VB_Description = "If the argument already has a Parent, AddChild creates a shallow copy of the node to be added."
    If node.Parent Is Nothing Then
        this.Children.Add node
        Set node.Parent = Me

        Set AddChild = node
    Else
        Dim copyOfNode As New TreeNode
        copyOfNode.Name = node.Name

        If Not IsEmpty(node.Value) Then
            'note: this should really use assign unknown, but it doesn't actually assign the value.
            '  I'm really not sure why, but I suspect it is because I'm trying to set properties.

            'AssignUnknown copyOfNode.Value, node.Value

            If IsObject(node.Value) Then
                Set copyOfNode.Value = node.Value
            Else
                copyOfNode.Value = node.Value
            End If
        End If

        Dim child As TreeNode
        For Each child In node.Children
            copyOfNode.AddChild child
        Next

        this.Children.Add copyOfNode
        Set copyOfNode.Parent = Me

        Set AddChild = copyOfNode
    End If

End Function

Public Function AddNewChild(ByVal Name As String) As TreeNode
Attribute AddNewChild.VB_Description = "Creates and Adds a New child node with the given Name."
    Dim child As TreeNode
    Set child = Me.AddChild(New TreeNode)
    child.Name = Name

    Set AddNewChild = child
End Function

Public Sub RemoveChild(ByVal node As TreeNode)
Attribute RemoveChild.VB_Description = "Removes the child node from this node's Children."
    With this.Children
        Set .Item(.IndexOf(node)).Parent = Nothing
    End With

    this.Children.Remove node
End Sub

Public Function HasChildren() As Boolean
    HasChildren = (this.Children.Count <> 0)
End Function

Public Function Path(Optional ByVal separator As String = "\") As String
Attribute Path.VB_Description = "Uses the node names to build a Path String. If a node name is empty, the path will have consecutive separators."
    Dim result As String
    result = Me.Name

    If Me.HasChildren Then
        result = result & separator
    End If

    If Not Me.Parent Is Nothing Then
        result = Me.Parent.Path(separator) & result
    End If

    Path = result

End Function

Public Function ToString() As String
    ToString = "Name: " & this.Name & "; ValueType: " & TypeName(this.Value)
End Function

Private Sub AssignUnknown(ByRef destination As Variant, ByVal source As Variant)
    If IsObject(source) Then
        Set destination = source
    Else
        destination = source
    End If
End Sub

Private Sub Class_Initialize()
    Set this.Children = New TreeNodes
End Sub

TreeNodes

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "TreeNodes"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private this As Collection

Public Sub Clear()
Attribute Clear.VB_Description = "Removes all of the child nodes and frees the circular reference to their Parent."
    Dim node As TreeNode
    For Each node In this
        ' Yes, I could call `Remove`, but this is more efficient.
        Set node.Parent = Nothing 'release circular reference
    Next

    Set this = New Collection
End Sub

Public Sub Add(ByVal Item As TreeNode)
    this.Add Item
End Sub

Public Sub Remove(ByVal Item As TreeNode)
Attribute Remove.VB_Description = "Removes a TreeNode from the collection and frees its circular reference to its Parent."
    Set Item.Parent = Nothing 'release circular reference
    this.Remove IndexOf(Item)
End Sub

Public Function Item(ByVal index As Long) As TreeNode
Attribute Item.VB_UserMemId = 0
    Set Item = this(index)
End Function

Public Function Count() As Long
    Count = this.Count
End Function

' Returns the index of item if found, otherwise returns 0.
Public Function IndexOf(ByVal node As TreeNode) As Long
Attribute IndexOf.VB_Description = "Returns the index of item if found, otherwise returns 0."
    Dim i As Long
    For i = 1 To this.Count
        If this.Item(i) Is node Then
            IndexOf = i
            Exit Function
        End If
    Next i
End Function

Public Function Exists(ByVal Name As String) As Boolean
    Dim i As Long
    For i = 1 To this.Count
        If this.Item(i).Name = Name Then
            Exists = True
            Exit Function
        End If
    Next
End Function

Public Function NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
    Set NewEnum = this.[_NewEnum]
End Function

Private Sub Class_Initialize()
    Set this = New Collection
End Sub

Private Sub Class_Terminate()
    Set this = Nothing
End Sub

Unit Tests

The unit tests here use Rubberduck's integrated framework.

Attribute VB_Name = "TreeTests"
Option Explicit

Option Private Module

'@TestModule
Private Assert As New Rubberduck.AssertClass

Private t As Tree

'@TestInitialize
Public Sub TestInitialize()
    Set t = New Tree
    t.Root.Name = "C:"
End Sub

'@TestCleanup
Public Sub TestCleanup()
    Set t = Nothing
End Sub

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

    'Arrange:
        Dim myTree As Tree
        Set myTree = New Tree
    'Act:

    'Assert:
    Assert.IsNotNothing myTree.Root

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

'@TestMethod
Public Sub RootIsNotNothingAfterSetting()
    'Arrange:
    Set t = New Tree

    'Act:
    Set t.Root = New TreeNode

    'Assert
    Assert.IsNotNothing t.Root
End Sub

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

    'Arrange:
        Dim child As New TreeNode
    'Act:
        t.Root.AddChild child

    'Assert:
    Assert.AreSame child, t.Root.Children(1)

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

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

    Const expected As Long = 1

    'Arrange:
        Dim child As TreeNode
        Set child = t.Root.AddChild(New TreeNode)
        child.Name = "Users"
    'Act:
        Set child = child.AddChild(New TreeNode)
        child.Name = "username"

    'Assert:
    Assert.AreEqual expected, t.Root.Children.Count
    Assert.AreEqual expected, t.Root.Children(1).Children.Count
    Assert.AreEqual "Users", t.Root.Children(1).Name
    Assert.AreEqual "username", t.Root.Children(1).Children(1).Name

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

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

    'Arrange:
        Dim child As TreeNode
    'Act:
        Set child = t.Root.AddChild(New TreeNode)
        child.Name = "Users"

    'Assert:
    Assert.AreEqual "C:", child.Parent.Name

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

'@TestMethod
Public Sub ParentIsNotNothingAfterRemovingChild() 'TODO: Rename test
    On Error GoTo TestFail

    'Arrange:
        Const expectedCount As Long = 0

        Dim child As TreeNode
        Set child = t.Root.AddChild(New TreeNode)
    'Act:
        t.Root.RemoveChild child

    'Assert:
    Assert.AreEqual expectedCount, t.Root.Children.Count
    Assert.IsNotNothing t.Root
    Assert.AreEqual "C:", t.Root.Name

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

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

    'Arrange:
        Set t.Root = New TreeNode

    'Act:
        t.Root.AddChild New TreeNode
    'Assert:
    Assert.IsTrue t.Root.HasChildren

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

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

    'Arrange:
    'Act:

    'Assert:
    Assert.IsFalse t.Root.HasChildren

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

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

    'Arrange:
        Const expected As String = "C:\Users\username\test.txt"

        Dim child As TreeNode
        Set child = t.Root.AddChild(New TreeNode)
        child.Name = "Users"

        Set child = child.AddChild(New TreeNode)
        child.Name = "username"

        Set child = child.AddChild(New TreeNode)
        child.Name = "test.txt"
    'Act:
        Dim actual As String
        actual = child.Path
    'Assert:
    Assert.AreEqual expected, actual

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

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

    'Arrange:
        Const expected As String = "C:\Users\"

        Dim child As TreeNode
        Set child = t.Root.AddChild(New TreeNode)
        child.Name = "Users"

        Set child = child.AddChild(New TreeNode)
        child.Name = "username"
    'Act:
        Dim actual As String
        actual = t.Root.Children(1).Path
    'Assert:
    Assert.AreEqual expected, actual

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


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

    'Arrange:
        Const expected As String = "C:/Users/username/test.txt"

        Dim child As TreeNode
        Set child = t.Root.AddChild(New TreeNode)
        child.Name = "Users"

        Set child = child.AddChild(New TreeNode)
        child.Name = "username"

        Set child = child.AddChild(New TreeNode)
        child.Name = "test.txt"
    'Act:
        Dim actual As String
        actual = child.Path("/")
    'Assert:
    Assert.AreEqual expected, actual

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

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

    'Arrange:
        Const expected As String = "C:/Users/"

        Dim child As TreeNode
        Set child = t.Root.AddChild(New TreeNode)
        child.Name = "Users"

        Set child = child.AddChild(New TreeNode)
        child.Name = "username"
    'Act:
        Dim actual As String
        actual = t.Root.Children(1).Path("/")
    'Assert:
    Assert.AreEqual expected, actual

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
'@TestMethod
Public Sub AddingANodeToSecondParentCopiesNode()
    On Error GoTo TestFail

    'Arrange:
        Dim parent1 As TreeNode
        Dim parent2 As TreeNode

        Set parent1 = t.Root.AddNewChild("parent 1")
        Set parent2 = t.Root.AddNewChild("parent 2")

        Dim child As New TreeNode
        child.Name = "child"

    'Act:
        parent1.AddChild child
        parent2.AddChild child
    'Assert:
    Assert.AreNotSame parent1.Children(1), parent2.Children(1)

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

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

    'Arrange:
        Dim parent1 As TreeNode
        Dim parent2 As TreeNode

        Set parent1 = t.Root.AddNewChild("parent 1")
        Set parent2 = t.Root.AddNewChild("parent 2")

        Dim child As New TreeNode
        child.Name = "child"

    'Act:
        parent1.AddChild child
        parent2.AddChild child

    'Assert:
    Assert.AreSame parent1, parent1.Children(1).Parent
    Assert.AreSame parent2, parent2.Children(1).Parent

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

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

    'Arrange:
        Dim expected As New Collection
    'Act:
        Set t.Root.Value = expected
    'Assert:
    Assert.AreSame expected, t.Root.Value

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

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

    'Arrange:
        Const expected As Integer = 42
    'Act:
        t.Root.Value = expected
    'Assert:
    Assert.AreEqual expected, t.Root.Value

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


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

    'Arrange:
        Dim parent1 As TreeNode
        Dim parent2 As TreeNode

        Set parent1 = t.Root.AddNewChild("parent 1")
        Set parent2 = t.Root.AddNewChild("parent 2")

        Dim child As New TreeNode
        child.Name = "child"
        Const expected As Integer = 42
        child.Value = expected
    'Act:
        parent1.AddChild child
        parent2.AddChild child

    'Assert:
    Assert.AreNotSame parent1.Children(1), parent2.Children(1)
    Assert.AreEqual parent1.Children(1).Value, parent2.Children(1).Value

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

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

    'Arrange:
        Dim parent1 As TreeNode
        Dim parent2 As TreeNode

        Set parent1 = t.Root.AddNewChild("parent 1")
        Set parent2 = t.Root.AddNewChild("parent 2")

        Dim child As New TreeNode
        child.Name = "child"
        Dim expected As New Collection
        Set child.Value = expected
    'Act:
        parent1.AddChild child
        parent2.AddChild child

    'Assert:
    Assert.AreNotSame parent1.Children(1), parent2.Children(1)
    Assert.AreSame parent1.Children(1).Value, parent2.Children(1).Value

TestExit:
    Exit Sub
TestFail:
    Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub
\$\endgroup\$
4
\$\begingroup\$
Public Property Set Root(ByVal Value As TreeNode)
    Set this.Root = Value
End Property

Private Sub Class_Initialize()
    Set this.Root = New TreeNode
End Sub

Why do you need to expose a setter at all? As soon as you create a new Tree, you're ready to add child nodes using myTree.Root.Children.

This brings me to this superfluous test here:

'@TestMethod
Public Sub RootIsNotNothingAfterSetting()
    'Arrange:
    Set t = New Tree

    'Act:
    Set t.Root = New TreeNode

    'Assert
    Assert.IsNotNothing t.Root
End Sub

You're already testing that Root is set upon tree creation; what the setter is allowing, really, is for weirdness like this:

Set myTree.Root = Nothing

Which defeats the test and highlights that your data structure is missing an important [tiny little] detail: immutability!

No one should ever be allowed to swap that Root reference! If client code needs a new Root, then they need a new Tree!


Public Sub ParentIsNotNothingAfterRemovingChild() 'TODO: Rename test

That test was definitely renamed, and yet you still have a TODO item here that could be removed.


'@TestInitialize
Public Sub TestInitialize()
    Set t = New Tree
    t.Root.Name = "C:"
End Sub

'@TestCleanup
Public Sub TestCleanup()
    Set t = Nothing
End Sub

The Rubberduck setup & teardown methods don't need @TestInitialize and @TestCleanup markers if they're named [respectively] TestInitialize and TestCleanup - I only know because I wrote the framework though :)

These markers exist in the event where one would like to use different names for setup & teardown. Note that this is also the reason why TestInitialize and TestCleanup cannot be used as test method names without a @TestMethod marker*.

* actually that's not exactly true - see issue #329 - "@TestMethod" marker has no effect on a method named "TestInitialize" or "TestCleanup"

\$\endgroup\$
  • \$\begingroup\$ You're absolutely right about the Tree setter. It was there before I started initializing the root node upon creation. Nice review. \$\endgroup\$ – RubberDuck Mar 20 '15 at 18:11
  • \$\begingroup\$ Okay, so what if I want to create a new tree from a branch? Hmm.... \$\endgroup\$ – RubberDuck Mar 20 '15 at 22:38
  • 1
    \$\begingroup\$ @RubberDuck then you need some Tree.Create(TreeNode) method, possibly usable from a default instance ("static").. no? \$\endgroup\$ – Mathieu Guindon Mar 20 '15 at 22:41
  • \$\begingroup\$ Or possibly a TreeNode.CreateTree(). \$\endgroup\$ – RubberDuck Mar 20 '15 at 22:42
  • 1
    \$\begingroup\$ It probably doesn't hurt to specify the @TestInitialize, @TestCleanup explicitly. It would protect against the unit test api changing (since it is still green). \$\endgroup\$ – Rossco Jul 14 '15 at 21:34

Your Answer

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

Not the answer you're looking for? Browse other questions tagged or ask your own question.