438 lines
11 KiB
Text
438 lines
11 KiB
Text
' 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
|
|
|
|
'' Used to trigger Test.Main to print all tests as comma separated string.
|
|
Public Const _TRIGGER_GET_ALLTESTS As String = "#GetAllTests"
|
|
|
|
'' 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)
|
|
|
|
Dim sTestsuite As String
|
|
|
|
If Not Tests Then
|
|
'prints the names of all testmodules
|
|
PrintAllTestModules()
|
|
Return
|
|
Endif
|
|
|
|
If Tests = _TRIGGER_GET_ALLTESTS Then
|
|
Print AllTests()
|
|
Return
|
|
Endif
|
|
|
|
If Tests = "*" Then
|
|
'triggers all tests
|
|
Tests = ""
|
|
Endif
|
|
|
|
If Tests Begins "@" Then
|
|
'a test suite was called by name
|
|
sTestsuite = Tests
|
|
Tests = MTest.GetTestSuiteByName(Tests)
|
|
Endif
|
|
|
|
' run tests
|
|
Test._Reset() ' only if you run this Main multiple times per process, which you shouldn't
|
|
If Tests Then
|
|
FromString(Tests)
|
|
Endif
|
|
RunTests()
|
|
|
|
If sTestsuite Then
|
|
sTestsuite = Replace(sTestsuite, "@", "Testsuite: ")
|
|
$hPrinter.Session.Summary.Description = sTestsuite
|
|
Else
|
|
$hPrinter.Session.Summary.Description = TestCommand.ToString(TestCommand.FromString(Tests))
|
|
Endif
|
|
|
|
PrintSummary()
|
|
Quit ExitCode()
|
|
|
|
TheEnd:
|
|
Catch
|
|
Test.BailOut(Error.Text)
|
|
|
|
End
|
|
|
|
Private Sub PrintSummary()
|
|
|
|
With $hPrinter.Session
|
|
Test._Print(Null) ' 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
|
|
|
|
If Not $Suite Then
|
|
' create as Suite with all tests
|
|
$Suite = New TestSuite
|
|
For Each TestModule In GetAllTestModules()
|
|
$Suite.AddAllTestCases(TestModule)
|
|
Next
|
|
Endif
|
|
|
|
$Suite.Run()
|
|
If Not Test._Finished Then Test._Finish()
|
|
|
|
End
|
|
|
|
Private Function GetAllTestModules() As Class[]
|
|
|
|
Dim TestClass As Class
|
|
Dim TestModules As New Class[]
|
|
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))
|
|
TestModules.Add(TestClass)
|
|
Next
|
|
|
|
Return TestModules
|
|
|
|
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 aoTestModules As Class[]
|
|
Dim cAlltests As New Collection
|
|
Dim oTestModule As Class
|
|
|
|
aoTestModules = GetAllTestModules()
|
|
|
|
For Each oTestModule In aoTestModules
|
|
cAlltests.Add(TestSuite.GetTestsFromTestModule(oTestModule), oTestModule.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
|
|
|
|
'' Tell the testing system that the next assertion is a TODO. Even if it fails it reports ok, but will be reported as Todo.
|
|
Public Sub Todo(Optional Comment As String)
|
|
|
|
Test._Next.Directive = TestAssertion.TODO
|
|
Test._Next.Comment = Comment
|
|
|
|
End
|
|
|
|
'' Tell the testing system that a test is skipped. Reports ok.
|
|
Public Sub Skip(Optional Comment As String)
|
|
|
|
Test._Next.Directive = TestAssertion.SKIP
|
|
Test._Next.Comment = Comment
|
|
Assert.Pass()
|
|
|
|
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 PrintAllTestModules()
|
|
|
|
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
|
|
|
|
'Fill suite from String
|
|
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
|