' Gambas module file

Export

Class __Test

'' Special value for unspecified test plan
Public Const NO_PLAN As Integer = -1

Property Read _Printer As TapPrinter
Property Read _Finished As Boolean
Property _Next As TestAssertion

Private $hPrinter As New TapPrinter
Private $hNext As TestAssertion

Private $Suite As TestSuite


'' The static procedure Test.Main() starts tests. By default it runs all testmethods in all
'' testmodules ordered by name and prints the result to the console.
''
'' The optional string Tests ca be used to define a TestSuite which can be used to choose any
'' combination of testmodule and testmethod, separated by comma.
''
'' A testmodule is a special class with the ending test. It must contain at minimum one testmethod.
''
'' A testmethod is a public sub in a testmodule whose name is not
'' "_Setup", "_Teardown", "_SetupEach" or "_TeardownEach".
''
'' A testmodule can be choosen by it's name, a testmethod by it's testmodules'
'' name followed by a dot and the name of the testmethod.
''
'' Example: Test.Main("TestWWW, TestMail.Send, TestMail.Receive")
''
'' runs all testmethods in TestWWW and the testmethods Send and Receive of the testmodule TestMail.
''
'' Public methods called "_Setup", "_Teardown", "_SetupEach" or "_TeardownEach" can be used to create a testfixture,
'' which defines a special environment for the tests.

Public Sub Main(Optional Tests As String)

    If Not Tests Then
        PrintAllTests()
        Return
    Endif

    If Tests = "*" Then
        'triggers all tests
        Tests = ""
    Endif
    Test._Reset() ' only if you run this Main multiple times per process, which you shouldn't
    If Tests Then
        FromString(Tests)
    Endif
    RunTests()
    $hPrinter.Session.Summary.Description = TestCommand.ToString(TestCommand.FromString(Tests))
    PrintSummary()
    Quit ExitCode()

TheEnd:

End

Private Sub PrintSummary()

    With $hPrinter.Session
        Test._Print(gb.Lf) ' better readability for humans
        
        ' even if the tests came in unsorted, print it sorted
        Test.Note(Subst$(("Ran: '&1' "), TestCommand.ToString(TestCommand.FromString(.Summary.Description))))
        If .TestsRun <> .Plan Then Test.Note(Subst$(("Planned &1 tests but ran &2"), .Plan, .TestsRun))
        Test.Note(gb.Lf)

        ShowTestCollection(("&1 skipped:"), FindSkips(.Summary.Subtests, ""))
        ShowTestCollection(("&1 todo:"), FindTodos(.Summary.Subtests, ""))
        ShowTestCollection(("&1 bonus:"), FindBonus(.Summary.Subtests, ""))

        If Not .Summary.Success Then ShowTestCollection(("&1 tests failed:"), FindFailures(.Summary.Subtests, ""))
        Test.Note(IIf(.Summary.Success, "PASSED", "FAILED"))
    End With

End

Private Function ExitCode() As Integer

    Return IIf($hPrinter.Session.Summary.Success, 0, 1)

End

'' Prints a Collection[] of tests as returned by FindFailures, FindSkips, FindTodos.
'' _Description_ can contain '&1' which is substituted for _TestCollection_.Count.
Private Sub ShowTestCollection(Description As String, TestCollection As Collection[])

    Dim cTest As Collection

    If TestCollection.Count Then
        Test.Note(Subst$(Description, TestCollection.Count))
        For Each cTest In TestCollection
            Dim hTest As TestAssertion = cTest!Assertion
            Test.Note(Subst$(("&2: &1 -- &3 &4"), cTest["Path"], hTest.Id, hTest.Description, IIf(hTest.Comment, "# " & hTest.Comment, "")))
        Next
        Test.Note(gb.Lf)
    Endif

End

Private Function FindFailures(Tests As TestAssertion[], Prefix As String) As Collection[]

    Dim hTest As TestAssertion
    Dim sName As String
    Dim aRet As New Collection[]

    For Each hTest In Tests
        sName = Prefix &/ hTest.Description
        ' Only show the deepest subtests that caused failures.
        If Not hTest.Success And If Not hTest.Subtests.Count Then aRet.Add(["Path": Prefix, "Assertion": hTest])
        aRet.Insert(FindFailures(hTest.Subtests, sName))
    Next
    Return aRet

End

Private Function FindSkips(Tests As TestAssertion[], Prefix As String) As Collection[]

    Dim hTest As TestAssertion
    Dim sName As String
    Dim aRet As New Collection[]

    For Each hTest In Tests
        sName = Prefix &/ hTest.Description
        If hTest.Directive = TestAssertion.SKIP Then aRet.Add(["Path": Prefix, "Assertion": hTest])
        aRet.Insert(FindSkips(hTest.Subtests, sName))
    Next
    Return aRet

End

Private Function FindTodos(Tests As TestAssertion[], Prefix As String) As Collection[]

    Dim hTest As TestAssertion
    Dim sName As String
    Dim aRet As New Collection[]

    For Each hTest In Tests
        sName = Prefix &/ hTest.Description
        If hTest.Directive = TestAssertion.TODO And If Not hTest.Ok Then aRet.Add(["Path": Prefix, "Assertion": hTest])
        aRet.Insert(FindTodos(hTest.Subtests, sName))
    Next
    Return aRet

End

