' 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