A hacked-up testing framework

Question

Inspired by this post, I wanted to be able, in any vba project I could be working on, to create a test class and write test methods. Like this:

ThisWorkbook Workbook | class module (client code)

Option Explicit

Public Sub TestAreEqual()
    Assert.AreEqual 12, 34, "Values should be equal."
End Sub

Public Sub TestAreNotEqual()
    Assert.AreNotEqual 12, 34, "Values should not be equal."
End Sub

Public Sub TestAreSame()
    Assert.AreSame New Collection, New Collection, "Objects should be same reference."
End Sub

Public Sub TestAreNotSame()
    Assert.AreNotSame New Collection, New Collection, "Objects should not be the same reference."
End Sub

Public Sub TestFail()
    Assert.Fail "This wasn't meant to be."
End Sub

Public Sub TestInconclusive()
    Assert.Inconclusive "No idea."
End Sub

Public Sub TestIsFalse()
    Assert.IsFalse False, "True should be False."
End Sub

Public Sub TestIsNothing()
    Dim foo As Object
    Assert.IsNothing foo, "Foo should be nothing."
End Sub

Public Sub TestIsNotNothing()
    Dim foo As New Collection
    Assert.IsNotNothing foo, "Foo shouldn't be nothing."
End Sub

Public Sub TestIsTrue()
    Assert.IsTrue True, "False should be True."
End Sub

Public Sub TestBlowUp()
    Debug.Print 1 / 0
    Assert.Fail "Test should have failed by now."
End Sub

Public Sub Test()

    Dim methods As List
    Set methods = List.Create

    methods.Add "TestAreEqual", _
                "TestAreNotEqual", _
                "TestAreSame", _
                "TestAreNotSame", _
                "TestFail", _
                "TestInconclusive", _
                "TestIsFalse", _
                "TestIsNothing", _
                "TestIsNotNothing", _
                "TestIsTrue", _
                "TestBlowUp"

    TestClass.RegisterTestClass Me, methods
    TestClass.RunAllTests

End Sub

Test() method output:

2014-09-14 23:00:54 TestIsTrue: [PASS]
2014-09-14 23:00:54 TestIsFalse: [PASS]
2014-09-14 23:00:54 TestAreEqual: [FAIL] - AreEqual failed: Values should be equal.
2014-09-14 23:00:54 TestAreNotEqual: [PASS]
2014-09-14 23:00:54 TestAreSame: [FAIL] - Objects should be same reference.
2014-09-14 23:00:54 TestAreNotSame: [PASS]
2014-09-14 23:00:54 TestFail: [FAIL] - This wasn't meant to be.
2014-09-14 23:00:54 TestInconclusive: [INCONCLUSIVE] - No idea.
2014-09-14 23:00:54 TestIsNothing: [PASS]
2014-09-14 23:00:54 TestIsNotNothing: [PASS]
2014-09-14 23:50:35 TestBlowUp: [INCONCLUSIVE] - Test raised an error: Division by zero

---

The test code above is really testing that the Assert class works as intended:

Assert class module

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Assert"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Public Event AssertSucceeded()
Public Event AssertFailed(ByVal message As String)
Public Event AssertInconclusive(ByVal message As String)
Option Explicit

Public Property Get DefaultInstance() As Assert
    Set DefaultInstance = Me
End Property

Public Sub IsTrue(ByVal condition As Boolean, Optional ByVal message As String)
    If condition Then
        RaiseEvent AssertSucceeded
    Else
        RaiseEvent AssertFailed("IsTrue failed: " & message)
    End If
End Sub

Public Sub IsFalse(ByVal condition As Boolean, Optional ByVal message As String)
    If Not condition Then
        RaiseEvent AssertSucceeded
    Else
        RaiseEvent AssertFailed("IsFalse failed: " & message)
    End If
End Sub

Public Sub Inconclusive(Optional ByVal message As String)
    RaiseEvent AssertInconclusive(message)
End Sub

Public Sub Fail(Optional ByVal message As String)
    RaiseEvent AssertFailed(message)
End Sub

