680 lines
22 KiB
QBasic
680 lines
22 KiB
QBasic
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
|