gambas-source-code/comp/src/gb.test/.src/TestSuite/TestSuite.class

161 lines
4.7 KiB
Text
Raw Normal View History

' Gambas class file
''' The TestSuite class represents a suite of different tests to be run. The TestSuite contains
''' a part-whole hierarchy of objects that implement the ITest interface --
''' including TestCase objects and other TestSuite objects. Executing the Run method for the
''' TestSuite will execute all test cases that it contains. The TestSuite class also provides
''' methods for add all test cases contained in a TestModule object into the suite.
Property Read Tests As TestCase[]
Private $Tests As New TestCase[]
'' Runs all tests contained within the collection and collects the result in the Track parameter.
Public Sub Run()
Dim oTest As TestCase
Dim CurrentTestModule, LastTestModule As Class
Dim CurrentAction As String
Assert $Tests
Test.Plan($Tests.Count)
For Each oTest In $Tests
CurrentTestModule = oTest.TestModule
If LastTestModule Then
If LastTestModule <> CurrentTestModule Then
CurrentAction = LastTestModule.Name & ":TeardownTestModule"
StopTestModule(LastTestModule)
CurrentAction = CurrentTestModule.Name & ":SetupTestModule"
StartTestModule(CurrentTestModule)
Endif
Else
'Test.Note("-------------------- " & CurrentTestModule.Name)
CurrentAction = CurrentTestModule.Name & ":SetupTestModule"
StartTestModule(CurrentTestModule)
Endif
Test._Print(gb.Lf) 'better readability for humans
Test._Print(Subst$(("TestCase &1:&2"), oTest.TestModule.Name, oTest.Name))
2020-05-02 18:35:48 +02:00
Test._Subtest(Subst$("&1:&2", oTest.TestModule.Name, oTest.Name))
'Debug oTest.Name
oTest.Run()
2020-05-02 18:35:48 +02:00
If Not Test._Finished Then Test._Finish()
LastTestModule = CurrentTestModule
Next
If LastTestModule Then
CurrentAction = LastTestModule.Name & ":TeardownTestModule"
StopTestModule(LastTestModule)
Endif
Catch
Test.BailOut("Test Stopped with error \"" & Error.Text & "\" caused by " & CurrentAction & " in " & Error.Where & ".")
End Sub
Private Sub StartTestModule(TestModule As Class)
If TestModule.Symbols.Exist("_Setup") Then
Object.Call(TestModule, "_Setup")
Endif
End
Private Sub StopTestModule(TestModule As Class)
If TestModule.Symbols.Exist("_Teardown") Then
Object.Call(TestModule, "_Teardown")
Endif
End
'' Add a TestCase to the suite.
Private Sub AddTestCase(oTestCase As TestCase)
Assert $Tests
$Tests.Add(oTestCase, Object.Class(oTestCase).Name)
End Sub
'' Create a new test case and add it to the suite.
Private Function AddNewTestCase(sName As String, TestModule As Class)
Dim test As TestCase
Assert sName <> Null
Assert TestModule
test = New TestCase(sName, TestModule)
Assert $Tests
$Tests.Add(test)
End
Static Private Function GetTestsFromTestModule(TestModule As Class) As String[]
Dim sSymbol As String
Dim NoTestSymbols As String[] = ["_Setup", "_SetupEach", "_Teardown", "_TeardownEach", "Plan"]
Dim asTests As New String[]
Assert TestModule
For Each sSymbol In TestModule.Symbols
If Not NoTestSymbols.Exist(sSymbol, gb.IgnoreCase) Then
asTests.Add(sSymbol)
Endif
Next
Return asTests
End
'' Create all test cases that are contained in the specified TestModule and add them to the suite.
Public Function AddAllTestCases(TestModule As Class, Commands As TestCommand[])
Dim asTests As String[]
Dim i, Plan, MethodCounts As Integer
Dim Command As TestCommand
Dim NameProcedure As String
Assert TestModule
asTests = GetTestsFromTestModule(TestModule)
asTests.Sort
Command = TestCommand.Find(Commands, TestModule.Name)
'If there was no Command then Command is Null
Try MethodCounts = Command.Methods.Count
'Assert asTests.Count > 0 Error "Failed: No tests in " & TestModule.Name
If asTests.Count = 0 Then
Assert.Todo("No tests in " & TestModule.Name)
Endif
For i = 0 To asTests.Count - 1
NameProcedure = CStr(asTests[i])
If MethodCounts = 0 Then
'add every testmethod
AddNewTestCase(NameProcedure, TestModule)
Else
' just certain TestMethods will be added, increase plan, if plan exists in TestModule
If TestModule.Symbols.Exist("Plan", gb.IgnoreCase) Then
Plan = Object.GetProperty(TestModule, "Plan")
Inc Plan
Object.SetProperty(TestModule, "Plan", Plan)
Endif
If Command.Methods.Exist(NameProcedure) Then
AddNewTestCase(NameProcedure, TestModule)
Endif
Endif
Next
End
Private Function Tests_Read() As TestCase[]
Return $Tests
End