Automagic testing framework for VBA

Question

Building on @RubberDuck's recommendations, I now have something I find... beautiful. I'm sure there's a couple of things left to polish - this site is about making great code out of good any code, right?

This code requires trusted programmatic access to Visual Basic Project.

---

1. Client Code

I want my test classes to look like this:

TestClass1 class module (client code)

Option Explicit

Public Sub ThisIsNoTest()
    Err.Raise 5
End Sub

'@TestMethod
Public Sub MagicCommentWorks()
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.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()
    assert.IsTrue True
    assert.AreEqual False, True
    Debug.Print 1 / 0
    assert.Fail "Test should have failed by now."
End Sub

Public Sub TestNoAssert()
End Sub

Output

I want to be able to run my tests from a simple "command-line" call in the immediate pane:

TestEngine.RunAllTests "VBAProject", New TestClass1
Registered test: TestClass1.MagicCommentWorks
Registered test: TestClass1.TestAreEqual
Registered test: TestClass1.TestAreNotEqual
Registered test: TestClass1.TestAreSame
Registered test: TestClass1.TestAreNotSame
Registered test: TestClass1.TestFail
Registered test: TestClass1.TestInconclusive
Registered test: TestClass1.TestIsFalse
Registered test: TestClass1.TestIsNothing
Registered test: TestClass1.TestIsNotNothing
Registered test: TestClass1.TestIsTrue
Registered test: TestClass1.TestBlowUp
Registered test: TestClass1.TestNoAssert
2014-09-16 00:24:20 MagicCommentWorks: [INCONCLUSIVE] - No assertions made.
2014-09-16 00:24:20 TestAreEqual: [PASS]
2014-09-16 00:24:20 TestAreNotEqual: [PASS]
2014-09-16 00:24:20 TestAreSame: [FAIL] - AreSame failed: Objects should be same reference.
2014-09-16 00:24:20 TestAreNotSame: [PASS]
2014-09-16 00:24:20 TestFail: [FAIL] - Fail failed: This wasn't meant to be.
2014-09-16 00:24:20 TestInconclusive: [PASS]
2014-09-16 00:24:20 TestIsFalse: [PASS]
2014-09-16 00:24:20 TestIsNothing: [PASS]
2014-09-16 00:24:20 TestIsNotNothing: [PASS]
2014-09-16 00:24:20 TestIsTrue: [PASS]
2014-09-16 00:24:20 TestBlowUp: [INCONCLUSIVE] - Test raised an error: Division by zero
2014-09-16 00:24:20 TestNoAssert: [INCONCLUSIVE] - No assertions made.

The client code must reference an Excel add-ins:

• UnitTesting contains the test engine.

That's all. UnitTesting references these .xlam Excel add-ins:

• System contains the Framework "namespace", which exposes custom types such as List and Tuple as well as various string helper methods in the Strings "namespace".

• Reflection is used by the UnitTesting add-in, and references the Microsoft Visual Basic for Applications Extensibility 5.3 library, as well as the System add-in.

I'm mostly interested on feedback about the UnitTesting project, but the Reflection project is also open to critics!

---

2. UnitTesting

Provided that the add-in's dependencies are installed, this module is the only add-in that the client code must reference (although nothing forbids also referencing System).

The only thing the client code needs to know about, is the TestEngine's default instance.

TestEngine class module

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

Private Type TTestEngine
    Output As ITestOutput
    RegisteredTests As Dictionary
    CurrentTest As String
    CurrentTestResults As List
End Type

Private WithEvents assertion As Assert
Attribute assertion.VB_VarHelpID = -1
Private this As TTestEngine

Public Sub RunAllTests(ByVal projectName As String, ByRef classInstance As Object)

    Set this.RegisteredTests = ReflectTestMethods(projectName, classInstance)

    Dim test As Variant
    For Each test In this.RegisteredTests
        RunTest test
    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
    For Each prospect In classMethods

        If CanAddTestMethod(prospect, result) Then

            result.Add prospect.name, Tuple.Create(classInstance, prospect.name)
            Debug.Print "Registered test: " & TypeName(classInstance) & "." & prospect.name

        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 IsTestMethodName(prospect) Then Exit Function
    If testMethods.Exists(prospect.name) Then Exit Function

    CanAddTestMethod = True

