295 lines
8.4 KiB
Text
295 lines
8.4 KiB
Text
' Gambas class file
|
|
|
|
Export
|
|
|
|
''' 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.
|
|
|
|
'' Gets the number of run tests.
|
|
Property Read CountRunnedTests 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
|
|
|
|
'' Member Variables
|
|
Private $colErrors As TestErrors
|
|
Private $colFailures As TestErrors
|
|
Private $colParameters As TestParameters
|
|
Private $iCountRunnedTests 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
|
|
$iCountRunnedTests = 0
|
|
|
|
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
|
|
$iCountRunnedTests = $iCountRunnedTests + 1
|
|
Raise AfterEndTest
|
|
|
|
End Sub
|
|
|
|
'' Adds a failure to the collection of failures.
|
|
Public Sub AddFailure(sDescription As String)
|
|
|
|
Dim oNewError As TestError
|
|
Dim source As String
|
|
|
|
source = Object.Class($oCurrentTestCase.Container).Name &
|
|
"." & $oCurrentTestCase.Name
|
|
|
|
'Failures use Error number 0
|
|
oNewError = $colFailures.Add($oCurrentTestCase, 0, source, 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
|
|
|
|
'' 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 a condition is false. 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 AssertFalse(bCondition As Boolean, Optional sMessage As String)
|
|
|
|
If 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 empty
|
|
'' vVariant: variant to evaluate
|
|
'' sMessage: the detail message to record if this assertion fails
|
|
Public Sub AssertEmpty(vVariant As Variant, Optional sMessage As String)
|
|
|
|
If (vVariant <> Null) Then
|
|
AddFailure(sMessage & " - Variant is not 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
|
|
'' Use it so:
|
|
''
|
|
'' Try DosomethingThatThrowserror()
|
|
'' AssertError(Error.Code, Error.Text)
|
|
|
|
Public Sub AssertError(ErrorNumber As Long, ErrorMessage As String, Optional ErrorNumberExpected As Long, Optional StrMessage As String)
|
|
|
|
If (ErrorNumberExpected = 0 And ErrorNumber = 0) Then
|
|
AddFailure(StrMessage & " - Expected Error did not occur.")
|
|
Else If (ErrorNumberExpected <> 0 And ErrorNumber <> ErrorNumberExpected) Then
|
|
AddFailure(StrMessage &
|
|
" - Expected Error (" & ErrorNumberExpected & ") but Error (" &
|
|
ErrorNumber & ") was thrown instead. Description: " &
|
|
ErrorMessage)
|
|
End If
|
|
Error.Clear
|
|
|
|
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 CountRunnedTests_Read() As Integer
|
|
|
|
Return $iCountRunnedTests
|
|
|
|
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
|