Attribute VB_Name = "DevTester" '================ Developer Testing mechanics ============= ' Shared module version: 20220614 ' Depends on: ex_VBA ' Required reference: Microsoft Scripting Runtime Option Private Module Option Explicit Private Const ENUM_PARAM_CLASS_MODULE = 2 Private Const ENUM_PARAM_PROCEDURE = 0 Public Enum TTestErrors ASSERT_FAIL = vbObjectError + 1 UNEXPECTED_INTERACTION End Enum Private g_TestLog As String Private g_TestCase As String Private g_TestClause As String Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal nMilliseconds As LongPtr) ' Run this procedure to add new test suite Public Sub RunAddTestSuite() Dim iProject As Object: Set iProject = GetVBProject Dim sName$: sName = InputBox("Input suite name s_Suite") If sName = vbNullString Then _ Exit Sub If Not sName Like "s_*" Then Call MsgBox("Invalid suite name", vbExclamation) Exit Sub End If Dim aComponent As Object: Set aComponent = FindVBComponent(iProject, sName) If Not aComponent Is Nothing Then Call MsgBox("Test suite already exists", vbExclamation) Exit Sub End If Dim iNewComponent As Object Set iNewComponent = iProject.VBComponents.Add(ENUM_PARAM_CLASS_MODULE) iNewComponent.Name = sName Call iNewComponent.CodeModule.AddFromString(DefaultTestCode) Dim iHelper As Object: Set iHelper = FindVBComponent(iProject, "DevHelper").CodeModule Dim nStart&: nStart = iHelper.ProcStartLine("Dev_GetTestSuite", ENUM_PARAM_PROCEDURE) Call iHelper.InsertLines(nStart + 3, GetTestSuiteLine(sName)) End Sub Public Function Dev_LogMsg(sMsg$) If g_TestLog <> vbNullString Then _ g_TestLog = g_TestLog & vbNewLine If g_TestCase <> vbNullString Then g_TestLog = g_TestLog & "Test case: " & g_TestCase & vbNewLine g_TestCase = vbNullString End If If g_TestClause <> vbNullString Then g_TestLog = g_TestLog & "Test clause: " & g_TestClause & vbNewLine g_TestClause = vbNullString End If g_TestLog = g_TestLog & sMsg End Function Public Function Dev_LogError(nErrID&, Optional sDescription$ = vbNullString) Select Case nErrID Case 0 To 512: Call Dev_LogMsg("System error " & nErrID & vbNewLine & sDescription) Case ASSERT_FAIL: Call Dev_LogMsg("Assertion failed... Aborting test") Case UNEXPECTED_INTERACTION: Call Dev_LogMsg("Unexpected user interaction ... Aborting test") Case Else: Call Dev_LogMsg("Unknown error type " & nErrID & vbNewLine & sDescription) End Select End Function Public Function Dev_RunTestFileIO(sSuite$, sTest$, sOutputFile$) Const UTF16_MODE = TristateTrue Dim sResult$: sResult = Dev_RunTest(sSuite, sTest) Dim sPath$: sPath = Application.ActiveDocument.Path & sOutputFile Dim fso As New Scripting.FileSystemObject Dim fs As Scripting.TextStream: Set fs = fso.OpenTextFile(sPath, ForWriting, Create:=True, Format:=UTF16_MODE) Call fs.Write(sResult) Call fs.Close End Function Public Function Dev_RunTest(sSuite$, sTest$) As String Dim iSuite As Object: Set iSuite = Dev_GetTestSuite(sSuite) If iSuite Is Nothing Then Dev_RunTest = "Invalid test suite" Exit Function End If Call Randomize Call ResetLog Call ResetDescription On Error GoTo ON_ERROR Call iSuite.Setup Call CallByName(iSuite, sTest, VbMethod) Call iSuite.Teardown On Error GoTo 0 Dev_RunTest = IIf(g_TestLog = vbNullString, "OK", "FAILED" & vbNewLine & g_TestLog) Exit Function ON_ERROR: Call Dev_LogError(Err.Number, Err.Description) Dev_RunTest = "FAILED" & vbNewLine & g_TestLog Set iSuite = Nothing End Function Public Function Dev_RunTestDebug(sSuite$, sTest$) As String Dim iSuite As Object: Set iSuite = Dev_GetTestSuite(sSuite) If iSuite Is Nothing Then Dev_RunTestDebug = "Invalid test suite" Exit Function End If Call ResetLog Call ResetDescription Call iSuite.Setup Call CallByName(iSuite, sTest, VbMethod) Call iSuite.Teardown Dev_RunTestDebug = IIf(g_TestLog = vbNullString, "OK", "FAILED" & vbNewLine & g_TestLog) End Function ' ====== Tester functions ======== Public Function Dev_NewCase(sDescription$) Call ResetDescription g_TestCase = sDescription End Function Public Function Dev_NewClause(sDescription$) g_TestClause = sDescription End Function Public Function Dev_ExpectObjectValid(oVal As Object, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) Dev_ExpectObjectValid = TestObjectValid(oVal) If Not Dev_ExpectObjectValid Then _ Call Dev_LogMsg("Expected valid object") Call ResetClause End Function Public Function Dev_ExpectObjectInvalid(oVal As Object, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) Dev_ExpectObjectInvalid = Not TestObjectValid(oVal) If Not Dev_ExpectObjectInvalid Then _ Call Dev_LogMsg("Expected invalid object") Call ResetClause End Function Public Function Dev_ExpectNothing(oVal As Object, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) Dev_ExpectNothing = oVal Is Nothing If Not Dev_ExpectNothing Then _ Call Dev_LogMsg("Expected Nothing") Call ResetClause End Function Public Function Dev_ExpectNotNothing(oVal As Object, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) Dev_ExpectNotNothing = Not oVal Is Nothing If Not Dev_ExpectNotNothing Then _ Call Dev_LogMsg("Expected not Nothing") Call ResetClause End Function Public Function Dev_ExpectTrue(bVal As Boolean, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) Dev_ExpectTrue = bVal = True If Not Dev_ExpectTrue Then _ Call Dev_LogMsg("Expected TRUE statement") Call ResetClause End Function Public Function Dev_ExpectFalse(bVal As Boolean, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) Dev_ExpectFalse = bVal = False If Not Dev_ExpectFalse Then _ Call Dev_LogMsg("Expected FALSE statement") Call ResetClause End Function Public Function Dev_ExpectEQ(actualValue As Variant, expectedValue As Variant, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) On Error GoTo INCOMPARABLE Dev_ExpectEQ = CompareDeep(expectedValue, actualValue) = 0 On Error GoTo 0 If Not Dev_ExpectEQ Then _ Call Dev_LogMsg(Fmt("Actual: {1} | Expectedl: {2}", actualValue, expectedValue)) Call ResetClause Exit Function INCOMPARABLE: Dev_ExpectEQ = False Call Dev_LogMsg(Fmt("Invalid comparison: {1} == {2}", actualValue, expectedValue)) End Function Public Function Dev_ExpectNE(val1 As Variant, val2 As Variant, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) On Error GoTo INCOMPARABLE Dev_ExpectNE = CompareDeep(val1, val2) <> 0 On Error GoTo 0 If Not Dev_ExpectNE Then _ Call Dev_LogMsg(Fmt("Unexpected equality: {1} == {2}", val1, val2)) Call ResetClause Exit Function INCOMPARABLE: Dev_ExpectNE = False Call Dev_LogMsg(Fmt("Invalid comparison: {1} <> {2}", val1, val2)) End Function Public Function Dev_ExpectGR(val1 As Variant, val2 As Variant, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) On Error GoTo INCOMPARABLE Dev_ExpectGR = CompareDeep(val1, val2) > 0 On Error GoTo 0 If Not Dev_ExpectGR Then _ Call Dev_LogMsg(Fmt("Expected: {1} > {2}", val1, val2)) Call ResetClause Exit Function INCOMPARABLE: Dev_ExpectGR = False Call Dev_LogMsg(Fmt("Invalid comparison: {1} > {2}", val1, val2)) End Function Public Function Dev_ExpectLS(val1 As Variant, val2 As Variant, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) On Error GoTo INCOMPARABLE Dev_ExpectLS = CompareDeep(val1, val2) < 0 On Error GoTo 0 If Not Dev_ExpectLS Then _ Call Dev_LogMsg(Fmt("Expected: {1} < {2}", val1, val2)) Call ResetClause Exit Function INCOMPARABLE: Dev_ExpectLS = False Call Dev_LogMsg(Fmt("Invalid comparison: {1} < {2}", val1, val2)) End Function Public Function Dev_ExpectGE(val1 As Variant, val2 As Variant, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) On Error GoTo INCOMPARABLE Dev_ExpectGE = CompareDeep(val1, val2) >= 0 On Error GoTo 0 If Not Dev_ExpectGE Then _ Call Dev_LogMsg(Fmt("Expected: {1} >= {2}", val1, val2)) Call ResetClause Exit Function INCOMPARABLE: Dev_ExpectGE = False Call Dev_LogMsg(Fmt("Invalid comparison: {1} >= {2}", val1, val2)) End Function Public Function Dev_ExpectLE(val1 As Variant, val2 As Variant, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) On Error GoTo INCOMPARABLE Dev_ExpectLE = CompareDeep(val1, val2) <= 0 On Error GoTo 0 If Not Dev_ExpectLE Then _ Call Dev_LogMsg(Fmt("Expected: {1} <= {2}", val1, val2)) Call ResetClause Exit Function INCOMPARABLE: Dev_ExpectLE = False Call Dev_LogMsg(Fmt("Invalid comparison: {1} <= {2}", val1, val2)) End Function Public Function Dev_ExpectAEQ(actualValue As Variant, expectedValue As Variant, nPrecision&, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) On Error GoTo INCOMPARABLE Dev_ExpectAEQ = CompareApproximate(actualValue, expectedValue, nPrecision) = 0 On Error GoTo 0 If Not Dev_ExpectAEQ Then _ Call Dev_LogMsg(Fmt("Actual: {1} | Expectedl: {2} | Precision: {3}", actualValue, expectedValue, nPrecision)) Call ResetClause Exit Function INCOMPARABLE: Dev_ExpectAEQ = False Call Dev_LogMsg(Fmt("Invalid comparison: {1} == {2}, precision {3}", actualValue, expectedValue, nPrecision)) End Function Public Function Dev_ExpectANE(val1 As Variant, val2 As Variant, nPrecision&, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) On Error GoTo INCOMPARABLE Dev_ExpectANE = CompareApproximate(val1, val2, nPrecision) <> 0 On Error GoTo 0 If Not Dev_ExpectANE Then _ Call Dev_LogMsg(Fmt("Unexpected equality: {1} == {2}, precision: {3}", val1, val2, nPrecision)) Call ResetClause Exit Function INCOMPARABLE: Dev_ExpectANE = False Call Dev_LogMsg(Fmt("Invalid comparison: {1} <> {2}, precision {3}", val1, val2, nPrecision)) End Function Public Function Dev_ExpectAGR(val1 As Variant, val2 As Variant, nPrecision&, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) On Error GoTo INCOMPARABLE Dev_ExpectAGR = CompareApproximate(val1, val2, nPrecision) > 0 On Error GoTo 0 If Not Dev_ExpectAGR Then _ Call Dev_LogMsg(Fmt("Expected: {1} > {2}, precision {3}", val1, val2, nPrecision)) Call ResetClause Exit Function INCOMPARABLE: Dev_ExpectAGR = False Call Dev_LogMsg(Fmt("Invalid comparison: {1} > {2}, precision {3}", val1, val2, nPrecision)) End Function Public Function Dev_ExpectALS(val1 As Variant, val2 As Variant, nPrecision&, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) On Error GoTo INCOMPARABLE Dev_ExpectALS = CompareApproximate(val1, val2, nPrecision) < 0 On Error GoTo 0 If Not Dev_ExpectALS Then _ Call Dev_LogMsg(Fmt("Expected: {1} < {2}, precision {3}", val1, val2, nPrecision)) Call ResetClause Exit Function INCOMPARABLE: Dev_ExpectALS = False Call Dev_LogMsg(Fmt("Invalid comparison: {1} < {2}, precision {3}", val1, val2, nPrecision)) End Function Public Function Dev_ExpectAGE(val1 As Variant, val2 As Variant, nPrecision&, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) On Error GoTo INCOMPARABLE Dev_ExpectAGE = CompareApproximate(val1, val2, nPrecision) >= 0 On Error GoTo 0 If Not Dev_ExpectAGE Then _ Call Dev_LogMsg(Fmt("Expected: {1} >= {2}, precision {3}", val1, val2, nPrecision)) Call ResetClause Exit Function INCOMPARABLE: Dev_ExpectAGE = False Call Dev_LogMsg(Fmt("Invalid comparison: {1} >= {2}, precision {3}", val1, val2, nPrecision)) End Function Public Function Dev_ExpectALE(val1 As Variant, val2 As Variant, nPrecision&, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) On Error GoTo INCOMPARABLE Dev_ExpectALE = CompareApproximate(val1, val2, nPrecision) <= 0 On Error GoTo 0 If Not Dev_ExpectALE Then _ Call Dev_LogMsg(Fmt("Expected: {1} <= {2}, precision {3}", val1, val2, nPrecision)) Call ResetClause Exit Function INCOMPARABLE: Dev_ExpectALE = False Call Dev_LogMsg(Fmt("Invalid comparison: {1} <= {2}, precision {3}", val1, val2, nPrecision)) End Function ' ========= String comparisons =========== Public Function Dev_ExpectLike(sValue$, sMask$, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) Dev_ExpectLike = sValue Like sMask If Not Dev_ExpectLike Then _ Call Dev_LogMsg(Fmt("Expected: {1} Like {2}", sValue, sMask)) Call ResetClause End Function Public Function Dev_ExpectNotLike(sValue$, sMask$, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) Dev_ExpectNotLike = Not sValue Like sMask If Not Dev_ExpectNotLike Then _ Call Dev_LogMsg(Fmt("Expected: {1} not Like {2}", sValue, sMask)) Call ResetClause End Function ' ======= Error comparisons =========== Public Function Dev_ExpectAnyError(Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) Dev_ExpectAnyError = Err.Number <> 0 If Not Dev_ExpectAnyError Then _ Call Dev_LogMsg("Expected any Error, but got nothing") Call ResetClause End Function Public Function Dev_ExpectError(nError&, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) Dev_ExpectError = Err.Number = nError If Err.Number = 0 Then Call Dev_LogMsg(Fmt("Expected Error #{1}, but got no error", nError)) ElseIf Not Dev_ExpectError Then Call Dev_LogMsg(Fmt("Expected Error #{1}, actual Error #{2}", nError, Err.Number)) End If Call Err.Clear Call ResetClause End Function Public Function Dev_ExpectErrorMsg(sDesc$, Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) Dev_ExpectErrorMsg = Err.Description = sDesc If Err.Number = 0 Then Call Dev_LogMsg(Fmt("Expected Error, but got no error")) ElseIf Not Dev_ExpectErrorMsg Then Call Dev_LogMsg(Fmt("Expected error msg: #{1}" & vbNewLine & "Actual error message: #{2}", sDesc, Err.Description)) End If Call Err.Clear Call ResetClause End Function Public Function Dev_ExpectNoError(Optional sClause$ = vbNullString) As Boolean If sClause <> vbNullString Then _ Call Dev_NewClause(sClause) Dev_ExpectNoError = Err.Number = 0 If Not Dev_ExpectNoError Then _ Call Dev_LogMsg(Fmt("Expected no Error, but got Error #{1}", Err.Number)) Call Err.Clear Call ResetClause End Function ' =========== Assertion proxies ========== Public Function Dev_AssertObjectValid(oVal As Object, Optional sClause$ = vbNullString) If Not Dev_ExpectObjectValid(oVal, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertObjectInvalid(oVal As Object, Optional sClause$ = vbNullString) If Not Dev_ExpectObjectInvalid(oVal, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertNothing(oVal As Object, Optional sClause$ = vbNullString) If Not Dev_ExpectNothing(oVal, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertNotNothing(oVal As Object, Optional sClause$ = vbNullString) If Not Dev_ExpectNotNothing(oVal, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertTrue(bVal As Boolean, Optional sClause$ = vbNullString) If Not Dev_ExpectTrue(bVal, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertFalse(bVal As Boolean, Optional sClause$ = vbNullString) If Not Dev_ExpectFalse(bVal, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertEQ(expectedValue As Variant, actualValue As Variant, Optional sClause$ = vbNullString) If Not Dev_ExpectEQ(expectedValue, actualValue, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertNE(val1 As Variant, val2 As Variant, Optional sClause$ = vbNullString) If Not Dev_ExpectNE(val1, val2, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertGR(val1 As Variant, val2 As Variant, Optional sClause$ = vbNullString) If Not Dev_ExpectGR(val1, val2, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertLS(val1 As Variant, val2 As Variant, Optional sClause$ = vbNullString) If Not Dev_ExpectLS(val1, val2, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertGE(val1 As Variant, val2 As Variant, Optional sClause$ = vbNullString) If Not Dev_ExpectGE(val1, val2, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertLE(val1 As Variant, val2 As Variant, Optional sClause$ = vbNullString) If Not Dev_ExpectLE(val1, val2, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertAEQ(expectedValue As Variant, actualValue As Variant, nPrecision&, Optional sClause$ = vbNullString) If Not Dev_ExpectAEQ(expectedValue, actualValue, nPrecision, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertANE(val1 As Variant, val2 As Variant, nPrecision&, Optional sClause$ = vbNullString) If Not Dev_ExpectANE(val1, val2, nPrecision, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertAGR(val1 As Variant, val2 As Variant, nPrecision&, Optional sClause$ = vbNullString) If Not Dev_ExpectAGR(val1, val2, nPrecision, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertALS(val1 As Variant, val2 As Variant, nPrecision&, Optional sClause$ = vbNullString) If Not Dev_ExpectALS(val1, val2, nPrecision, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertAGE(val1 As Variant, val2 As Variant, nPrecision&, Optional sClause$ = vbNullString) If Not Dev_ExpectAGE(val1, val2, nPrecision, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertALE(val1 As Variant, val2 As Variant, nPrecision&, Optional sClause$ = vbNullString) If Not Dev_ExpectALE(val1, val2, nPrecision, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertLike(sValue$, sMask$, Optional sClause$ = vbNullString) As Boolean If Not Dev_ExpectLike(sValue, sMask, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertNotLike(sValue$, sMask$, Optional sClause$ = vbNullString) As Boolean If Not Dev_ExpectNotLike(sValue, sMask, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertAnyError(Optional sClause$ = vbNullString) If Not Dev_ExpectAnyError(sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertError(nError&, Optional sClause$ = vbNullString) As Boolean If Not Dev_ExpectError(nError, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertErrorMsg(sDesc$, Optional sClause$ = vbNullString) As Boolean If Not Dev_ExpectErrorMsg(sDesc, sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function Public Function Dev_AssertNoError(Optional sClause$ = vbNullString) As Boolean If Not Dev_ExpectNoError(sClause) Then _ Call Err.Raise(ASSERT_FAIL) End Function ' ======== Private Function ResetLog() g_TestLog = vbNullString End Function Private Function ResetDescription() g_TestCase = vbNullString g_TestClause = vbNullString End Function Private Function ResetClause() g_TestClause = vbNullString End Function Private Function TestObjectValid(target As Object) As Boolean Call Sleep(100) On Error Resume Next Dim sName$: sName = target.Name Select Case Err.Number ' no error Case 0: TestObjectValid = True ' object doesnt not support property Case 438: TestObjectValid = True Case Else: TestObjectValid = False End Select End Function Private Function GetVBProject() As Object Dim iApplication As Object: Set iApplication = Application If Application.Name = "Microsoft Excel" Then Set GetVBProject = iApplication.ThisWorkbook.VBProject Else Set GetVBProject = iApplication.VBE.ActiveVBProject End If End Function Private Function FindVBComponent(iProject As Object, sName$) As Object Dim aComponent As Object For Each aComponent In iProject.VBComponents If aComponent.Name = sName Then Set FindVBComponent = aComponent Exit Function End If Next aComponent End Function Private Function DefaultTestCode() As String DefaultTestCode = _ "Public Function Setup()" & vbNewLine & _ " ' Mandatory setup function" & vbNewLine & _ "End Function" & vbNewLine & _ vbNewLine & _ "Public Function Teardown()" & vbNewLine & _ " ' Mandatory teardown function" & vbNewLine & _ "End Function" & vbNewLine & _ vbNewLine & _ "Public Function t_Init()" & vbNewLine & _ " On Error GoTo PROPAGATE_ERROR" & vbNewLine & _ vbNewLine & _ " Exit Function" & vbNewLine & _ "PROPAGATE_ERROR:" & vbNewLine & _ " Call Dev_LogError(Err.Number, Err.Description)" & vbNewLine & _ "End Function" End Function Private Function GetTestSuiteLine(sName$) As String GetTestSuiteLine = _ " Case " & """" & sName & """" & ": " & _ "Set Dev_GetTestSuite = New " & sName End Function