Public Sub IsNothing(ByVal value As Object, Optional ByVal message As String)
    If value Is Nothing Then
        RaiseEvent AssertSucceeded
    Else
        RaiseEvent AssertFailed("IsNothing failed: " & message)
    End If
End Sub

Public Sub IsNotNothing(ByVal value As Object, Optional ByVal message As String)
    If Not value Is Nothing Then
        RaiseEvent AssertSucceeded
    Else
        RaiseEvent AssertFailed("IsNotNothing failed: " & message)
    End If
End Sub

Public Sub AreEqual(ByVal value1 As Variant, ByVal value2 As Variant, Optional ByVal message As String)

    Dim result As Boolean
    result = (value1 = value2)

    If IsObject(value1) And IsObject(value2) Then

        If TypeOf value1 Is IEquatable And TypeOf value2 Is IEquatable Then

            Dim equatable1 As IEquatable
            Set equatable1 = value1

            Dim equatable2 As IEquatable
            Set equatable2 = value2

            result = equatable1.Equals(equatable2)

        End If

    End If

    If result Then
        RaiseEvent AssertSucceeded
    Else
        RaiseEvent AssertFailed("AreEqual failed: " & message)
    End If

End Sub

Public Sub AreNotEqual(ByVal value1 As Variant, ByVal value2 As Variant, Optional ByVal message As String)

    Dim result As Boolean
    result = (value1 = value2)

    If IsObject(value1) And IsObject(value2) Then

        If TypeOf value1 Is IEquatable And TypeOf value2 Is IEquatable Then

            Dim equatable1 As IEquatable
            Set equatable1 = value1

            Dim equatable2 As IEquatable
            Set equatable2 = value2

            result = equatable1.Equals(equatable2)

        End If

    End If

    If Not result Then
        RaiseEvent AssertSucceeded
    Else
        RaiseEvent AssertFailed(message)
    End If

End Sub

Public Sub AreSame(ByVal value1 As Object, ByVal value2 As Object, Optional ByVal message As String)
    If (ObjPtr(value1) = ObjPtr(value2)) Then
        RaiseEvent AssertSucceeded
    Else
        RaiseEvent AssertFailed(message)
    End If
End Sub

Public Sub AreNotSame(ByVal value1 As Object, ByVal value2 As Object, Optional ByVal message As String)
    If Not (ObjPtr(value1) = ObjPtr(value2)) Then
        RaiseEvent AssertSucceeded
    Else
        RaiseEvent AssertFailed(message)
    End If
End Sub

---

The TestClass default instance contains all the logic. Here's the code, I'll list my concerns after:

TestClass class module

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "TestClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Option Explicit
Private testOutput As ITestOutput
Private currentTest As String
Private currentTestFailed As Boolean
Private registeredMethods As New Dictionary
Private WithEvents assertion As Assert
Attribute assertion.VB_VarHelpID = -1

Public Sub RegisterTestClass(ByVal owner As Object, ByVal methods As List)
    Dim method As Variant
    For Each method In methods
        RegisterTestMethod owner, method
    Next
End Sub

Public Sub RegisterTestMethod(ByVal owner As Object, ByVal name As String)

    If registeredMethods.Exists(name) Then
        Exit Sub
    End If

    Dim testReference As Tuple
    Set testReference = Tuple.Create(owner, name)
    registeredMethods.Add name, testReference

End Sub

Public Sub RunAllTests()

    Dim testName As Variant
    For Each testName In registeredMethods
        RunTest testName
    Next

End Sub

Public Sub RunTest(ByVal name As String)

    currentTest = name
    currentTestFailed = False

    Dim result As TestResult
    On Error GoTo CleanFail

    Dim output As New DebugTestOutput 'todo: decouple
    Set testOutput = output

    Dim test As Tuple
    Set test = registeredMethods(name)

    CallByName test.Item1, test.Item2, VbMethod

CleanExit:
    Exit Sub

CleanFail:
    If Err.Number = AssertError Then
        Set result = TestResult.Create(Failed, Err.Description)
        Resume CleanExit

    ElseIf Err.Number = InconclusiveAssertError Then
        Set result = TestResult.Create(Inconclusive, Err.Description)
        Resume CleanExit

    Else
        Set result = TestResult.Create(Inconclusive, "Test raised an error: " & Err.Description)
        Resume CleanExit
    End If