End Function

Private Function IsTestMethodName(ByVal testMethod As Method) As Boolean

    IsTestMethodName = _
        Framework.Strings.StartsWith("Test", testMethod.name, False) Or _
        Framework.Strings.StartsWith("'@TestMethod", Split(testMethod.Body, vbNewLine)(1), False)

End Function

Private Sub RunTest(ByVal name As String)

    this.CurrentTest = name
    Set this.CurrentTestResults = List.Create

    Dim result As TestResult
    On Error GoTo CleanFail

    Dim testOutput As New DebugTestOutput
    Set this.Output = testOutput

    Dim test As Tuple
    Set test = this.RegisteredTests(name)

    CallByName test.Item1, test.Item2, VbMethod

    If this.CurrentTestResults.Count = 0 Then
        Set result = TestResult.Create(Inconclusive, "No assertions made.")

    ElseIf CurrentTestFailedResults.Count = 0 Then
        Set result = TestResult.Create(Succeeded)

    ElseIf CurrentTestFailedResults.Count > 0 Then
        Set result = CurrentTestFailedResults.First

    End If

CleanExit:
    this.Output.WriteResult this.CurrentTest, result
    this.CurrentTest = vbNullString

    Exit Sub

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

End Sub

Private Function CurrentTestFailedResults() As List
    Dim resultList As List
    Set resultList = List.Create

    Dim result As TestResult
    For Each result In this.CurrentTestResults
        If result.TestOutcome = Failed Then resultList.Add result
    Next
    Set CurrentTestFailedResults = resultList
End Function

Private Sub assertion_Completed(ByVal result As TestResult)
    this.CurrentTestResults.Add result
    If result.TestOutcome = Failed And CurrentTestFailedResults.Count = 0 Then
        this.Output.WriteResult this.CurrentTest, result
    End If
End Sub

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

---

Assert class module

The Assert class has undergone a thorough simplification:

Public Event Completed(ByVal result As TestResult)
Option Explicit

Private Sub OnAssertSucceeded()
    RaiseEvent Completed(TestResult.Create(Succeeded))
End Sub

Private Sub OnAssertFailed(ByVal name As String, ByVal message As String)
    RaiseEvent Completed(TestResult.Create(Failed, name & " failed: " & message))
End Sub

Private Sub OnAssertInconclusive(ByVal message As String)
    RaiseEvent Completed(TestResult.Create(0, message))
End Sub

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
        OnAssertSucceeded
    Else
        OnAssertFailed "IsTrue", message
    End If
End Sub

Public Sub IsFalse(ByVal condition As Boolean, Optional ByVal message As String)
    If Not condition Then
        OnAssertSucceeded
    Else
        OnAssertFailed "IsFalse", message
    End If
End Sub

Public Sub Inconclusive(Optional ByVal message As String)
    OnAssertInconclusive message
End Sub

Public Sub Fail(Optional ByVal message As String)
    OnAssertFailed "Fail", message
End Sub

Public Sub IsNothing(ByVal value As Object, Optional ByVal message As String)
    If value Is Nothing Then
        OnAssertSucceeded
    Else
        OnAssertFailed "IsNothing", message
    End If
End Sub

Public Sub IsNotNothing(ByVal value As Object, Optional ByVal message As String)
    If Not value Is Nothing Then
        OnAssertSucceeded
    Else
        OnAssertFailed "IsNotNothing", 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
        OnAssertSucceeded
    Else
        OnAssertFailed "AreEqual", 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
        OnAssertSucceeded
    Else
        OnAssertFailed "AreNotEqual", 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
        OnAssertSucceeded
    Else
        OnAssertFailed "AreSame", 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
        OnAssertSucceeded
    Else
        OnAssertFailed "AreNotSame", message
    End If
