127 lines
2.8 KiB
Text
127 lines
2.8 KiB
Text
' Gambas class file
|
|
|
|
Export
|
|
Property Suite As TestSuite
|
|
Private $Suite As TestSuite
|
|
|
|
Public Sub _new()
|
|
|
|
$Suite = New TestSuite
|
|
' Dim res As New TestResult
|
|
' 'RunTests(res, "GuTestIntentionalError", Null, False)
|
|
' RunTests(res, Null, Null, False)
|
|
' PrintResult(res)
|
|
|
|
End
|
|
|
|
'' Show the Test Runner Form
|
|
Public Sub ShowTestForm()
|
|
|
|
Dim fm As New FmRunner
|
|
|
|
fm.Show()
|
|
|
|
End
|
|
|
|
Public Sub Test(Optional ContainerName As String, Optional CaseName As String, Optional ShowDebug As Boolean)
|
|
|
|
Dim Res As New TestResult
|
|
|
|
Me._RunTests(Res, ContainerName, CaseName, ShowDebug)
|
|
Me._PrintResult(Res)
|
|
|
|
End
|
|
|
|
Public Sub _PrintResult(Res As TestResult)
|
|
|
|
Dim Errs As TestErrors
|
|
Dim Fails As TestErrors
|
|
Dim Err As TestError
|
|
Dim Fail As TestError
|
|
' Dim C As Class
|
|
|
|
'TS.Run(Res)
|
|
Errs = Res.Errors
|
|
Fails = Res.Failures
|
|
|
|
Print "----------------------- Test Results ----------------------- "
|
|
Print " " & res.CountRunnedTests & " Tests done"
|
|
Print "------------------------------------------------------------ "
|
|
If Errs.Count > 0 Then
|
|
For Each Err In Errs.Items
|
|
Print " Error in:";; Err.Source
|
|
Print " Error:";; Err.Description
|
|
Next
|
|
Else
|
|
Print " No Errors"
|
|
Endif
|
|
Print "\n"
|
|
If Fails.Count > 0 Then
|
|
For Each Fail In Fails.Items
|
|
Print " Failure in:";; Fail.Source
|
|
Print " Failure:";; Fail.Description
|
|
Next
|
|
Else
|
|
Print " No Failures"
|
|
Endif
|
|
Print "------------------------- Test End -------------------------"
|
|
If res.WasSuccessful = True Then
|
|
Print " Success!"
|
|
Else
|
|
Print " Not successful"
|
|
Endif
|
|
|
|
End
|
|
|
|
'' Run all tests, optional limited by Container or TestCaseName. TestResult contains .
|
|
Public Sub _RunTests(Result As TestResult, Optional ContainerName As String, Optional CaseName As String, Optional ShowDebug As Boolean)
|
|
|
|
Dim Container As ATestContainer
|
|
|
|
If ContainerName = Null Then
|
|
If CaseName = Null Then
|
|
For Each ContainerName In Runner.GetAllTestContainerNames()
|
|
Container = Object.New(ContainerName)
|
|
$Suite.AddAllTestCases(Container)
|
|
Next
|
|
Endif
|
|
Else
|
|
Container = Object.New(ContainerName)
|
|
If CaseName = Null Then
|
|
$Suite.AddAllTestCases(Container)
|
|
Else
|
|
$Suite.AddNewTestCase(CaseName, Container)
|
|
Endif
|
|
Endif
|
|
|
|
$Suite.Run(Result, ShowDebug)
|
|
|
|
End
|
|
|
|
Static Public Function GetAllTestContainerNames() As String[]
|
|
|
|
Dim ret As New String[]
|
|
Dim C As Class
|
|
|
|
For Each C In Classes
|
|
If Left(C.Name, 7) = "_GuTest" Then
|
|
ret.add(C.Name)
|
|
Endif
|
|
Next
|
|
ret.Sort()
|
|
|
|
Return ret
|
|
|
|
End
|
|
|
|
Private Function Suite_Read() As TestSuite
|
|
|
|
Return $Suite
|
|
|
|
End
|
|
|
|
Private Sub Suite_Write(Value As TestSuite)
|
|
|
|
$Suite = Value
|
|
|
|
End
|