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
Reflectionlibrary to get all methods from the specified class instance. - Find test methods among all found methods - a test method is a
Public Subwhose 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.