End Sub

---

3. Reflection

I didn't mean to do this. I blame thank @RubberDuck for this wonderful idea. I don't like to have to ask the client code to lower its security settings, but in this case the benefits clearly outweight the "risks".

This is a bit of meta-programming here, and it's my first serious usage of VBE. Surely something could improve here.

ClassModule class module

This class is pretty much a helper that gets a list of method members of a CodeModule instance. For now.

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

Public Function GetMethods(ByVal projectName As String, ByVal className As String) As List

    Dim result As List
    Set result = List.Create

    Dim procedureName As String, lastFound As String
    Dim procedureBody As String

    Dim proj As VBProject
    Set proj = GetProject(projectName)

    If proj Is Nothing Then Exit Function
    Dim module As CodeModule
    Set module = GetClass(proj, className)

    Dim i As Long
    For i = module.CountOfDeclarationLines + 1 To module.CountOfLines
        procedureName = module.ProcOfLine(i, vbext_pk_Proc)
        If procedureName <> lastFound Then
            procedureBody = module.Lines(module.ProcStartLine(procedureName, vbext_pk_Proc), module.ProcCountLines(procedureName, vbext_pk_Proc))
            result.Add Method.Create(procedureName, procedureBody)
            lastFound = procedureName
        End If
    Next

    Set GetMethods = result

End Function

Private Function GetProject(ByVal projectName As String) As VBProject

    Dim proj As VBProject
    For Each proj In Application.VBE.VBProjects
        If proj.Name = projectName Then
            Set GetProject = proj
            Exit Function
        End If
    Next

End Function

Private Function GetClass(ByVal project As VBProject, ByVal className As String) As CodeModule

    Dim component As VBComponent
    For Each component In project.VBComponents
        If component.Name = className Then
            Set GetClass = component.CodeModule
            Exit Function
        End If
    Next

End Function

---

Method class module

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Method"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
Private Type TMethod
    Name As String
    Body As String
End Type
Private this As TMethod
Option Explicit

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

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

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

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

Public Function Create(ByVal methodName As String, ByVal methodBody As String) As Method
    Dim result As New Method
    result.Name = methodName
    result.Body = methodBody
    Set Create = result
End Function

---

This can certainly be improved. How?

Answer 1

Look what I found

Dim procedureName As String, lastFound As String
Dim procedureBody As String

Personally I don't like declaring variables like this, and almost every language allows you to do this in some way or another.

I think this is one of those holy war issues though, some programmers like doing this and some programmers say this is bad practice.

Be wary of who is going to maintain this code and what they will say about you when you are gone.

---

I found something else, probably left overs of changing code or logic

Private Function CanAddTestMethod(ByVal prospect As Method, ByRef testMethods As Dictionary) As Boolean
    Dim result As Boolean

    If Not IsTestMethodName(prospect) Then Exit Function
    If testMethods.Exists(prospect.name) Then Exit Function

    CanAddTestMethod = True
End Function

I am guessing that you don't need

Dim result As Boolean

anymore and that it was leftover, although I think that you would want something like this instead

Private Function CanAddTestMethod(ByVal prospect As Method, ByRef testMethods As Dictionary) As Boolean
    CanAddTestMethod = false

    If Not IsTestMethodName(prospect) Then Exit Function
    If testMethods.Exists(prospect.name) Then Exit Function

    CanAddTestMethod = True
End Function

So that if you exit the function in one of your if statements it says "hey I am false, you can't add a test method"

but then I remember that we are talking about VBA here and I think that if you exit without setting the method it will automagically be false, so it would be just

Private Function CanAddTestMethod(ByVal prospect As Method, ByRef testMethods As Dictionary) As Boolean
    If Not IsTestMethodName(prospect) Then Exit Function
    If testMethods.Exists(prospect.name) Then Exit Function
    CanAddTestMethod = True
End Function

---

