gambas-source-code/.src/TestRunner/FmRunner.class
2016-09-21 10:55:37 +02:00

192 lines
3.3 KiB
Text

' Gambas class file
Property Suite As TestSuite
Private $Suite As TestSuite
Private $Result As TestResult
Private $FmResult As FmRunnerResult
Private $CRunner As CRunner
Public Sub _new()
$Result = New Testresult As "Result"
FillForm()
End
Public Sub Result_AfterStartTest(oTestCase As ITestCase)
End
Public Sub Result_AfterEndTest()
UpdateProgress()
$FmResult.Result = $Result
End
Public Sub Result_AfterAddTrace(sMessage As String)
$FmResult.Result = $Result
End
Public Sub Result_AfterAddError(oError As TestError)
$FmResult.Result = $Result
End
Public Sub Result_AfterAddFailure(oError As TestError)
$FmResult.Result = $Result
End
Sub UpdateProgress()
Dim Runs As New Integer[]
Runs.Add($Result.CountRunnedTests)
Runs.Add($Suite.CountTestCases())
$FmResult.Runs = Runs
Wait 0.4
End
Sub FillForm()
FillCbos()
FillTabs()
End
Sub FillCbos()
FillCboContainers()
FillCboTests()
End
Sub FillCboContainers()
Dim ContainerNames As New String[]
' ------------------------------------------------- CboContainers
With ContainerNames
.Add("All Test Containers")
.Insert(CRunner.GetAllTestContainerNames())
End With
With Me.CboContainers
.List = ContainerNames
.Index = 0
.Show()
End With
End
Sub FillCboTests(Optional TestContainerName As String)
Dim ContainerNames As String[]
Dim TestNames As New String[]
Dim C As ATestContainer
Dim i As Integer
TestNames.Add("All Test Cases")
If Not TestContainerName Then
'all Tests
ContainerNames = CRunner.GetAllTestContainerNames()
Else
'only tests from one container
ContainerNames = New String[]
ContainerNames.Add(TestContainerName)
Endif
For Each ContainerNames
C = Object.New(ContainerNames[i])
TestNames.Insert(C.CaseNames)
Inc i
Next
TestNames.Sort
With Me.CboTestCases
.List = TestNames
.Index = 0
.Show()
End With
End
Sub FillTabs()
$FmResult = New FmRunnerResult(Me.TabPanel1)
With $FmResult
.Expand = True
.Show
End With
With Me.TabPanel1
.Count = 1
.Arrangement = Arrange.Fill
.Show
.Index = 0
.Text = "Results"
End With
End
Private Function Suite_Read() As TestSuite
Return $Suite
End
Private Sub Suite_Write(Value As TestSuite)
$Suite = Value
FillCbos()
End
Public Sub CboContainers_Change()
Dim ContainerName As String
If CboContainers.Index > 0 Then
ContainerName = CRunner.GetAllTestContainerNames()[CboContainers.Index - 1]
Endif
FillCboTests(ContainerName)
End
Public Sub BtRun_Click()
RunTests()
End
Sub RunTests()
Dim ContainerName, CaseName As String
$CRunner = New CRunner
$Suite = $CRunner.Suite
' ------------------------------------------------- Container name
If CboContainers.Index > 0 Then
ContainerName = CboContainers.List[CboContainers.Index]
Endif
' ------------------------------------------------- Case name
If CboTestCases.Index > 0 Then
CaseName = CboTestCases.List[CboTestCases.Index]
Endif
$CRunner.RunTests($Result, ContainerName, CaseName)
$CRunner.PrintResult($Result)
$Result = New Testresult As "Result"
End