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

' Gambas class file

Export

Create Static

Private $hHarness As New TestHarness
Private $bVerbose As Boolean

''' The static procedure Test.Main() starts test(s).

'' Runs all tests in all testcontainers and prints the result to the console.
'' With Test.Main(NameTestModule) the tests can be restricted to only those of a single test module.
'' With Test.Main(NameTestModule, NameProcedure) only a single test can be accomplished.

Public Sub Main(Optional Tests As String, Optional Sparse As Boolean, Optional NoSummary As Boolean)

    Assert.Reset() ' only if you run this Main multiple times per process, which you shouldn't
    $bVerbose = Not Sparse
    RunTests(Tests, Sparse)
    If Not NoSummary Then PrintSummary()

End

Private Sub PrintSummary()

    With $hHarness.Current

        If $bVerbose Then
            Dim sLine As String
            Print "# Transcript of the TAP stream:"
            Print
            For Each sLine In .Lines
                Print sLine
            Next
            Print
            Print String$(80, "*")
            Print
        Endif

        Print .Name;; IIf(.Success, "PASSED", "FAILED");;
        Print "("; "exit code";; .ExitCode; ",";;
        Print "runtime";; Format$(DateDiff(.Started, .Ended, gb.Second), "0.00s"); ")"

        If .Run <> .Planned Then
            Print "Planned";; .Planned;; "tests but ran";; .Run
        Endif

        If .Failed > 0 Then
            Dim iInd As Integer
            Print "Failed";; .Failed;; "out of";; .Run;; "tests:";;
            For iInd = 0 To .Failures.Max
                Print .Failures[iInd];
                If iInd < .Failures.Max Then Print ",";;
            Next
            Print
        Endif

        If .Bonus Then
            Print "Passed";; .Bonus;; "additional tests marked as TODO"
        Endif

        If .BailedOut Then
            Print "Bailed out with message";; .BailMessage
        Endif

        Print
        Print "# " & String$(80, "*")
        Print

    End With

End

'
'' Run all tests, optional limited by Container or TestCaseName. Track contains .

Private Function RunTests(Tests As String, Optional Sparse As Boolean)

    Dim aTestCommands As TestCommand[]
    Dim sTestModule As String
    Dim TestModule As Class
    Dim Suite As New TestSuite
    Dim hTapStream As Stream, sTap As String

    aTestCommands = TestCommand.ParseCommands(Tests)

    'FIXME: SingleTestModule, NameProcedure do not exist any more, they are replaced by aTestCommands
    Dim NameProcedure, SingleTestModule As String

    For Each sTestModule In GetAllTestModules(aTestCommands)
        TestModule = Class.Load(sTestModule)
        Suite.AddAllTestCases(TestModule, aTestCommands)
    Next

    ' FIXME: This as hack that allows to see the TAP as it is produced. Sparse = true switches that off
    ' This is for tests which fail with an error and test gb.test's BailOut.
    ' Such tests are buffered to a string stream but before they can be echoed,
    ' the process dies.

    If Sparse = False Then
        ' The TAP stream is produced in this process. We have to get it into the
        ' harness somehow. Since we don't start a new process, it is going to be
        ' done by a buffer.
        hTapStream = Open String For Write
        Assert.Output = hTapStream
        Suite.Run()
        sTap = Close #hTapStream
        hTapStream = Open String sTap For Read
        
        'FIXME: SingleTestModule, NameProcedure do not exist any more
        $hHarness.Read(hTapStream, Subst$("&1:&2", SingleTestModule, IIf(NameProcedure, NameProcedure, "*")))
        Close #hTapStream
    Else
        Suite.Run()
    Endif

End

''

Function GetAllTestModules(Commands As TestCommand[]) As String[]

    Dim TestClass As Class
    Dim TestModuleNames As New String[]
    Dim sNames As New String[]
    Dim sName As String
    Dim Command As TestCommand

    If Exist(".../.test")
        sNames = Split(File.Load(".../.test"), gb.Lf, Null, True)
    Endif

    Assert sNames

    sNames.Sort
    For Each sName In sNames
        TestClass = Class.Load(sName)
        If Not TestClass Then Error.Raise(Subst$(("Could not load test module '&1'"), sName))

        '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 Test->GetAllTestModuleNames: Unknown symbol 'Stat' in class 'Class'

        If TestModuleNames.Exist(sName) Then Continue
        If Commands.Count = 0 Then
            'Add every Testmodule
            TestModuleNames.Add(sName)
        Else
            ' Add only testmodules whose names exist in Commands
            For Each Command In Commands
                If Lower(Command.ModuleName) = Lower(sName) Then
                    TestModuleNames.Add(sName)
                Endif
            Next
            ' If Lower(sName) = Lower(SingleTestModule) Then
            '     TestModuleNames.Add(sName)
            ' Endif
        Endif
    Next

    TestModuleNames.Sort
    ' Print "# These TestContainer will be executed:\n#\n# " & TestModuleNames.Join("\n# ") & "\n"
    Return TestModuleNames

Catch
    Assert.BailOut("Error in " & Error.Where & ": " & Error.Text)
    Quit 1

End