' 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 test container object into the suite. Inherits ITest Property Read Tests As ITest[] Private $Tests As ITest[] Public Sub _new() $Tests = New ITest[] End Sub '' Runs all tests contained within the collection and collects the result in the Track parameter. Public Sub Run() Dim oTest As ITestCase Dim CurrentContainer, LastContainer As UnitTest Dim CurrentAction As String Assert $Tests For Each oTest In $Tests CurrentContainer = oTest.Container If LastContainer Then If LastContainer <> CurrentContainer Then CurrentAction = LastContainer.Name & ":TearDownContainer" StopContainer(LastContainer) CurrentAction = CurrentContainer.Name & ":SetupContainer" StartContainer(CurrentContainer) Endif Else 'Assert.Note("-------------------- " & CurrentContainer.Name) CurrentAction = CurrentContainer.Name & ":SetupContainer" StartContainer(CurrentContainer) Endif With Track .ContainerName = oTest.Container.Name .TestName = oTest.Name End With oTest.Run() LastContainer = CurrentContainer Next If LastContainer Then CurrentAction = LastContainer.Name & ":TearDownContainer" StopContainer(LastContainer) Endif Catch 'Bail out Print "Bail out! " & "Unittest Stopped with error \"" & Error.Text & "\" caused by " & CurrentAction & "." Print "# ------- No success! -------" Quit End Sub Private Sub StartContainer(Container As UnitTest) Container.SetupContainer() ' Tracks tests in a container, reset if container changes Track.ContainerTestsCount = 0 End Private Sub StopContainer(Container As UnitTest) With Container .TearDownContainer() If .Plan > 0 Then Track.Plan += .Plan Else Track.Plan += Track.ContainerTestsCount Endif End With End '' Add a object implementing ITest (either a TestCase or TestSuite) to the suite. Public Sub AddTest(oTest As ITest) Assert $Tests $Tests.Add(oTest) End Sub '' Add a TestCase to the suite. Public Sub AddTestCase(oTestCase As ITestCase) Assert $Tests $Tests.Add(oTestCase, Object.Class(oTestCase).Name) End Sub '' Create a new test case and add it to the suite. Public Function AddNewTestCase(sName As String, oTestContainer As UnitTest) Dim test As TestCase Assert sName <> Null Assert oTestContainer test = New TestCase(sName, oTestContainer) Assert $Tests $Tests.Add(test) End '' Create all test cases that are contained in the specified TestContainer and add them to the suite. Public Function AddAllTestCases(oTestContainer As UnitTest, Optional NameProcedure As String) Dim sTests As Variant Dim i As Integer Assert oTestContainer oTestContainer.CaseNames.Sort sTests = oTestContainer.CaseNames If sTests Then For i = 0 To sTests.Count - 1 If NameProcedure = Null Then AddNewTestCase(CStr(sTests[i]), oTestContainer) Else ' just one TestMethod was called, change plan oTestContainer.Plan = 1 If sTests[i] = NameProcedure Then AddNewTestCase(CStr(sTests[i]), oTestContainer) Endif Endif Next Endif End Private Function Tests_Read() As ITest[] Return $Tests End