gambas-source-code/.src/TestResult.class
2015-01-30 07:46:43 +01:00

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