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.