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

' 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