gambas-source-code/.src/TestSuite/TestResult.class

' 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 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

'' 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

'' 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
    Dim source As String

    source = Object.Class($oCurrentTestCase.TestContainer).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 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
'' 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
    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 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