In the RunTest sub you wait until the third line of code to declare the error handling, I am not sure that this was on purpose or not, maybe the Error Description won't work if the GoTo is earlier and there is an error before the 3^rd line.

Just a thought.

---

Can we move the Exit Function code in the GetMethods function to the start of the function so we don't have to Dim variables we aren't going to use? It would be seen easier when debugging the code

instead of This

Public Function GetMethods(ByVal projectName As String, ByVal className As String) As List

    Dim result As List
    Set result = List.Create

    Dim procedureName As String, lastFound As String
    Dim procedureBody As String

    Dim proj As VBProject
    Set proj = GetProject(projectName)

    If proj Is Nothing Then Exit Function
    Dim module As CodeModule
    Set module = GetClass(proj, className)

    Dim i As Long
    For i = module.CountOfDeclarationLines + 1 To module.CountOfLines
        procedureName = module.ProcOfLine(i, vbext_pk_Proc)
        If procedureName <> lastFound Then
            procedureBody = module.Lines(module.ProcStartLine(procedureName, vbext_pk_Proc), module.ProcCountLines(procedureName, vbext_pk_Proc))
            result.Add Method.Create(procedureName, procedureBody)
            lastFound = procedureName
        End If
    Next

    Set GetMethods = result

End Function

write it like this

Public Function GetMethods(ByVal projectName As String, ByVal className As String) As List
    Dim proj As VBProject
    Set proj = GetProject(projectName)

    If proj Is Nothing Then Exit Function

    Dim result As List
    Set result = List.Create

    Dim procedureName As String, lastFound As String
    Dim procedureBody As String

    Dim module As CodeModule
    Set module = GetClass(proj, className)

    Dim i As Long
    For i = module.CountOfDeclarationLines + 1 To module.CountOfLines
        procedureName = module.ProcOfLine(i, vbext_pk_Proc)
        If procedureName <> lastFound Then
            procedureBody = module.Lines(module.ProcStartLine(procedureName, vbext_pk_Proc), module.ProcCountLines(procedureName, vbext_pk_Proc))
            result.Add Method.Create(procedureName, procedureBody)
            lastFound = procedureName
        End If
    Next

    Set GetMethods = result

End Function

---

And Where are all the Brackets and Semi-Colons?

Answer 2

I've not really dug into everything here, perhaps someone else will give you a fresh perspective on the Unit Testing code. I want to address an algorithm issue in ClassModule.GetMethods. I am partly responsible for this inefficiency because, in previous answer, I pointed you to some code I had written a while back.

The algorithm you're currently using is \$O(n)\$ where \$N\$ is the number of lines in the module. It's possible to do it in \$O(log n)\$ time by switching to a while loop and directly finding the line number of the next method.

So, instead of this:

Dim i As Long
For i = module.CountOfDeclarationLines + 1 To module.CountOfLines
    procedureName = module.ProcOfLine(i, vbext_pk_Proc)
    If procedureName <> lastFound Then
        procedureBody = module.Lines(module.ProcStartLine(procedureName, vbext_pk_Proc), module.ProcCountLines(procedureName, vbext_pk_Proc))
        result.Add Method.Create(procedureName, procedureBody)
        lastFound = procedureName
    End If
Next

Use this:

Dim lineNumber as Long
lineNumber = module.CountOfDeclarationLines + 1
While (lineNumber < module.CountOfLines)
    procedureName = module.ProcOfLine(lineNumber, vbext_pk_Proc)

    procedureBody = module.Lines(module.ProcStartLine(procedureName, vbext_pk_Proc), module.ProcCountLines(procedureName, vbext_pk_Proc))

    result.Add Method.Create(procedureName, procedureBody)

    ' add current start line to the number of lines in current procedure to get the start line of the next procedure.
    lineNumber = lineNumber + module.ProcCountLines(procedureName, vbext_pk_Proc) + 1
Wend

---

While I'm thinking about it, I'm not a big fan of this line of code, which I did not change in the improved algorithm version above.

