Growing my own Tree (Structure)

Question

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

Answer 1

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"}

• RubberDuck: You're absolutely right about the Tree setter. It was there before I started initializing the root node upon creation. Nice review.
• RubberDuck: Okay, so what if I want to create a new tree from a branch? Hmm....
• Mathieu Guindon: @RubberDuck then you need some Tree.Create(TreeNode) method, possibly usable from a default instance ("static").. no?
• RubberDuck: Or possibly a TreeNode.CreateTree().
• Rossco: 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).