End Sub

Private Sub Class_Initialize()
    Set assertion = Assert.DefaultInstance
End Sub

Private Sub assertion_AssertSucceeded()

    If currentTestFailed Then Exit Sub

    Dim result As TestResult
    Set result = TestResult.Create(Succeeded)

    testOutput.WriteResult currentTest, result

End Sub

Private Sub assertion_AssertFailed(ByVal message As String)

    If currentTestFailed Then Exit Sub
    currentTestFailed = True

    Dim result As TestResult
    Set result = TestResult.Create(Failed, message)

    testOutput.WriteResult currentTest, result

End Sub

Private Sub assertion_AssertInconclusive(ByVal message As String)

    If currentTestFailed Then Exit Sub
    currentTestFailed = True

    Dim result As TestResult
    Set result = TestResult.Create(Inconclusive, message)

    testOutput.WriteResult currentTest, result

End Sub

The whole event-handling hack is a work-around to avoid forcing the client to write test Function methods that return a TestResult object: at one point I had all methods in the Assert class as functions returning a TestResult object, and the client /test code had to return the test outcome to the TestClass. I'm not crazy about the design I have, but I find leaking the TestResult type into the client code would be messier.

I'd bounty an answer that finds a clean and clever way to avoid this:

If currentTestFailed Then Exit Sub

Which is the ugly hack I've come up with, to only report the first failed assertion of a test. It's still not correctly reporting the last successful assertion, but before I work on that feature, I'd like to know whether it'd be better to consider a different approach.

There are a number of constraints, pretty well explained in [this blog with surprisingly similar code](http://zbz5.net/adventures-vb6-reflection-and-error-handling I stumbled upon when googling about the pesky "automation error" I kept getting when all I wanted was to raise an AssertFailedError or AssertInconclusiveError - the TestClass simply cannot receive a meaningful error that's coming from the client code, so raising an error to halt test method execution is out of the way - and since I didn't want to give the client code the responsibility of determining a test's result, I simply run everything the client method has, and evaluate all assertions made.

---

TestResult class module

This type wants to encapsulate the result of a test. However because of design constraints it's actually encapsulating the result of an Assert method call.

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

Public Enum TestOutcome
    Inconclusive
    Failed
    Succeeded
End Enum

Private Type TTestResult
    outcome As TestOutcome
    output As String
End Type

Private this As TTestResult

Public Property Get TestOutcome() As TestOutcome
    TestOutcome = this.outcome
End Property

Friend Property Let TestOutcome(ByVal value As TestOutcome)
    this.outcome = value
End Property

Public Property Get testOutput() As String
    testOutput = this.output
End Property

Friend Property Let testOutput(ByVal value As String)
    this.output = value
End Property

Public Function Create(ByVal outcome As TestOutcome, Optional ByVal output As String)

    Dim result As New TestResult
    result.TestOutcome = outcome
    result.testOutput = output

    Set Create = result

End Function

---

The output is generated by a DebugTestOutput class, which implements an ITestOutput interface:

ITestOutput class module (interface)

Option Explicit

Public Sub WriteResult(ByVal name As String, ByVal result As TestResult)
End Sub

Any class can implement this, and once I've decoupled TestClass from the below implementation, the client code can implement it and supply a custom implementation:

DebugTestOutput class module

Option Explicit

Private Const InconclusiveResult As String = "INCONCLUSIVE"
Private Const SuccessResult As String = "PASS"
Private Const FailureResult As String = "FAIL"
Private outcomeStrings As Dictionary

Implements ITestOutput

Private Sub Class_Initialize()
    Set outcomeStrings = New Dictionary
    outcomeStrings.Add Inconclusive, InconclusiveResult
    outcomeStrings.Add Failed, FailureResult
    outcomeStrings.Add Succeeded, SuccessResult
End Sub

Private Sub ITestOutput_WriteResult(ByVal name As String, ByVal result As TestResult)
    If result.testOutput = vbNullString Then
        Debug.Print Framework.Strings.Format("{0:s} {1}: [{2}]", Now, name, outcomeStrings(result.TestOutcome))
    Else
        Debug.Print Framework.Strings.Format("{0:s} {1}: [{2}] - {3}", Now, name, outcomeStrings(result.TestOutcome), result.testOutput)
    End If
End Sub

Note that the List class, and the Framework module, are outside the scope of this post, but they're dependencies of this library; the project is an Excel add-in (.xlam) called UnitTesting, referencing another Excel add-in called System (there's another called Data, too).

