146 lines
3.4 KiB
Text
146 lines
3.4 KiB
Text
' Gambas class file
|
|
|
|
Export
|
|
Property Suite As TestSuite
|
|
Private $Suite As TestSuite
|
|
|
|
'' Normal name for testclasses starts with _GuTest, here it can be redefined
|
|
Property constSelfTest As Boolean
|
|
Private $constSelfTest As Boolean
|
|
|
|
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(Null, Me.constSelfTest)
|
|
|
|
fm.Show()
|
|
|
|
End
|
|
'' Runs the Unittest and prints the result to the console. Optional limited to one testclass and/or one testmethod.
|
|
|
|
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.constSelfTest)
|
|
Me._PrintResult(Res)
|
|
|
|
End
|
|
|
|
'' Prints a result.
|
|
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, Optional constSelfTest As Boolean)
|
|
|
|
Dim Container As ATestContainer
|
|
|
|
If ContainerName = Null Then
|
|
If CaseName = Null Then
|
|
For Each ContainerName In UnitTest.GetAllTestContainerNames(constSelfTest)
|
|
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(Optional constSelfTest As Boolean) As String[]
|
|
|
|
Dim ret As New String[]
|
|
Dim C As Class
|
|
|
|
For Each C In Classes
|
|
|
|
'If Left(C.Name, Len(Prefix)) = Prefix 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
|
|
|
|
Private Function constSelfTest_Read() As String
|
|
|
|
Return $constSelfTest
|
|
|
|
End
|
|
|
|
Private Sub constSelfTest_Write(Value As String)
|
|
|
|
$constSelfTest = Value
|
|
|
|
End
|