' Gambas class file Export ''' This class identifies a test container. A test container is a ''' class that holds different TestMethods, it has to inherit UnitTest. ''' The static procedure Unittest.Main() starts test(s). '' Optional number of planned assertions. If > 0 then number of fulfilled assertions is compared with this. Public Plan As Integer Public Subtest As String '' Name of this testcontainer Property Read Name As String '' The names of the different test case methods in this test container Property Read CaseNames As String[] Private $CaseNames As String[] '' Runs all tests in all testcontainers and prints the result to the console. '' With UnitTest.Main(NameTestcontainer) the tests can be restricted to only those of a single test container. '' With UnitTest.Main(NameTestcontainer, NameProcedure) only a single test can be accomplished. Static Public Sub Main(Optional NameTestContainer As String, Optional NameProcedure As String, Optional DoSelfTest As Boolean) 'Track.Initialize() RunTests(NameTestContainer, NameProcedure, DoSelfTest) PrintSummary() End Public Sub _new() Dim sSymbols As String[] Dim sSymbol As String ' ------------------------------------------------- Fill Cases by listing all Testmethods $CaseNames = New String[] sSymbols = Object.Class(Me).Symbols For Each sSymbol In sSymbols If Left(sSymbol, 4) = "Test" Then $CaseNames.Add(sSymbol) Endif Next End Static Private Sub PrintSummary() Dim bSuccess As Boolean = True If Track.NOKs.Count > 0 Then Print "# Failed tests: " & PrintNumbers(Track.NOKs) 'Plan If Track.Plan > 0 Then Print "1.." & Track.Plan Else Print "0..0" Endif If Track.NOKs.Count > 0 Or If Track.Counter = 0 Then bSuccess = False Endif If Track.Plan <> Track.Counter Then bSuccess = False Print "# Plan was " & Track.Plan & " but assertions counted was " & Track.Counter Endif If bSuccess = True Then Print "# ------- Success! -------" Else Print "# ------- No success! -------" Endif Track.Reset() End Static Private Function PrintNumbers(Numbers As Long[]) As String Dim Number As Long Dim s As New String[] For Each Number In Numbers s.Add(Number) Next Return s.Join(",") End ' '' Run all tests, optional limited by Container or TestCaseName. Track contains . Static Private Function RunTests(SingleTestContainer As String, Optional NameProcedure As String, Optional DoSelfTest As Boolean) Dim ContainerName As String Dim Container As UnitTest Dim Suite As New TestSuite 'FIXME: If included as component then TestContainers can only be loaded if they contain the magic word Export For Each ContainerName In GetAllTestContainerNames(SingleTestContainer, DoSelfTest) Container = Object.New(ContainerName) Suite.AddAllTestCases(Container, NameProcedure) Next Suite.Run() End Static Function GetAllTestContainerNames(Optional SingleTestContainer As String, Optional DoSelfTest As Boolean) As String[] Dim TestClass As Class Dim TestContainernames As New String[] Dim sNames As New String[] Dim sName As String sNames = Dir(".../.gambas") Assert sNames sNames.Sort For Each sName In sNames ' 1st Alternative: ' Try TestClass = Class.Load(sName) If TestClass Then If TestClass.Parent Then If TestClass.Parent.Name = "UnitTest" Then GoSub AddClass Endif Endif Endif ' 2nd Alternative: 'Usage of 2nd Alternative creates this error: '"Class.GotoNextSection.12" 'which unfortunately happens only if gb.test is a component of a project. ' If Class.Stat(sName).Parent = "UnitTest" Then ' GoSub AddClass ' Endif Next Goto Done AddClass: TestClass = Class.Load(sName) If TestClass Then 'sName = Class.Stat(sName).Name 'Atention: Class.Stat(sName).Name does not work if included as component 'Then this creates the error: 'Bail out! Error in Unittest->GetAllTestContainerNames: Unknown symbol 'Stat' in class 'Class' If Not TestContainernames.Exist(sName) Then If testclass.Symbols.Exist("ThisIsAnUnitTestSelfTest") If DoSelfTest = True Then GoSub AddTestContainer Endif Else GoSub AddTestContainer Endif Endif Endif Return AddTestContainer: If SingleTestContainer = Null Then TestContainernames.Add(sName) Else If Lower(sName) = Lower(SingleTestContainer) Then TestContainernames.Add(sName) Endif Endif Return Done: TestContainernames.Sort ' Print "# These TestContainer will be executed:\n#\n# " & TestContainernames.Join("\n# ") & "\n" Return TestContainernames Catch Print "Bail out! Error in Unittest->GetAllTestContainerNames: " & Error.Text Print "# ------- No success! -------" Quit End ' Run the specified test case methods in this test container Public Sub _RunCase(oCase As ITestCase) Dim MethodName As String Dim hClass As Class ' ------------------------------------------------- Iterate through test methods hClass = Object.Class(Me) Assert $CaseNames For Each MethodName In $CaseNames Track.MethodTestsCount = 0 If hClass[MethodName].Kind = Class.Method Then If MethodName = oCase.Name Then Try Object.Call(Me, MethodName) If Error Then 'If Error.Code > 0 Then Inc Track.Counter Track.NOKs.Add(Track.Counter) Print "not ok " & Track.Counter & " " & Track.ContainerName & ":" & Track.TestName & " Raised error: " & Error.Text Error.Clear 'Endif Endif Endif Endif Next End Sub ''Initialize the test fixture Public Sub SetupEach() End Sub ''Destroy the test fixture Public Sub TearDownEach() End Sub ''Initialize the test fixture for container Public Sub SetupContainer() End Sub ''Destroy the test fixture for container Public Sub TearDownContainer() End Sub '' Bail out = stop immediately Public Sub BailOut(Optional Reason As String) 'Bail out If Reason <> Null Then Reason = Trim(" with reason \"" & Reason & "\"") Endif Print "Bail out! Unittest stopped" & Reason Print "# ------- No success! -------" Quit End Sub Private Function CaseNames_Read() As String[] Return $CaseNames End '' Returns the classname of the TestContainer Private Function Name_Read() As String Return Object.Class(Me).Name End