270 lines
7.5 KiB
Text
270 lines
7.5 KiB
Text
' Gambas class file
|
|
|
|
' The TestResult object collects the results from executing test cases. It is an
|
|
' instance of the Collecting Parameter pattern. When new failures or errors
|
|
' are added to the TestResult or if a test case is started or finished, the
|
|
' TestResult generates events to notify its event handlers about what has happened.
|
|
'
|
|
' The test framework distinguishes between failures and errors.
|
|
' A failure is anticipated and checked for with assertions. Errors are
|
|
' unanticipated problems signified by exceptions that are not generated
|
|
' by the framework. TestResult includes a set of Assert methods that simplify
|
|
' the checking of test assertions.
|
|
|
|
' Member Variables
|
|
Private $colErrors As TestErrors
|
|
Private $colFailures As TestErrors
|
|
Private $colParameters As TestParameters
|
|
Private $iRunTests As Integer
|
|
Private $oCurrentTestCase As ITestCase
|
|
|
|
' Events
|
|
Event AfterStartTest(oTestCase As ITestCase)
|
|
Event AfterEndTest()
|
|
Event AfterAddError(oError As TestError)
|
|
Event AfterAddFailure(oError As TestError)
|
|
Event AfterAddTrace(sMessage As String)
|
|
|
|
' Initialize Variables
|
|
Public Sub _new()
|
|
|
|
$colErrors = New TestErrors
|
|
$colFailures = New TestErrors
|
|
$iRunTests = 0
|
|
|
|
End Sub
|
|
|
|
' ' Cleanup references
|
|
' Private Sub Class_Terminate()
|
|
'
|
|
' $colErrors = Null
|
|
' $colFailures = Null
|
|
'
|
|
' End Sub
|
|
|
|
' Returns whether the entire test was successful or not.
|
|
Property Read WasSuccessful As Boolean
|
|
|
|
' Informs the result that a test will be started.
|
|
Public Sub StartTest(oTestCase As ITestCase)
|
|
|
|
$oCurrentTestCase = oTestCase
|
|
Raise AfterStartTest(oTestCase)
|
|
|
|
End Sub
|
|
|
|
' Informs the result that a test is completed.
|
|
Public Sub EndTest()
|
|
|
|
$oCurrentTestCase = Null
|
|
$iRunTests = $iRunTests + 1
|
|
Raise AfterEndTest
|
|
|
|
End Sub
|
|
|
|
' Adds a failure to the collection of failures.
|
|
Public Sub AddFailure(sDescription As String)
|
|
|
|
Dim oNewError As TestError
|
|
|
|
'Failures use Error number 0
|
|
oNewError = $colFailures.Add($oCurrentTestCase, 0, "", sDescription)
|
|
Raise AfterAddFailure(oNewError)
|
|
oNewError = Null
|
|
|
|
End Sub
|
|
|
|
' Adds a error to the collection of errors.
|
|
Public Sub AddError(lNumber As Long, sSource As String, sDescription As String)
|
|
|
|
Dim oNewError As TestError
|
|
|
|
oNewError = $colErrors.Add($oCurrentTestCase, lNumber, sSource, sDescription)
|
|
Raise AfterAddError(oNewError)
|
|
oNewError = Null
|
|
|
|
End Sub
|
|
|
|
' Add trace message
|
|
Public Sub AddTrace(sMessage As String)
|
|
|
|
Raise AfterAddTrace(sMessage)
|
|
|
|
End Sub
|
|
|
|
' Gets the number of run tests.
|
|
Property Read RunTests As Integer
|
|
|
|
' Returns a collection of failures
|
|
Property Read Failures As TestErrors
|
|
|
|
' Returns a collection of errors
|
|
Property Read Errors As TestErrors
|
|
|
|
' Set and Returns parameter collection
|
|
Property Parameters As TestParameters
|
|
|
|
' Asserts that a condition is true. If it isn't it raises a failure with the given message.
|
|
' bCondition: condition to be asserted
|
|
' sMessage: optional message describing the asserted condition
|
|
Public Sub Assert(bCondition As Boolean, Optional sMessage As String)
|
|
|
|
If Not bCondition Then
|
|
AddFailure(sMessage)
|
|
End If
|
|
|
|
End Sub
|
|
|
|
' Asserts that the expected string equals the actual string.
|
|
' sExpected: the expected value
|
|
' sActual: the actual value
|
|
' sMessage: optional message describing the asserted condition
|
|
Public Sub AssertEqualsString(sExpected As String, sActual As String, Optional sMessage As String)
|
|
|
|
If sExpected <> sActual Then
|
|
AddFailure(NotEqualsMessage(sMessage, sExpected, sActual))
|
|
End If
|
|
|
|
End Sub
|
|
|
|
' Asserts that the expected long value equals the actual long value.
|
|
' lExpected: the expected value
|
|
' lActual: the actual value
|
|
' sMessage: optional message describing the asserted condition
|
|
Public Sub AssertEqualsLong(lExpected As Long, lActual As Long, Optional sMessage As String)
|
|
|
|
If lExpected <> lActual Then
|
|
AddFailure(NotEqualsMessage(sMessage, lExpected, lActual))
|
|
End If
|
|
|
|
End Sub
|
|
|
|
' Asserts that the expected Float value equals the actual Float value with delta precision.
|
|
' dExpected: the expected value
|
|
' dActual: the actual value
|
|
' dDelta: tolerated precision
|
|
' sMessage: optional message describing the asserted condition
|
|
Public Sub AssertEqualsFloat(dExpected As Float, dActual As Float, dDelta As Float, Optional sMessage As String)
|
|
|
|
If (Abs(dExpected - dActual) > dDelta) Then
|
|
AddFailure(NotEqualsMessage(sMessage, dExpected, dActual))
|
|
End If
|
|
|
|
End Sub
|
|
|
|
' Asserts that the expected variant equals the actual variant.
|
|
' vExpected: the expected value
|
|
' vActual: the actual value
|
|
' sMessage: optional message describing the asserted condition
|
|
Public Sub AssertEqualsVariant(vExpected As Variant, vActual As Variant, Optional sMessage As String)
|
|
|
|
If vExpected <> vActual Then
|
|
AddFailure(NotEqualsMessage(sMessage, vExpected, vActual))
|
|
End If
|
|
|
|
End Sub
|
|
|
|
' Asserts that an object is not nothing
|
|
' oObject: object reference
|
|
' sMessage: the detail message to record if this assertion fails
|
|
Public Sub AssertExists(oObject As Object, Optional sMessage As String)
|
|
|
|
If Not oObject Then
|
|
AddFailure(sMessage & " - Object of type " & oObject.TypeOf & " is Nothing.")
|
|
End If
|
|
|
|
End Sub
|
|
|
|
' Asserts that the expected object equals the actual object.
|
|
' oExpected: expected object reference
|
|
' oActual: actual object reference
|
|
' sMessage: the detail message to record if this assertion fails
|
|
Public Sub AssertEqualsObject(oExpected As Object, oActual As Object, Optional sMessage As String)
|
|
|
|
If Not (oExpected = OActual) Then
|
|
AddFailure(sMessage & " - Object [" & oExpected.name & "] does not equal Object [" & oActual.name & "].")
|
|
End If
|
|
|
|
End Sub
|
|
|
|
' Asserts that a variant is not empty
|
|
' vVariant: variant to evaluate
|
|
' sMessage: the detail message to record if this assertion fails
|
|
Public Sub AssertNotEmpty(vVariant As Variant, Optional sMessage As String)
|
|
|
|
If (vVariant = Null) Then
|
|
AddFailure(sMessage & " - Variant is Empty.")
|
|
End If
|
|
|
|
End Sub
|
|
|
|
' Asserts that a variant is not null
|
|
' vVariant: variant to evaluate
|
|
' sMessage: the detail message to record if this assertion fails
|
|
Public Sub AssertNotNull(vVariant As Variant, Optional sMessage As String)
|
|
|
|
If (IsNull(vVariant)) Then
|
|
AddFailure(sMessage & " - Variant is Null.")
|
|
End If
|
|
|
|
End Sub
|
|
|
|
' Asserts that an error was thrown
|
|
' lError: error number to compare
|
|
Public Sub AssertEqualsError(oError As Error, Optional lError As Long, Optional sMessage As String)
|
|
|
|
If (lError = 0 And oError.Number = 0) Then
|
|
AddFailure(sMessage & " - Expected Error did not occur.")
|
|
Else If (lError <> 0 And oError.Number <> lError) Then
|
|
AddFailure(sMessage &
|
|
" - Expected Error (" & lError & ") but Error (" &
|
|
oError.Number & ") was thrown instead. Description: " &
|
|
oError.Description)
|
|
End If
|
|
|
|
End Sub
|
|
|
|
' Build a message about a failed equality check
|
|
Private Function NotEqualsMessage(sMessage As String, sExpected As Variant, sActual As Variant) As String
|
|
|
|
Return sMessage & " expected: " & CString(sExpected) & " but was: " & CStr(sActual)
|
|
|
|
End Function
|
|
|
|
Private Function WasSuccessful_Read() As Boolean
|
|
|
|
Return (($colErrors.Count = 0) And ($colFailures.Count = 0))
|
|
|
|
End
|
|
|
|
Private Function RunTests_Read() As Integer
|
|
|
|
Return $iRunTests
|
|
|
|
End
|
|
|
|
Private Function Failures_Read() As TestErrors
|
|
|
|
Return $colFailures
|
|
|
|
End
|
|
|
|
Private Function Errors_Read() As TestErrors
|
|
|
|
'Errors = $colErrors
|
|
Return $colErrors
|
|
|
|
End
|
|
|
|
Private Function Parameters_Read() As TestParameters
|
|
|
|
'Parameters = $colParameters
|
|
Return $colParameters
|
|
|
|
End
|
|
|
|
Private Sub Parameters_Write(Value As TestParameters)
|
|
|
|
$colParameters = Value
|
|
|
|
End
|