' 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.Note(Subst$(("Subtest &1:&2"), oTest.TestModule.Name, oTest.Name)) Test.Print(gb.lf) ' better readability for humans Test.Print(Subst$(("Subtest &1:&2"), oTest.TestModule.Name, oTest.Name)) Test.Subtest(Subst$("&1:&2", oTest.TestModule.Name, oTest.Name)) 'Debug oTest.Name oTest.Run() 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 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