' 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 Assert.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 'Assert.Note("-------------------- " & CurrentTestModule.Name) CurrentAction = CurrentTestModule.Name & ":SetupTestModule" StartTestModule(CurrentTestModule) Endif Assert.Note(Subst$(("Entering subtest &1:&2"), oTest.TestModule.Name, oTest.Name)) Assert.Subtest(Subst$("&1:&2", oTest.TestModule.Name, oTest.Name)) oTest.Run() If Not Assert.Finished Then Assert.Finish() LastTestModule = CurrentTestModule Next If LastTestModule Then CurrentAction = LastTestModule.Name & ":TearDownTestModule" StopTestModule(LastTestModule) Endif Catch Assert.BailOut("Test Stopped with error \"" & Error.Text & "\" caused by " & CurrentAction & ".") Quit 1 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) Dim Plan As Integer 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, Optional NameProcedure As String) Dim asTests As String[] Dim i As Integer Assert TestModule asTests = GetTestsFromTestModule(TestModule) asTests.Sort ' Tests must not be empty 'Assert asTests.Count > 0 Error "Failed: No tests in " & TestModule.Name If asTests.Count = 0 Then Assert.BailOut("Error: No tests in " & TestModule.Name) Endif For i = 0 To asTests.Count - 1 If NameProcedure = Null Then AddNewTestCase(CStr(asTests[i]), TestModule) Else ' just one TestMethod was called, change plan, if plan exists in TestModule If TestModule.Symbols.Exist("Plan", gb.IgnoreCase) Then Object.SetProperty(TestModule, "Plan", 1) Endif If asTests[i] = NameProcedure Then AddNewTestCase(CStr(asTests[i]), TestModule) Endif Endif Next End Private Function Tests_Read() As TestCase[] Return $Tests End