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:
Tobias Boege 2020-02-23 15:54:16 +01:00
parent 0a63c13676
commit 787674f188
12 changed files with 851 additions and 1 deletions

View file

@ -0,0 +1,4 @@
[Component]
Key=gb.test.tap
Version=3.14.90
Authors=(C) 2018-2020 Tobias Boege <tobias@gambas-buch.de>

View file

@ -0,0 +1,2 @@
[Desktop Entry]
Icon=./.icon.png

Binary file not shown.

After

Width:  |  Height:  |  Size: 11 KiB

View 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

View 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

View 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

View 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

View 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

View 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

View 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

View 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

View file

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