vbUnit3のManualFixtureの使用例

runner.bas

'
'   Test runner module
'
Public Sub run()
    Dim tests As ISuite
    Dim test As ITest
    Dim results As TestResult
    
    Set tests = New vbUnitTestSuite
    Set test = tests.suite
    Set results = test.run
    
    With results
        Debug.Print Join(Array( _
                            "RunTests:" & .NumRunTests, _
                            "Failures:" & .NumFailures, _
                            "Errors:" & .NumErrors, _
                            "Assertions:" & .NumAssertions, _
                            "Messages:" & .NumMessages), _
                        " / ")
    End With
    
    If Not results.WasSuccessful Then
        Debug.Print "*** NG ***"
        Dim testErr As vbUnit3.TestError
        
        Debug.Print "--- Errors ---"
        For Each testErr In results.Errors
            With testErr
                Debug.Print Join(Array( _
                                    .AssertNumber, _
                                    .AssertTypeName, _
                                    .AssertMessage, _
                                    .Description, _
                                    .Description1, _
                                    .Number, _
                                    .Source, _
                                    .TraceMessage), _
                                "|")
            End With
        Next
        
        Debug.Print "--- Filures ---"
        For Each testErr In results.Failures
            With testErr
                Debug.Print Join(Array( _
                                    .AssertNumber, _
                                    .AssertTypeName, _
                                    .AssertMessage, _
                                    .Description, _
                                    .Description1, _
                                    .Source, _
                                    .TraceMessage), _
                                "|")
            End With
        Next
        
    Else
        Debug.Print "OK"
    End If
    
    Set tests = Nothing
End Sub

vbUnitTestFixture.cls

Option Explicit
'
'  Test case (fixture)
'

Implements IManualFixture

Private m_assert As IAssert

'TODO: Add your test methods here
Public Sub TestFail()
  m_assert.Verify False, "hello"
End Sub


Private Sub IManualFixture_Create(assert As vbUnit3.IAssert)
    Set m_assert = assert
End Sub

Private Sub IManualFixture_Destroy()
    Set m_assert = Nothing
End Sub

Private Sub IManualFixture_GetTestNames(tests As vbUnit3.ITestNames)
    tests.Add "TestFail"
End Sub

Private Sub IManualFixture_Setup(assert As vbUnit3.IAssert)
End Sub

Private Sub IManualFixture_TearDown()
End Sub

vbUnitTestSuite.cls

Option Explicit
'
'  Test suite
'

Implements ISuite

Private Function ISuite_Suite() As ITest
Dim suite As New TestSuite
  suite.SuiteName = TypeName(Me)      'TODO: Add suitename here
  
  'TODO: Add your Fixtures here
  suite.AddFixture New vbunitTestFixture
  
  Set ISuite_Suite = suite
End Function