Private Function FindBonus(Tests As TestAssertion[], Prefix As String) As Collection[]

    Dim hTest As TestAssertion
    Dim sName As String
    Dim aRet As New Collection[]

    For Each hTest In Tests
        sName = Prefix &/ hTest.Description
        If hTest.Directive = TestAssertion.TODO And If hTest.Ok Then aRet.Add(["Path": Prefix, "Assertion": hTest])
        aRet.Insert(FindBonus(hTest.Subtests, sName))
    Next
    Return aRet

End

'' Run all tests in $Suite. If $Suite is Null, run all tests.

Private Function RunTests()

    Dim Testmodule As Class
    Dim sTestModule As String

    If Not $Suite Then
        ' create as Suite with all tests
        $Suite = New TestSuite
        For Each sTestModule In GetAllTestModules()
            TestModule = __Test.Load(sTestModule)
            $Suite.AddAllTestCases(TestModule)
        Next
    Endif

    $Suite.Run()
    If Not Test._Finished Then Test._Finish()

End

Private Function GetAllTestModules() As String[]

    Dim TestClass As Class
    Dim TestModuleNames As New String[]
    Dim sNames As New String[]
    Dim sName As String
    Dim hStat As ClassStat

    Component.Load("gb.util")

    For Each sName In Dir(".../.gambas")
        hStat = Class.Stat("..." &/ sName)
        If hStat.Test Then sNames.Add(hStat.Name)
    Next

    Assert sNames

    sNames.Sort

    For Each sName In sNames
        TestClass = __Test.Load(sName)
        If Not TestClass Then Error.Raise(Subst$(("Could not load test module '&1'"), sName))
        If TestModuleNames.Exist(sName) Then Continue
        TestModuleNames.Add(sName)
    Next

    TestModuleNames.Sort
    Return TestModuleNames

Catch
    Test.BailOut("Error in " & Error.Where & ": " & Error.Text)

End

'' Returns an collection of the testmodules and their testmethods.
'' Key is the name of the testmodule, Value is a string array with the names of the testmethods it contains

Public Function AllTestsCollection() As Collection

    Dim sModules As String[]
    Dim sModule As String
    Dim TestModule As Class
    Dim cAlltests As New Collection

    sModules = GetAllTestModules()

    For Each sModule In sModules
        TestModule = __Test.Load(sModule)
        cAlltests.Add(TestSuite.GetTestsFromTestModule(Testmodule), TestModule.Name)
    Next

    Return cAlltests

End

'' Returns a comma separated string with all tests in the same way Test.Main() wants it.

Public Function AllTests() As String

    Dim tests As Collection
    Dim asTests As String[]
    Dim asLines As New String[]
    Dim sModule As String

    tests = AllTestsCollection()

    For Each tests
        sModule = tests.Key
        asTests = tests[tests.Key]
        asTests.Sort
        If asTests.Count > 0 Then
            asLines.Add(sModule & "." & asTests.Join(";"))
        Endif
    Next

    asLines.Sort()
    Return asLines.Join(",")

End

' ------------------------------------------------- Test controls

'' Prints "Bail out!" and stops all testing immediately.
Public Sub BailOut(Optional Comment As String)

    $hPrinter.BailOut(Comment)
    Quit 1

End
'' Synonym for Note, prints Comment with leading #

Public Sub Diagnostic(Comment As String)

    $hPrinter.Diagnostic(Comment)

End
'' Synonym for Diagnostic, prints Comment with leading #

Public Sub Note(Comment As String)

    $hPrinter.Note(Comment)

End
'' Prints Line to Stdout

Public Sub _Print({Line} As String)

    $hPrinter.Print({Line})

End

Private Function _Printer_Read() As TapPrinter

    Return $hPrinter

End

Private Function _Finished_Read() As Boolean

    Return $hPrinter.Session.Finished

End

Public Sub _Reset()

    $hPrinter = New TapPrinter As "Printer"

End

Private Function _Next_Read() As TestAssertion

    If $hNext = Null Then
        $hNext = New TestAssertion
    Endif
    Return $hNext

End

Private Sub _Next_Write(Value As TestAssertion)

    $hNext = Value

End

Public Sub _Subtest(Description As String, Optional Tests As Integer, Optional Comment As String)

    Test._Printer.Subtest(Description, Tests, Comment)

End

Public Sub Plan(Tests As Integer, Optional Comment As String)

    Test._Printer.Plan(Tests, Comment)

End

Public Sub SkipAll(Optional Comment As String)

    Test._Printer.SkipAll(Comment)

End

Public Sub _Finish()

    Test._Printer.Finish()

End

Private Sub PrintAllTests()

    Dim sName As String
    Dim hStat As ClassStat
    Dim aTest As New String[]

    Component.Load("gb.util")

    For Each sName In Dir(".../.gambas")
        hStat = Class.Stat("..." &/ sName)
        If hStat.Test Then aTest.Add(hStat.Name)
    Next
    
    Print aTest.Join();

End
Private Sub FromString(Tests As String)

    Dim Commands As TestCommand[]
    Dim Command As TestCommand
    Dim TestModule As Class
    Dim sName As String

    Commands = TestCommand.FromString(Tests)
    
    $Suite = New TestSuite

    For Each Command In Commands
        With Command
            TestModule = __Test.Load(.ModuleName)
            If Command.Methods.Count = 0 Then
                Command.Methods = $Suite.GetTestsFromTestModule(TestModule)
            Endif
            For Each sName In Command.Methods
                $Suite.AddTestCase(sName, Testmodule)
            Next
        End With
    Next

End