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

' Gambas module file

Export

'' 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


'' The static procedure Test.Main() starts tests. By default it runs all testcases in all 
'' testcontainers 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 testcontainers and testcases, separated by comma.
'' 
'' A testcontainer is a special class with the ending test. It must contain at minimum one testcase. 
'' 
'' A test case is a public sub in a test container whose name is not 
'' "Setup", "Teardown", "SetupEach" or "TeardownEach".
'' 
'' A testcontainer can be choosen by it's name, a testcase by it's testcontainers' 
'' name followed by a dot and the name of the testcase.
'' 
'' Example: Test.Main("TestWWW, TestMail.Send, TestMail.Recieve") 
'' 
'' runs all testcases in TestWWW and the testcases Send and Recieve of the testcontainer 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)

    Test._Reset() ' only if you run this Main multiple times per process, which you shouldn't
    RunTests(Tests)
    PrintSummary()

End

Private Sub PrintSummary()

    With $hPrinter.Session
        Test._Print(gb.Lf) ' better readability for humans
        Test.Note(Subst$(("Ran: '&1' "), .Summary.Description))
        If .TestsRun <> .Plan Then Test.Note(Subst$(("Planned &1 tests but ran &2"), .Plan, .TestsRun))
        Test.Note(gb.Lf)

        If Not .Summary.Success Then ShowTestCollection(("&1 tests failed:"), FindFailures(.Summary.Subtests, ""))
        ShowTestCollection(("&1 skipped:"), FindSkips(.Summary.Subtests, ""))
        ShowTestCollection(("&1 todo:"), FindTodos(.Summary.Subtests, ""))
        ShowTestCollection(("&1 bonus:"), FindBonus(.Summary.Subtests, ""))

        Test.Note(IIf(.Summary.Success, "PASSED", "FAILED"))
    End With

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, optional limited by Container or TestCaseName. Track contains .

Private Function RunTests(Tests As String)

    Dim aTestCommands As TestCommand[]
    Dim sTestModule As String
    Dim TestModule As Class
    Dim Suite As New TestSuite

    aTestCommands = TestCommand.ParseCommands(Tests)

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

    $hPrinter.Session.Summary.Description = Tests
    Suite.Run()
    If Not Test._Finished Then Test._Finish()

End

Private Function GetAllTestContainers(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))
        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 Not sNames.Exist(Command.ModuleName) Then
                    Test.BailOut(Subst$(("There is no test called &1."), Command.ModuleName))
                Endif
                If Lower(Command.ModuleName) = Lower(sName) Then
                    TestModuleNames.Add(sName)
                Endif
            Next
        Endif
    Next

    TestModuleNames.Sort

    Return TestModuleNames

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

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