Answer 1

I really like that Test methods are this simple.

Public Sub TestAreEqual()
    Assert.AreEqual 12, 34, "Values should be equal."
End Sub

And message doesn't print if the test passes. This is good, and what people will expect after working with the .Net framework.

What I don't like is the boiler plate code.

Public Sub Test()

   Dim methods As List
    Set methods = List.Create

   methods.Add "TestAreEqual", _
                "TestAreNotEqual", _
                "TestAreSame", _
                "TestAreNotSame", _

         .....    

   TestClass.RegisterTestClass Me, methods
    TestClass.RunAllTests

End Sub

My problem with it isn't that it's boiler plate, my problem is that there's no way to automatically generate it for the person writing the test. Manually writing these registrations would be time consuming and error prone. Neither of which you would want in a Unit Testing frame work.

I really think you need to leverage the VBA Extensibility Library to insert Public Sub Test() into the class. My VBEX project on GitHub has a getProcedures method that would be easy to leverage in a GetTestMethods() function.

Public Function GetTestMethods(CodeMod As CodeModule) As vbeProcedures
    Dim procs As New vbeProcedures
    Dim proc As vbeProcedure

    If mVbeProcedures.Count = 0 Then
        getProcedures
    End If

    For Each proc In mVbeProcedures
        If InStr(0, proc.Lines, "@TestMethod") Then
            procs.Add proc
        End If
    Next proc

    Set GetTestMethods = procs

End Function

Note that I took the approach of tagging the test procedures with '@TestMethod. I suppose you could key on the word Public instead, but this feels safer to me and more in line with the .Net framework. (There could be private code that shouldn't be executed in your TestClass. You wouldn't want to register those.)

---

Do you see the repetition in the Assertion events? I think you had it right when you suggested a Completed event to me. Instead of passing a message in the assert event, pass a TestResult and let the output decide how to print the result. The client code doesn't ever need to know about the concept of a TestResult class.

Public Sub IsTrue(ByVal condition As Boolean, Optional ByVal message As String)
    dim result as New TestResult

    result.Outcome = IIf(condition, Succeeded, Failed)
    result.Message = message

    RaiseEvent Completed(result)
End Sub

Of course, this means we need to add a message property to TestResult.

Private Type TTestResult
    outcome As TestOutcome
    output As String
    message As String
End Type

Private this As TTestResult

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

Friend Property Let Message(ByVal value As String)
    this.message = value
End Property

---

So now TestClass has only one event, Completed, so there's no longer a reason to make sure no other events have fired. It becomes this easy.

Private Sub assertion_Completed(ByVal result As TestResult)

    testOutput.WriteResult currentTest, result

End Sub

But what about Inconclusive results? As it is, we'll only ever get success or failure. Well, that's easy enough to deal with in your existing error handler by directly passing a result to the output.

CleanFail:
    If Err.Number = AssertError Then
        testOutput.WriteResult TestResult.Create(Failed, Err.Description)
        Resume CleanExit

    ElseIf Err.Number = InconclusiveAssertError Then
        testOutput.WriteResult TestResult.Create(Inconclusive, Err.Description)
        Resume CleanExit

    Else
        testOutput.WriteResult TestResult.Create(Inconclusive, "Test raised an error: " & Err.Description)
        Resume CleanExit
    End If
End Sub

---

There's one other that took me way too long to notice: the lack of a ITestResult and IAssert for injection purposes. You probably don't need it, but it would make it easier to change and build IOutput classes and TestClasses if you have complete control over their dependencies.