Following-up on the Automagic testing framework for VBA review, I've refactored much of the TestEngine
static class, and introduced a TestMethod
class.
Refactoring part of the TestEngine
into its own class introduced new problems that needed new solutions; because the client code is using the Assert
class default instance, each TestMethod
instance had to be listening for the same instance's events - VBA events cannot be registered/unregistered at will, so I introduced a ListenAssertEvents
flag in each instance, that would only be True
when that instance is running.
I never thought I'd say this, but it's a good thing VBA doesn't support multithreaded execution. I'd have gone mad if it were the case.
Here's the output (in the immediate pane) for a TestClass1
class in a client VBA project named VBAProject
:
TestEngine.RunAllTests "VBAProject", new TestClass1
2014-09-21 20:19:44 MagicCommentWorks: [INCONCLUSIVE] - No assertions made.
2014-09-21 20:19:44 TestAreEqual: [PASS]
2014-09-21 20:19:44 TestAreNotEqual: [PASS]
2014-09-21 20:19:44 TestAreSame: [FAIL] - AreSame failed: Objects should be same reference.
2014-09-21 20:19:44 TestAreNotSame: [PASS]
2014-09-21 20:19:44 TestFail: [FAIL] - Fail failed: This wasn't meant to be.
2014-09-21 20:19:44 TestInconclusive: [INCONCLUSIVE] - No idea.
2014-09-21 20:19:44 TestIsFalse: [PASS]
2014-09-21 20:19:44 TestIsNothing: [PASS]
2014-09-21 20:19:44 TestIsNotNothing: [PASS]
2014-09-21 20:19:44 TestIsTrue: [PASS]
2014-09-21 20:19:44 TestBlowUp: [FAIL] - AreEqual failed: This failed assertion prevents reporting the division by zero that follows.
2014-09-21 20:19:44 TestNoAssert: [INCONCLUSIVE] - No assertions made.
This time I've thoroughly verified the output, it's exactly what's expected - in case I missed anything, here's the TestClass1
client code:
Option Explicit
Public Sub ThisIsNoTest()
Err.Raise 5
End Sub
'@TestMethod
Public Sub MagicCommentWorks()
End Sub
Private Sub TestPrivateMethod()
End Sub
Public Sub TestAreEqual()
Assert.AreEqual 12, 12, "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.IsTrue True
Assert.Inconclusive "No idea."
Assert.Fail "shouldn't output this result."
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()
Assert.IsTrue True
Assert.AreEqual False, True, "This failed assertion prevents reporting the division by zero that follows."
Debug.Print 1 / 0
Assert.Fail "Test should have failed by now."
End Sub
Public Sub TestNoAssert()
End Sub
TestEngine class module (with default instance)
The TestEngine
class' goal has been reduced to the following:
- Use the
Reflection
library to get all methods from the specified class instance. - Find test methods among all found methods - a test method is a
Public Sub
whose name begins withTest
, or that is decorated with a "magic comment" that marks the method as a test method. - Execute all found test methods, delegate outputting the test results.
Option Explicit
Private Type TTestEngine
Output As ITestOutput
RegisteredTests As Dictionary
CurrentTest As TestMethod
CurrentTestAllResults As List
CurrentTestFailedOrInconclusiveResults As List
End Type
Private Const TestMethodNamePrefix As String = "Test"
Private Const TestMethodAttribute As String = "TestMethod"
Private this As TTestEngine
Public Property Get Output() As ITestOutput
Set Output = this.Output
End Property
Public Property Set Output(ByVal value As ITestOutput)
Set this.Output = value
End Property
Public Sub RunAllTests(ByVal projectName As String, ByRef classInstance As Object)
Set this.RegisteredTests = ReflectTestMethods(projectName, classInstance)
Dim test As TestMethod
Dim result As TestResult
Dim item As Variant
For Each item In this.RegisteredTests.Items 'requires Variant
Set test = item 'cast Variant to TestMethod
Set result = test.Run
this.Output.WriteResult test.MethodName, result
Next
End Sub
Private Function ReflectTestMethods(ByVal projectName As String, ByRef classInstance As Object) As Dictionary
Dim classMethods As List
Set classMethods = ClassModule.GetMethods(projectName, TypeName(classInstance))
Dim result As New Dictionary
Dim prospect As Method
Dim tMethod As TestMethod
For Each prospect In classMethods
If CanAddTestMethod(prospect, result) Then
Set tMethod = New TestMethod
Set tMethod.OwnerInstance = classInstance
tMethod.MethodName = prospect.name
result.Add tMethod.MethodName, tMethod
End If
Next
Set ReflectTestMethods = result
End Function
Private Function CanAddTestMethod(ByVal prospect As Method, ByRef testMethods As Dictionary) As Boolean
Dim result As Boolean
If Not IsTestMethod(prospect) Then Exit Function
If testMethods.Exists(prospect.name) Then Exit Function
CanAddTestMethod = True
End Function
Private Function IsTestMethod(ByVal TestMethod As Method) As Boolean
Dim result As Boolean
result = _
Framework.Strings.StartsWith(TestMethodNamePrefix, TestMethod.name, False) Or _
TestMethod.HasAttribute(TestMethodAttribute)
If Not result Then Exit Function
result = result And Framework.Strings.StartsWith("public sub", TestMethod.Signature, False)
IsTestMethod = result
End Function
Private Sub Class_Initialize()
Dim testOutput As New DebugTestOutput
Set this.Output = testOutput 'default value. Client code may override.
End Sub
TestMethod class module
The whole CurrentTestXxxxxx
hack from the previous iteration, was blatantly begging to be extracted into this class. I have no regrets; calling the Run
function cleanly returns the test's result - the TestEngine
isn't even aware that the test code might make 20 assertions and fail 15 times; there is no way a failed Assert
call can stop a test method from running to completion, so I'm gathering all results in this.AssertResults
, and when the method completes, I evaluate the test's result based on the contents of that result set:
Option Explicit
Private Type TTestMethod
OwnerInstance As Object
MethodName As String
AssertResults As List
ListenAssertEvents As Boolean
End Type
Private this As TTestMethod
Private WithEvents assertion As Assert
Public Property Get OwnerInstance() As Object
Set OwnerInstance = this.OwnerInstance
End Property
Friend Property Set OwnerInstance(ByRef value As Object)
Set this.OwnerInstance = value
End Property
Public Property Get MethodName() As String
MethodName = this.MethodName
End Property
Friend Property Let MethodName(ByVal value As String)
this.MethodName = value
End Property
Public Function Run() As TestResult
Dim result As TestResult
On Error GoTo CleanFail
this.ListenAssertEvents = True
CallByName this.OwnerInstance, this.MethodName, VbMethod
this.ListenAssertEvents = False
CleanExit:
Set Run = EvaluateResults
Exit Function
CleanFail:
this.AssertResults.Add TestResult.Create(Inconclusive, "Test raised an error: " & Err.Description)
Resume CleanExit
End Function
Private Function EvaluateResults() As TestResult
Dim result As TestResult
Set result = TestResult.Create(Succeeded)
If this.AssertResults.Count = 0 Then
Set result = TestResult.Create(Inconclusive, "No assertions made.")
ElseIf this.AssertResults.Count = 1 Then
Set result = this.AssertResults.First
Else
Dim assertResult As TestResult
For Each assertResult In this.AssertResults
If assertResult.TestOutcome = Failed _
Or assertResult.TestOutcome = Inconclusive _
Then
Set result = assertResult
Exit For
End If
Next
End If
Set EvaluateResults = result
End Function
Private Sub assertion_Completed(ByVal result As TestResult)
If this.ListenAssertEvents Then this.AssertResults.Add result
End Sub
Private Sub Class_Initialize()
Set this.AssertResults = List.Create
Set assertion = Assert.DefaultInstance
End Sub
Private Sub Class_Terminate()
Set assertion = Nothing
End Sub
The EvaluateResults
method seemingly defaults to success, and creates too many objects. I don't like it.