gb.test.tap: New component for reading and writing TAP
[GB.TEST.TAP] * NEW: Add new component based on an old fork of gb.test.
This commit is contained in:
parent
0a63c13676
commit
787674f188
12 changed files with 851 additions and 1 deletions
4
comp/src/gb.test.tap/.component
Normal file
4
comp/src/gb.test.tap/.component
Normal file
|
@ -0,0 +1,4 @@
|
|||
[Component]
|
||||
Key=gb.test.tap
|
||||
Version=3.14.90
|
||||
Authors=(C) 2018-2020 Tobias Boege <tobias@gambas-buch.de>
|
2
comp/src/gb.test.tap/.directory
Normal file
2
comp/src/gb.test.tap/.directory
Normal file
|
@ -0,0 +1,2 @@
|
|||
[Desktop Entry]
|
||||
Icon=./.icon.png
|
BIN
comp/src/gb.test.tap/.icon.png
Normal file
BIN
comp/src/gb.test.tap/.icon.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 11 KiB |
10
comp/src/gb.test.tap/.project
Normal file
10
comp/src/gb.test.tap/.project
Normal file
|
@ -0,0 +1,10 @@
|
|||
# Gambas Project File 3.0
|
||||
Startup=Main
|
||||
Version=3.14.90
|
||||
Description="TAP producer and consumer: https://testanything.org"
|
||||
Authors="(C) 2018-2020 Tobias Boege <tobias@gambas-buch.de>"
|
||||
TabSize=4
|
||||
Translate=1
|
||||
Language=en_US
|
||||
Type=Component
|
||||
Packager=1
|
222
comp/src/gb.test.tap/.src/Assert.class
Normal file
222
comp/src/gb.test.tap/.src/Assert.class
Normal file
|
@ -0,0 +1,222 @@
|
|||
' Gambas class file
|
||||
|
||||
''' Assertions which print TAP.
|
||||
|
||||
Export
|
||||
Create Static
|
||||
|
||||
Public Struct Subtest
|
||||
Printer As TapPrinter
|
||||
Description As String
|
||||
Indent As Integer
|
||||
Success As Boolean
|
||||
' Directive to apply to the next "ok" line
|
||||
Directive As Integer
|
||||
Comment As String
|
||||
End Struct
|
||||
|
||||
Private $aActiveTests As New Subtest[]
|
||||
Private $hCurrent As New Subtest
|
||||
|
||||
Public Sub _new()
|
||||
|
||||
With $hCurrent = New Subtest
|
||||
.Printer = New TapPrinter As "Printer"
|
||||
.Indent = 0
|
||||
.Success = True
|
||||
.Directive = Tap.NONE
|
||||
End With
|
||||
|
||||
End
|
||||
|
||||
Public Sub Setup(Optional Tests As Integer, Optional Comment As String, Optional {Output} As Stream)
|
||||
|
||||
If IsMissing({Output}) Then
|
||||
{Output} = $hCurrent.Printer.Output
|
||||
If Not {Output} Then {Output} = File.Out
|
||||
Endif
|
||||
$hCurrent.Printer.Output = {Output}
|
||||
Plan(Tests, Comment)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Subtest(Description As String, Optional Tests As Integer)
|
||||
|
||||
Dim iIndent As Integer = $hCurrent.Indent
|
||||
|
||||
$aActiveTests.Push($hCurrent)
|
||||
With $hCurrent = New Subtest
|
||||
.Printer = New TapPrinter As "Printer"
|
||||
.Description = Description
|
||||
.Indent = iIndent + 1
|
||||
.Success = True
|
||||
.Directive = Tap.NONE
|
||||
End With
|
||||
If Tests Then Plan(Tests)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Finish()
|
||||
|
||||
Dim hFinished As Subtest
|
||||
|
||||
$hCurrent.Printer.Finish()
|
||||
hFinished = $hCurrent
|
||||
Try $hCurrent = $aActiveTests.Pop()
|
||||
If Not Error Then
|
||||
$hCurrent.Printer.Test(hFinished.Success,, hFinished.Description)
|
||||
Endif
|
||||
|
||||
End
|
||||
|
||||
Public Sub Printer_Filter()
|
||||
|
||||
Last.Line = String$($hCurrent.Indent, "\t") & Last.Line
|
||||
|
||||
End
|
||||
|
||||
Public Sub Plan(Tests As Integer, Optional Comment As String)
|
||||
|
||||
$hCurrent.Printer.Plan(Tests, Comment)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Ok(Result As Boolean, Optional Description As String) As Boolean
|
||||
|
||||
With $hCurrent
|
||||
If .Directive <> Tap.NONE Then
|
||||
.Printer.Test(Result,, Description, .Directive, .Comment)
|
||||
Else
|
||||
.Printer.Test(Result,, Description)
|
||||
.Success = .Success And Result
|
||||
Endif
|
||||
.Directive = Tap.NONE
|
||||
.Comment = Null
|
||||
End With
|
||||
Return Result
|
||||
|
||||
End
|
||||
|
||||
Public Sub Todo(Optional Comment As String)
|
||||
|
||||
$hCurrent.Directive = Tap.TODO
|
||||
$hCurrent.Comment = Comment
|
||||
|
||||
End
|
||||
|
||||
Public Sub Skip(Optional Comment As String)
|
||||
|
||||
$hCurrent.Directive = Tap.SKIP
|
||||
$hCurrent.Comment = Comment
|
||||
Me.Ok(True)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Diagnostic(Comment As String)
|
||||
|
||||
$hCurrent.Printer.Diagnostic(Comment)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Print({Line} As String)
|
||||
|
||||
$hCurrent.Printer.Print({Line})
|
||||
|
||||
End
|
||||
|
||||
' -------------------- High-level test functions --------------------
|
||||
|
||||
Public Sub NotOk(Result As Boolean, Optional Description As String) As Boolean
|
||||
|
||||
Return Ok(Not Result, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Equals(Got As Variant, Expected As Variant, Description As String) As Boolean
|
||||
|
||||
Return Ok(Got = Expected, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub LessEqual(Got As Variant, Bound As Variant, Description As String) As Boolean
|
||||
|
||||
Return Ok(Got <= Bound, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Less(Got As Variant, Bound As Variant, Description As String) As Boolean
|
||||
|
||||
Return Ok(Got < Bound, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub GreaterEqual(Got As Variant, Bound As Variant, Description As String) As Boolean
|
||||
|
||||
Return Ok(Got >= Bound, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Greater(Got As Variant, Bound As Variant, Description As String) As Boolean
|
||||
|
||||
Return Ok(Got > Bound, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Approximate(Got As Float, Expected As Float, Precision As Float, Description As String) As Boolean
|
||||
|
||||
Return Ok(Abs(Got - Expected) <= Precision, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub RelativeApproximate(Got As Float, Expected As Float, RelPrecision As Float, Description As String) As Boolean
|
||||
|
||||
Return Ok(Abs((Got - Expected) / Expected) <= RelPrecision, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub IsType(Got As Variant, Type As Integer, Description As String) As Boolean
|
||||
|
||||
Return Ok(TypeOf(Got) = Type, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Like(Got As String, Pattern As String, Description As String) As Boolean
|
||||
|
||||
Return Ok(Got Like Pattern, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Match(Got As String, Pattern As String, Description As String) As Boolean
|
||||
|
||||
Return Ok(Got Match Pattern, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub StringEquals(Got As String, Expected As String, Description As String) As Boolean
|
||||
|
||||
Dim bRes As Boolean
|
||||
Dim iPos As Integer
|
||||
|
||||
bRes = Equals(Got, Expected, Description)
|
||||
If Not bRes Then
|
||||
If Len(Got) <> Len(Expected) Then
|
||||
Diagnostic("Strings are of different length.")
|
||||
Diagnostic(" Got: " & Len(Got))
|
||||
Diagnostic(" Expected: " & Len(Expected))
|
||||
Endif
|
||||
For iPos = 1 To Min(Len(Got), Len(Expected))
|
||||
If Mid$(Got, iPos, 1) <> Mid$(Expected, iPos, 1) Then Break
|
||||
Next
|
||||
Diagnostic("Strings differ at position " & iPos)
|
||||
Diagnostic(" Got: " & Quote$(Mid$(Got, iPos, 20)) & IIf(Len(Got) > iPos + 20, "...", ""))
|
||||
Diagnostic(" Expected: " & Quote$(Mid$(Expected, iPos, 20)) & IIf(Len(Expected) > iPos + 20, "...", ""))
|
||||
Endif
|
||||
Return bRes
|
||||
|
||||
End
|
||||
|
||||
' Public Sub EqualsDeeply()
|
||||
'
|
||||
'
|
||||
'
|
||||
' End
|
37
comp/src/gb.test.tap/.src/Main.module
Normal file
37
comp/src/gb.test.tap/.src/Main.module
Normal file
|
@ -0,0 +1,37 @@
|
|||
' Gambas module file
|
||||
|
||||
Public Sub Main()
|
||||
|
||||
Dim hProc As Process
|
||||
Dim hHarness As New TestHarness
|
||||
|
||||
hProc = Exec ["gbx3", "-s", "SampleTest", Application.Path] For Read
|
||||
hHarness.Read(hProc, "SampleTest")
|
||||
|
||||
With hHarness.Current
|
||||
Dim sLine As String
|
||||
Print "Transcript of the TAP stream:"
|
||||
Print
|
||||
Print String$(80, "*")
|
||||
Print
|
||||
For Each sLine In .Lines
|
||||
Print sLine
|
||||
Next
|
||||
Print
|
||||
Print String$(80, "*")
|
||||
Print
|
||||
|
||||
Print "Test";; .Name;; IIf(.Success, "PASSED", "FAILED");; "("; Format$(DateDiff(.Started, .Ended, gb.Second), "0.00s"); ")"
|
||||
If .Run <> .Plan[1] Then Print "Planned";; .Plan[1];; "tests but ran";; .Run
|
||||
If .Failed Then
|
||||
Dim sFail As String
|
||||
Print "Failed";; .Failed;; "out of";; .Run;; "tests:"
|
||||
For Each sFail In .Failures
|
||||
Print sFail
|
||||
Next
|
||||
Endif
|
||||
If .BailedOut Then Print "Bailed out with message";; .BailMessage
|
||||
If .Bonus Then Print "Passed";; .Bonus;; "additional tests marked as TODO"
|
||||
End With
|
||||
|
||||
End
|
36
comp/src/gb.test.tap/.src/SampleTest.module
Normal file
36
comp/src/gb.test.tap/.src/SampleTest.module
Normal file
|
@ -0,0 +1,36 @@
|
|||
' Gambas module file
|
||||
|
||||
Public Sub Main()
|
||||
|
||||
With (Assert)
|
||||
.Plan(4)
|
||||
.Diagnostic("Starting tests!")
|
||||
|
||||
.Subtest("Comparisons", 4)
|
||||
.Greater(Now(), 0, "running after 1970")
|
||||
|
||||
.Equals(System.Charset, "UTF-8", "system is UTF-8")
|
||||
|
||||
.Diagnostic("Testing TODO directive")
|
||||
.Todo("increase precision")
|
||||
.Equals(Pi, 3.14, "Pi is 3.14")
|
||||
|
||||
.StringEquals(System.Family, "Linux", "system is Linux")
|
||||
|
||||
.Finish()
|
||||
|
||||
.Todo("See a string comparison diagnostic")
|
||||
.StringEquals(User.Home, "/home/tobias", "your home is my home")
|
||||
|
||||
.IsType( Error , gb.Boolean, "Error keyword is a Boolean here")
|
||||
|
||||
If Not Exist("/usr/bin/mountpoint") Then
|
||||
.Skip("mountpoint utility is not installed")
|
||||
Else
|
||||
Dim sCapture As String
|
||||
Exec ["/usr/bin/mountpoint", "/home"] To sCapture
|
||||
.Equals(Process.LastValue, 0, "/home is a mountpoint")
|
||||
Endif
|
||||
End With
|
||||
|
||||
End
|
9
comp/src/gb.test.tap/.src/Tap/Tap.module
Normal file
9
comp/src/gb.test.tap/.src/Tap/Tap.module
Normal file
|
@ -0,0 +1,9 @@
|
|||
' Gambas module file
|
||||
|
||||
Export
|
||||
|
||||
' Plan
|
||||
Public Const NO_PLAN As Integer = -1
|
||||
|
||||
' Directives
|
||||
Public Enum NONE = 0, TODO = 1, SKIP
|
160
comp/src/gb.test.tap/.src/Tap/TapParser.class
Normal file
160
comp/src/gb.test.tap/.src/Tap/TapParser.class
Normal file
|
@ -0,0 +1,160 @@
|
|||
' Gambas class file
|
||||
|
||||
''' Low-level parser for Test Anything Protocol ([TAP]) output.
|
||||
''' It can only be used for one test process.
|
||||
'''
|
||||
''' [TAP]: http://testanything.org/tap-specification.html
|
||||
|
||||
Export
|
||||
|
||||
Event Version(Version As Integer)
|
||||
|
||||
Event Plan(Start As Integer, {End} As Integer)
|
||||
|
||||
Event Ok(TestNr As Integer, Description As String)
|
||||
Event NotOk(TestNr As Integer, Description As String)
|
||||
Event Todo(TestNr As Integer, Comment As String)
|
||||
Event Skip(TestNr As Integer, Comment As String)
|
||||
|
||||
Event BailOut(Comment As String)
|
||||
Event Diagnostic(Comment As String)
|
||||
Event Else({Line} As String)
|
||||
|
||||
Private $iLine As Integer = 0
|
||||
Private $iTestsRun As Integer = 0
|
||||
|
||||
Public Sub Parse(TapStream As Stream)
|
||||
|
||||
While Not Eof(TapStream)
|
||||
ParseLine(TapStream.ReadLine())
|
||||
Wend
|
||||
|
||||
End
|
||||
|
||||
Public Sub ParseLine({Line} As String)
|
||||
|
||||
Dim sLine As String = {Line}
|
||||
Dim iVersion As Integer
|
||||
|
||||
Dim bResult As Boolean
|
||||
Dim iTestNr As Integer
|
||||
Dim sDescription As String
|
||||
Dim iDirective As Integer
|
||||
Dim sComment As String
|
||||
|
||||
If $iLine = 0 And If sLine Begins "TAP version " Then
|
||||
Try iVersion = CInt(Trim$(Mid$(sLine, 13)))
|
||||
' At present a "TAP version" line is always an error:
|
||||
' 1. It might not be an integer, which is an error
|
||||
' 2. A version lower than 13 is an error by the specification
|
||||
' 3. We don't support version 13 or above.
|
||||
If Error Then Error.Raise(Subst$(("Unrecognised TAP version '&1'"), Trim$(Mid$(sLine, 13))))
|
||||
If iVersion < 13 Then Error.Raise(Subst$(("Illegal TAP version '&1'"), iVersion))
|
||||
If iVersion > 12 Then Error.Raise(Subst$(("Unsupported TAP version &1"), iVersion))
|
||||
Endif
|
||||
If $iLine = 0 Then Raise Version(12)
|
||||
|
||||
If sLine Match "^\\d+..\\d+" Then
|
||||
With Scan(sLine, "*..*")
|
||||
If Not IsInteger(.[0]) Or If Not IsInteger(.[1]) Then Error.Raise(Subst$(("Couldn't extract test plan from '&1'"), sLine))
|
||||
Raise Plan(CInt(.[0]), CInt(.[1]))
|
||||
End With
|
||||
|
||||
Else If sLine Begins "ok" Or If sLine Begins "not ok" Then
|
||||
bResult = ParseTest(sLine, ByRef iTestNr, ByRef sDescription, ByRef iDirective, ByRef sComment)
|
||||
' A single line may raise two events: Ok or NotOk, depending on the result
|
||||
' and Todo or Skip or none of the two depending on the directive.
|
||||
' Use the TestNr argument to link the two when counting tests for statistics.
|
||||
If bResult Then
|
||||
Raise Ok(iTestNr, sDescription)
|
||||
Else
|
||||
Raise NotOk(iTestNr, sDescription)
|
||||
Endif
|
||||
|
||||
If iDirective = Tap.TODO Then
|
||||
Raise Todo(iTestNr, sComment)
|
||||
Else If iDirective = Tap.SKIP Then
|
||||
Raise Skip(iTestNr, sComment)
|
||||
Endif
|
||||
|
||||
Else If sLine Begins "Bail out!" Then
|
||||
Raise BailOut(Trim$(Mid$(sLine, 10)))
|
||||
|
||||
Else If sLine Begins "#" Then
|
||||
Raise Diagnostic(Trim$(Mid$(sLine, 2)))
|
||||
|
||||
Else
|
||||
Raise Else(sLine)
|
||||
Endif
|
||||
|
||||
Inc $iLine
|
||||
|
||||
End
|
||||
|
||||
Private Function ParseTest(sLine As String, ByRef TestNr As Integer, ByRef Description As String, ByRef Directive As Integer, ByRef Comment As String) As Boolean
|
||||
|
||||
Dim bResult As Boolean
|
||||
Dim aWords As String[]
|
||||
Dim sWord As String
|
||||
|
||||
' Tidy up caller's local variables
|
||||
TestNr = 0
|
||||
Description = ""
|
||||
Directive = Tap.NONE
|
||||
Comment = ""
|
||||
|
||||
Inc $iTestsRun
|
||||
|
||||
' "ok" or "not ok"
|
||||
If sLine Begins "ok" Then
|
||||
bResult = True
|
||||
sLine = Trim$(Mid$(sLine, 3))
|
||||
Else If sLine Begins "not ok"
|
||||
bResult = False
|
||||
sLine = Trim$(Mid$(sLine, 7))
|
||||
Else
|
||||
Error.Raise(Subst$(("Not a test line '&1'"), sLine))
|
||||
Endif
|
||||
|
||||
' Make sure that if a "#" occurs, it will be after a space
|
||||
sLine = Replace$(sLine, "#", " #")
|
||||
aWords = Split(sLine, " ", "", True).Reverse()
|
||||
|
||||
' TestNr
|
||||
Try sWord = aWords.Pop()
|
||||
Try TestNr = CInt(sWord)
|
||||
If Error Then
|
||||
aWords.Push(sWord)
|
||||
TestNr = $iTestsRun
|
||||
Endif
|
||||
|
||||
' Description
|
||||
While aWords.Count
|
||||
sWord = aWords.Pop()
|
||||
If sWord Begins "#" Then Break
|
||||
Description &= sWord & " "
|
||||
Wend
|
||||
Description = Trim$(Description)
|
||||
|
||||
' Directive
|
||||
If sWord Begins "#" Then
|
||||
If sWord = "#" Then
|
||||
Try sWord = aWords.Pop()
|
||||
If Error Then Error.Raise(("Premature end of directive"))
|
||||
Endif
|
||||
Select Case Lower$(sWord)
|
||||
Case "todo"
|
||||
Directive = Tap.TODO
|
||||
Case "skip"
|
||||
Directive = Tap.SKIP
|
||||
Default
|
||||
Error.Raise(Subst$(("Invalid directive '&1'"), sWord))
|
||||
End Select
|
||||
Endif
|
||||
|
||||
' Comment
|
||||
Comment = Trim$(aWords.Reverse().Join(" "))
|
||||
|
||||
Return bResult
|
||||
|
||||
End
|
157
comp/src/gb.test.tap/.src/Tap/TapPrinter.class
Normal file
157
comp/src/gb.test.tap/.src/Tap/TapPrinter.class
Normal file
|
@ -0,0 +1,157 @@
|
|||
' Gambas class file
|
||||
|
||||
''' Low-level class for planning and printing test results in Test Anything Protocol ([TAP]) format.
|
||||
'''
|
||||
''' [TAP]: http://testanything.org/tap-specification.html
|
||||
|
||||
Export
|
||||
|
||||
Event Filter
|
||||
|
||||
Property {Output} As Stream
|
||||
Property Read Planned As Integer
|
||||
Property Read Count As Integer
|
||||
Property Read Last As Integer
|
||||
Property Line As String
|
||||
|
||||
Private $hOutput As Stream
|
||||
Private $iPlan As Integer
|
||||
Private $iTestsRun As Integer
|
||||
Private $iLast As Integer
|
||||
Private $bFinished As Boolean
|
||||
Private $sLine As String
|
||||
|
||||
Public Sub _new(Optional Tests As Integer, Optional Comment As String, Optional {Output} As Stream = File.Out)
|
||||
|
||||
$hOutput = {Output}
|
||||
$iPlan = Tap.NO_PLAN
|
||||
$iTestsRun = 0
|
||||
$iLast = 0
|
||||
$bFinished = False
|
||||
If Not IsMissing(Tests) Then Plan(Tests, Comment)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Plan(Tests As Integer, Optional Comment As String)
|
||||
|
||||
If $iTestsRun Then Error.Raise(Subst$(("Too late to plan. Already ran &1 tests"), $iTestsRun))
|
||||
' TAP specification lists '1..0 # Skipped: WWW::Mechanize not installed'
|
||||
' as a valid example.
|
||||
If Tests <= Tap.NO_PLAN Then Error.Raise(("Number of tests must be non-negative"))
|
||||
$iPlan = Tests
|
||||
Print(Subst$("1..&1&2", $iPlan, IIf(Comment, " # " & Comment, "")))
|
||||
|
||||
End
|
||||
|
||||
Public Sub Finish()
|
||||
|
||||
If $iPlan > Tap.NO_PLAN Then Return ' already printed the "plan" line
|
||||
If $bFinished Then Error.Raise(("Tests already finished"))
|
||||
$iPlan = $iTestsRun
|
||||
Print("1.." & $iPlan)
|
||||
$bFinished = True
|
||||
|
||||
End
|
||||
|
||||
Public Sub Test(Result As Boolean, Optional TestNr As Integer, Optional Description As String, Optional Directive As Integer, Optional Comment As String)
|
||||
|
||||
Dim sDirective As String
|
||||
Dim sLine As String
|
||||
|
||||
If $bFinished Then Error.Raise(("Tests already finished"))
|
||||
|
||||
' It is not advised to start a description with a number token because
|
||||
' it will be interpreted as the (optional) test number. We issue a warning
|
||||
' about this but fix it anyway by always printing the TestNr before *and*
|
||||
' prefixing the Description with a dash, as is common.
|
||||
If Description Match "^[0-9]+(\\s|$)" Then
|
||||
Error Subst$(("Warning: Description '&1' should not start with a number"), Description)
|
||||
Endif
|
||||
If Description Like "*#*" Then
|
||||
Error.Raise(Subst$(("Description '&1' may not contain a '#' character"), Description))
|
||||
Endif
|
||||
|
||||
Inc $iTestsRun
|
||||
If Not TestNr Then TestNr = $iTestsRun
|
||||
$iLast = TestNr
|
||||
sLine = Subst$("&1 &2 - &3", IIf(Result, "ok", "not ok"), TestNr, Description)
|
||||
|
||||
If Not IsMissing(Directive) Then
|
||||
' Matches the values of the Enum Tap.Todo, Tap.Skip
|
||||
sDirective = Choose(Directive, "TODO", "SKIP")
|
||||
If Not sDirective Then Error.Raise(Subst$(("Unsupported directive '&1'"), Directive))
|
||||
sLine &= " # " & sDirective
|
||||
If Comment Then sLine &= " " & Comment
|
||||
Endif
|
||||
|
||||
Print(sLine)
|
||||
|
||||
End
|
||||
|
||||
Public Sub BailOut(Optional Comment As String)
|
||||
|
||||
If $bFinished Then Error.Raise(("Tests already finished"))
|
||||
Print("Bail out!" & IIf(Comment, " " & Comment, ""))
|
||||
$bFinished = True
|
||||
|
||||
End
|
||||
|
||||
Public Sub Diagnostic(Comment As String)
|
||||
|
||||
Print("# " & Comment)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Print({Line} As String)
|
||||
|
||||
Dim bCancel As Boolean
|
||||
|
||||
$sLine = {Line}
|
||||
bCancel = Raise Filter
|
||||
If bCancel Then Return
|
||||
Print #$hOutput, $sLine
|
||||
Flush #$hOutput
|
||||
|
||||
End
|
||||
|
||||
Private Function Output_Read() As Stream
|
||||
|
||||
Return $hOutput
|
||||
|
||||
End
|
||||
|
||||
Private Sub Output_Write(Value As Stream)
|
||||
|
||||
$hOutput = Value
|
||||
|
||||
End
|
||||
|
||||
Private Function Planned_Read() As Integer
|
||||
|
||||
Return $iPlan
|
||||
|
||||
End
|
||||
|
||||
Private Function Count_Read() As Integer
|
||||
|
||||
Return $iTestsRun
|
||||
|
||||
End
|
||||
|
||||
Private Function Last_Read() As Integer
|
||||
|
||||
Return $iLast
|
||||
|
||||
End
|
||||
|
||||
Private Function Line_Read() As String
|
||||
|
||||
Return $sLine
|
||||
|
||||
End
|
||||
|
||||
Private Sub Line_Write(Value As String)
|
||||
|
||||
$sLine = Value
|
||||
|
||||
End
|
213
comp/src/gb.test.tap/.src/TestHarness.class
Normal file
213
comp/src/gb.test.tap/.src/TestHarness.class
Normal file
|
@ -0,0 +1,213 @@
|
|||
' Gambas class file
|
||||
|
||||
''' Base class for a test harness. It collects statistics about the tests, inspired by perl's Test::Harness.
|
||||
|
||||
Export
|
||||
|
||||
Public Struct TestStats
|
||||
'' Name of the test
|
||||
Name As String
|
||||
'' Exit status of the test process
|
||||
ExitCode As Integer
|
||||
'' Whether the test was successful (all tests passed and at least one test was executed)
|
||||
Success As Boolean
|
||||
'' Number of run tests
|
||||
Run As Integer
|
||||
'' Difference between planned and run tests
|
||||
Delta As Integer
|
||||
'' Whether the test bailed out (aborted gracefully)
|
||||
BailedOut As Boolean
|
||||
'' If BailedOut, this contains the optional attached message
|
||||
BailMessage As String
|
||||
'' When the test started
|
||||
Started As Date
|
||||
'' When the test ended
|
||||
Ended As Date
|
||||
|
||||
'' TAP version in use
|
||||
Version As Integer
|
||||
'' Number of tests planned
|
||||
Planned As Integer
|
||||
'' Test range
|
||||
Plan As Integer[]
|
||||
'' Number of successful tests (not accounting for Todo or Skipped ones)
|
||||
Passed As Integer
|
||||
'' Number of failed tests (not accounting for Todo or Skipped ones)
|
||||
Failed As Integer
|
||||
'' Number of tested marked as to-do
|
||||
Todo As Integer
|
||||
'' Number of skipped tests
|
||||
Skipped As Integer
|
||||
'' Number of Todo tests which passed
|
||||
Bonus As Integer
|
||||
|
||||
'' Descriptions of failed tests
|
||||
Failures As String[]
|
||||
|
||||
'' A copy of the TAP stream
|
||||
Lines As String[]
|
||||
End Struct
|
||||
|
||||
Property Read Tests As TestStats[]
|
||||
Property Read Current As TestStats
|
||||
Property Read Finished As Boolean
|
||||
|
||||
Private $hProducer As Process
|
||||
Private $hParser As TapParser
|
||||
Private $aTests As New TestStats[]
|
||||
Private $hCurrent As TestStats
|
||||
Private $bLastOk As Boolean
|
||||
|
||||
Public Sub Attach(Producer As Process, Name As String)
|
||||
|
||||
$hProducer = Producer
|
||||
Object.Attach(Producer, Me, "TapStream")
|
||||
|
||||
' XXX: If a class inherits this, it can override/claim event handlers and our statistics aren't accurate.
|
||||
$hParser = New TapParser As "Parser"
|
||||
|
||||
$hCurrent = New TestStats
|
||||
$hCurrent.Name = Name
|
||||
$hCurrent.Plan = [1, 0]
|
||||
$hCurrent.Failures = New String[]
|
||||
$hCurrent.Lines = New String[]
|
||||
$hCurrent.Started = Now()
|
||||
|
||||
$aTests.Push($hCurrent)
|
||||
|
||||
' Catch
|
||||
' Debug Subst$(("Test harness failure: [&1] &2"), Error.Where, Error.Text)
|
||||
' Debug Error.Backtrace.Join("\n")
|
||||
' Error.Raise(Subst$(("Test harness failure: [&1] &2"), Error.Where, Error.Text))
|
||||
|
||||
End
|
||||
|
||||
Public Sub Wait()
|
||||
|
||||
$hProducer.Wait()
|
||||
|
||||
End
|
||||
|
||||
Public Sub Read(Producer As Process, Name As String)
|
||||
|
||||
Me.Attach(Producer, Name)
|
||||
Me.Wait()
|
||||
|
||||
End
|
||||
|
||||
Public Sub TapStream_Read()
|
||||
|
||||
Dim sLine As String = Last.ReadLine()
|
||||
|
||||
$hCurrent.Lines.Add(sLine)
|
||||
$hParser.ParseLine(sLine)
|
||||
|
||||
End
|
||||
|
||||
Public Sub TapStream_Error(Message As String)
|
||||
|
||||
Dim sLine As String
|
||||
|
||||
' Inject stderr as diagnostic messages
|
||||
For Each sLine In Split(Message, "\n")
|
||||
sLine = "# " & sLine
|
||||
$hCurrent.Lines.Add(sLine)
|
||||
$hParser.ParseLine(sLine)
|
||||
Next
|
||||
|
||||
End
|
||||
|
||||
Public Sub TapStream_Kill()
|
||||
|
||||
With $hCurrent
|
||||
.Ended = Now()
|
||||
.ExitCode = Last.Value
|
||||
.Run = .Passed + .Failed + .Todo + .Skipped
|
||||
.Delta = .Planned - .Run
|
||||
.Success = .ExitCode = 0 And .Planned > 0 And .Run = .Planned And .Failed = 0
|
||||
End With
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parser_Version(Version As Integer)
|
||||
|
||||
$hCurrent.Version = Version
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parser_Plan(Start As Integer, {End} As Integer)
|
||||
|
||||
$hCurrent.Plan = [Start, {End}]
|
||||
$hCurrent.Planned = 1 + {End} - Start
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parser_Ok(TestNr As Integer, Description As String)
|
||||
|
||||
Inc $hCurrent.Passed
|
||||
$bLastOk = True
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parser_NotOk(TestNr As Integer, Description As String)
|
||||
|
||||
Inc $hCurrent.Failed
|
||||
$hCurrent.Failures.Push(Description)
|
||||
$bLastOk = False
|
||||
|
||||
End
|
||||
|
||||
'' Undoes the last increment. Used to correct the count of passed/failed
|
||||
'' tests for Todo and Skip events.
|
||||
Private Sub UndoOk()
|
||||
|
||||
If $bLastOk Then
|
||||
Dec $hCurrent.Passed
|
||||
Else
|
||||
Dec $hCurrent.Failed
|
||||
$hCurrent.Failures.Pop()
|
||||
Endif
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parser_Todo(TestNr As Integer, Comment As String)
|
||||
|
||||
UndoOk()
|
||||
Inc $hCurrent.Todo
|
||||
If $bLastOk Then Inc $hCurrent.Bonus
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parser_Skip(TestNr As Integer, Comment As String)
|
||||
|
||||
UndoOk()
|
||||
Inc $hCurrent.Skipped
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parser_BailOut(Comment As String)
|
||||
|
||||
$hCurrent.BailedOut = True
|
||||
$hCurrent.BailMessage = Comment
|
||||
|
||||
End
|
||||
|
||||
' Diagnostic and Else messages are not handled here.
|
||||
|
||||
Private Function Tests_Read() As TestStats[]
|
||||
|
||||
Return $aTests
|
||||
|
||||
End
|
||||
|
||||
Private Function Current_Read() As TestStats
|
||||
|
||||
Return $hCurrent
|
||||
|
||||
End
|
||||
|
||||
Private Function Finished_Read() As Boolean
|
||||
|
||||
Return $hProducer.State <> Process.Running
|
||||
|
||||
End
|
|
@ -1 +1 @@
|
|||
gb.eval.highlight gb.args gb.settings gb.gui.base gb.form gb.form.stock gb.form.dialog gb.form.mdi gb.db.form gb.desktop gb.web gb.report gb.report2 gb.chart gb.mysql gb.net.smtp gb.net.pop3 gb.memcached gb.map gb.logging gb.markdown gb.media.form gb.util gb.util.web gb.form.editor gb.dbus.trayicon gb.web.form gb.web.form2 gb.form.terminal gb.term.form gb.web.feed gb.form.print gb.scanner gb.test
|
||||
gb.eval.highlight gb.args gb.settings gb.gui.base gb.form gb.form.stock gb.form.dialog gb.form.mdi gb.db.form gb.desktop gb.web gb.report gb.report2 gb.chart gb.mysql gb.net.smtp gb.net.pop3 gb.memcached gb.map gb.logging gb.markdown gb.media.form gb.util gb.util.web gb.form.editor gb.dbus.trayicon gb.web.form gb.web.form2 gb.form.terminal gb.term.form gb.web.feed gb.form.print gb.scanner gb.test.tap gb.test
|
||||
|
|
Loading…
Reference in a new issue