Author: Rubberduck VBA

Why?

Rubberduck unit tests live in standard modules (.bas) for a reason: they are executed with Application.Run, which is meant to execute macros. In an ideal world, Rubberduck unit tests would live in class modules (.cls) and be executed with CallByName. The problem is that CallByName is a VBA function, not an API member – and we can’t just execute arbitrary VBA code magically, so until that’s figured out, we have a little bit of a limitation here.

On top of that, not all Office applications feature an Application.Run method, which means Rubberduck unit tests can’t work in, say, Outlook.

It also means Rubberduck unit tests can’t declare a WithEvents object variable, because like the Implements keyword, that keyword is reserved for use in class modules.

Now, what?

So if one has a class with a method that raises an event, a test that would ensure the event is raised with the expected parameters, needs to take a little detour.

Say we have MyClass looking like this:

Option Explicit
Public Event Foo(ByVal value As String)

Public Sub DoSomething(ByVal value As String)
 RaiseEvent Foo(value)
End Sub

We will want to write a test to verify that DoSomething raises event Foo with the specified value argument.

TestHelper class

First step is to declare a WithEvents object variable to handle the event. Since that can only be done in a class module, we’ll need a new class module – call it TestHelper.

Option Explicit
Private WithEvents sut As MyClass
Private RaisedCount As Long
Private LastValue As String

Public Property Get SystemUnderTest() As MyClass
 Set SystemUnderTest = sut
End Property

Public Property Set SystemUnderTest(ByVal value As MyClass)
 Set sut = value
End Property

Public Property Get HasRaisedEvent() As Boolean
 RaisedCount > 0
End Property

Public Property Get Count() As Long
 Count = RaisedCount
End Property

Public Property Get LastEventArg() As String
 LastEventArg = LastValue
End Property

Private Sub sut_Foo(ByVal value As String)
 RaisedCount = RaisedCount + 1
 LastValue = value
End Sub

Now that we have encapsulated the knowledge of whether and how our event was raised, we’re ready to write a test for it.

TestMethod

'@TestMethod
Public Sub TestMethod1() 'TODO: Rename test
 On Error GoTo TestFail
 
 'Arrange:
 Dim sut As New MyClass
 Dim helper As New TestHelper
 Set helper.SystemUnderTest = sut
 
 Const expected As String = "foo"
 
 'Act:
 sut.DoSomething expected

'Assert:
 Assert.IsTrue helper.HasRaisedEvent
 Assert.AreEqual expected, helper.LastEventArg

TestExit:
 Exit Sub

TestFail:
 Assert.Fail "Test raised an error: #" & Err.Number & " - " & Err.Description
End Sub

This test will pass as is, and will fail when the tested method’s logic changes:

Public Sub DoSomething(ByVal value As String)
 RaiseEvent Foo(value & "A")
End Sub

Until we figure out a way to move Rubberduck unit tests to class modules and run them with CallByName, using a helper class will be the only way to test event raising.