procedureBody = module.Lines(module.ProcStartLine(procedureName, vbext_pk_Proc), module.ProcCountLines(procedureName, vbext_pk_Proc))

It's not your fault. The extensibility library is terribly clunky. That's why I extended it. What I don't quite understand is why you created a Method class, but didn't implement anything that would make these types of calls easier. Particularly, StartLine, CountOfLines, EndLine, and Body. (You're actually the one who wrote a number of properties in my library.) Consider the equivalent code where vbeProcedure (Method) has those properties.

Dim lineNumber As Long
lineNumber = codeMod.CountOfDeclarationLines + 1
While (lineNumber < codeMod.CountOfLines)
    procName = codeMod.ProcOfLine(lineNumber, vbext_pk_Proc)
    Set proc = New vbeProcedure
    proc.Initialize procName, codeMod

    procs.Add proc

    lineNumber = proc.EndLine + 1

Wend
Set GetProcedures = procs

Of course, doing that means the each Method has to know what parent module it belongs to, so if you take that approach, be careful of circular references and be sure to dispose of Methods properly.

---

GetProject is overly complicated. This is all you really need.

Private Function GetProject(ByVal projectName As String) As VBProject
    GetProject = Application.VBE.VBProjects(projectName)
End Function

Of course, it will blow up if you pass it an empty string or a Name that doesn't exist, but that's a good thing. Your code will blow up too, it will just do it farther up the stack trace and you'll be left wondering why Project Is Nothing. Let it fail early, especially when you're mucking around with meta-programming.

Scratch that. I see you put some code in to catch that.

If proj Is Nothing Then Exit Function

But I still don't like it. I'd prefer a error message to a silent failure any day of the week.

Answer 3

IsTestMethodName is lousy. The function should be IsTestMethod, and could use a few constants:

Private Const TestMethodNamePrefix As String = "Test"
Private Const TestMethodAttribute As String = "TestMethod"

Given a few more properties and a helper function in the Reflection.Method class:

Friend Property Let Body(ByVal value As String)
    this.Body = value
    FindSignature
End Property

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

'Private Const MethodAttributeMarker As String = "'@"    
Public Function HasAttribute(ByVal value As String) As Boolean
    HasAttribute = this.AttributeComment = MethodAttributeMarker & Trim(value)
End Function


Private Sub FindSignature()

    Dim lines() As String
    lines = Split(this.Body, vbNewLine)

    Dim i As Integer
    For i = LBound(lines) To UBound(lines)

        If framework.Strings.StartsWithAny(lines(i), False, "public sub", _
                                                            "private sub", _
                                                            "friend sub", _
                                                            "sub", _
                                                            "public function", _
                                                            "private function", _
                                                            "friend function", _
                                                            "function") _
        Then

            this.Signature = lines(i)

            If i > 0 Then

                If framework.Strings.StartsWith(AttributeMarker, lines(i - 1)) Then
                    this.AttributeComment = lines(i - 1)
                End If

            End If

            Exit Sub

        End If

    Next

End Sub

...you can turn IsTestMethodName into IsTestMethod in a whim. One issue with the current implementation is the hard-coding of Body line indices - the code assumes it will find a '@TestMethod "attribute" on the 2nd line (at index 1).. but a procedure's body doesn't start at its signature: it starts on the line that the VBA editor marks with a horizontal rule: the client code could very well have 5 blank lines between methods, and that would break your code.

So, given the above properties, IsTestMethod would look like this:

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

And now if there's a problem with the values of testMethod.Name, testMethod.AttributeComment or testMethod.Signature, the bug isn't in that code - it can only be in the Reflection code.

Answer 4

BUG!

I can't believe I let this one slip:

2014-09-16 00:24:20 TestInconclusive: [PASS]

The TestInconclusive test method should have output this:

2014-09-16 00:24:20 TestInconclusive: [INCONCLUSIVE] - No idea.

The TestEngine.CurrentTestFailedResults() function could be renamed to CurrentTestNotPassedResults(), and take Inconclusive results into account:

For Each result In this.CurrentTestResults
    If result.TestOutcome = Failed Or result.TestOutcome = Inconclusive Then resultList.Add result
Next

And then the assertion_Completed handler could be modified as such:

Private Sub assertion_Completed(ByVal result As TestResult)
    this.CurrentTestResults.Add result
    If (result.TestOutcome = Inconclusive Or result.TestOutcome = Failed) _
        And CurrentTestNotPassedResults.Count = 0 _
    Then
        this.Output.WriteResult this.CurrentTest, result
    End If
End Sub

That fixes the bug, and makes this test:

Public Sub TestInconclusive()
    assert.IsTrue True
    assert.Inconclusive "No idea."
    assert.Fail "shouldn't output this result."
End Sub

Output this single result, as it should:

2014-09-21 12:29:01 TestInconclusive: [INCONCLUSIVE] - No idea.

---

Tuple

It fixes the bug, but there's still something that smells: the RegisteredTests private member is a Dictionary<string,Tuple>:

For Each prospect In classMethods

    If CanAddTestMethod(prospect, result) Then
        
        result.Add prospect.name, Tuple.Create(classInstance, prospect.name)
        Debug.Print "Registered test: " & TypeName(classInstance) & "." & prospect.name
    
    End If

Next

This leads to this line of code - as it turns out, it's the most important line of all, and it reads like this:

CallByName test.Item1, test.Item2, VbMethod

Item1 and Item2 are both Variant, and mean absolutely nothing. As is the case in .NET code, using a Tuple is symptomatic of a missing abstraction - here a simple TestMethod class:

    If CanAddTestMethod(prospect, result) Then
        
        result.Add prospect.name, TestMethod.Create(classInstance, prospect.name)
        Debug.Print "Registered test: " & TypeName(classInstance) & "." & prospect.name
    
    End If

Isn't this much clearer?

Dim test As TestMethod
Set test = this.RegisteredTests(name)

CallByName test.OwnerInstance, test.MethodName, VbMethod

---

CurrentTestNotPassedResults()

This function looks like patchwork. It works, but smells... badly. And it's not efficient at all: the "failed/inconclusive" list of test results gets rebuilt every time a test is executed (heck, every time an assertion is made in a test), which means the more tests a client test class has to run, the longer it will take to process the later tests. Not nice.

The TestEngine would really benefit from having a private FailedOrInconclusiveResults list, instead of this function:

Private Type TTestEngine
    Output As ITestOutput
    RegisteredTests As Dictionary
    CurrentTest As String
    CurrentTestAllResults As List
    CurrentTestFailedOrInconclusiveResults As List
End Type

Then the assert_Completed handler can be simplified:

Private Sub assertion_Completed(ByVal result As TestResult)
    this.CurrentTestAllResults.Add result
    If result.TestOutcome = Inconclusive Or result.TestOutcome = Failed Then
        this.CurrentTestFailedOrInconclusiveResults.Add result
    End If
End Sub

Which removes all but one test.Output.WriteResult calls - the only one remaining is in the RunTest method, after the test executed. Much cleaner.

Answer 5

Bug

This one is subtle.

procedureBody = module.Lines(module.ProcStartLine(procedureName, vbext_pk_Proc), module.ProcCountLines(procedureName, vbext_pk_Proc))

Specifically, this:

module.ProcStartLine(procedureName, vbext_pk_Proc)

It will work 100% fine as long as you never pass it the name of a property. To be fair, you're Test Classes shouldn't ever have properties, but if one ever does.... Oh boy! Look out! Runtime Error #35 is waiting to peak its ugly head.

The problem is ProcStartLine needs to know what kind of method it's looking up by name. Which is a problem, because when using the extensibility library in this way, we are extremely unlikely to know whether we're dealing with a property or method upfront.

So, all that stuff in my other answer about an \$O(log n)\$ solution, forget it. In order to do this safely, you have to parse the code module line by line. Here's the solution I came up with. It's not pretty, but it makes the code safe.

Private Function GetProcedureType(signatureLine As String) As vbext_ProcKind
    If InStr(1, signatureLine, "Property Get") > 0 Then
        GetProcedureType = vbext_pk_Get
    ElseIf InStr(1, signatureLine, "Property Let") > 0 Then
        GetProcedureType = vbext_pk_Let
    ElseIf InStr(1, signatureLine, "Property Set") > 0 Then
        GetProcedureType = vbext_pk_Set
    ElseIf InStr(1, signatureLine, "Sub") > 0 Or InStr(1, signatureLine, "Function") > 0 Then
        GetProcedureType = vbext_pk_Proc
    Else
        Const InvalidProcedureCallOrArgument As Long = 5
        Err.Raise InvalidProcedureCallOrArgument
    End If
End Function

Private Function IsSignature(line As String) As Boolean
    If line = vbNullString Then Exit Function

    Dim propertyPosition As Long
    Dim functionPosition As Long
    Dim subPosition As Long
    Dim commentPosition As Long

    propertyPosition = InStr(1, line, "Property")
    functionPosition = InStr(1, line, "Function")
    subPosition = InStr(1, line, "Sub")
    commentPosition = InStr(1, line, "'")

    If propertyPosition > 0 Or functionPosition > 0 Or subPosition > 0 Then
        If InStr(1, line, "End") = 0 Then
            If commentPosition > propertyPosition Then
                Exit Function
            ElseIf commentPosition > functionPosition Then
                Exit Function
            ElseIf commentPosition > subPosition Then
                Exit Function
            Else
                IsSignature = True
            End If
        End If
    End If

End Function

Applying it to your code would look something like this. Note that I added procKind as a member of Method and there's no need to check this proc name again the last proc name because we only add a method if we're on a signature line.

Dim procKind As vbext_ProcKind
Dim i As Long
For i = Module.CountOfDeclarationLines + 1 To Module.CountOfLines
    line = Module.Lines(i, 1)
    If IsSignature(line) Then
        procKind = GetProcedureType(line)
        procedureName = Module.ProcOfLine(i, procKind)
        procedureBody = Module.Lines(Module.ProcStartLine(procedureName, procKind), Module.ProcCountLines(procedureName, procKind))

        result.Add Method.Create(procedureName, procedureBody, procKind)
    End If
Next

Of course, you might want to check the ProcKind before registering it as a TestMethod as well. I suspect CallByName won't like being told it's getting a vbMethod when it's really getting a property.

Sidenote: You may find it interesting to know that ProcOfLine does not suffer from this. As far as I can tell, you can pass that one any vbext_ProcKind and it will happily run with it.

---

We've already discussed this in chat, but for the sake of future readers, I'm adding this here. The \$O(n)\$ solution is possible after all. The reason ProcOfLine will take any vbext_ProcKind you throw at it is because it is an OUT parameter.

Note that the pprockind argument indicates whether the line belongs to a Sub or Function procedure, a Property Get procedure, a Property Let procedure, or a Property Set procedure. To determine what type of procedure a line is in, pass a variable of type Long to the ProcOfLine property, then check the value of that variable.

From the 2013 MS Access documentation. This is easily missed because both the 2013 Office and VB6 versions of the Visual Basic Add-in Object Reference don't mention it at all.

The solution is to simply declare a procKind variable, and let it capture the procKind for you.

Dim procKind as vbext_ProcKind
Dim lineNumber as Long
lineNumber = module.CountOfDeclarationLines + 1
While (lineNumber < module.CountOfLines)
    procedureName = module.ProcOfLine(lineNumber, procKind) 'procKind is an OUT param

    procedureBody = module.Lines(module.ProcStartLine(procedureName, procKind), module.ProcCountLines(procedureName, procKind))

    result.Add Method.Create(procedureName, procedureBody)

    ' add current start line to the number of lines in current procedure to get the start line of the next procedure.
    lineNumber = lineNumber + module.ProcCountLines(procedureName, procKind) + 1
Wend