gb.test: Process a TAP stream in realtime and capture stderr
[GB.TEST] * NEW: TestHarness: Don't buffer process output * NEW: The testee's stderr is converted into diagnostic messages * BUG: Remove (incorrect) usage of Error.Class from error reporting, Error.Where is sufficient * BUG: TapPrinter: Always flush output in case the process dies suddenly
This commit is contained in:
Tobias Boege
parent
3097bf1ea2
commit
33baf4da3a
4 changed files with 90 additions and 69 deletions
|
|
@ -61,8 +61,8 @@ Public Sub Main()
|
|||
Assert.Plan(1)
|
||||
|
||||
hStream = Open String TAP_INPUT For Read
|
||||
hParser = New TapParser(hStream) As "Parser"
|
||||
hParser.Parse()
|
||||
hParser = New TapParser As "Parser"
|
||||
hParser.Parse(hStream)
|
||||
Close #hStream
|
||||
|
||||
Assert.Equals($aEvents.Join("\n"), EXPECTED, "TAP Parser events")
|
||||
|
|
|
|||
|
|
@ -20,20 +20,20 @@ Event BailOut(Comment As String)
|
|||
Event Diagnostic(Comment As String)
|
||||
Event Else({Line} As String)
|
||||
|
||||
Private $hTapStream As Stream
|
||||
|
||||
Private $iLine As Integer = 0
|
||||
Private $iTestsRun As Integer = 0
|
||||
|
||||
Public Sub _new(TapStream As Stream)
|
||||
Public Sub Parse(TapStream As Stream)
|
||||
|
||||
$hTapStream = TapStream
|
||||
While Not Eof(TapStream)
|
||||
ParseLine(TapStream.ReadLine())
|
||||
Wend
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parse()
|
||||
Public Sub ParseLine({Line} As String)
|
||||
|
||||
Dim sLine As String
|
||||
Dim iLine As Integer = 0
|
||||
Dim sLine As String = {Line}
|
||||
Dim iVersion As Integer
|
||||
|
||||
Dim bResult As Boolean
|
||||
|
|
@ -42,54 +42,52 @@ Public Sub Parse()
|
|||
Dim iDirective As Integer
|
||||
Dim sComment As String
|
||||
|
||||
For Each sLine In $hTapStream.Lines
|
||||
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 $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)))
|
||||
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 Else(sLine)
|
||||
Raise NotOk(iTestNr, sDescription)
|
||||
Endif
|
||||
|
||||
Inc iLine
|
||||
Next
|
||||
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
|
||||
|
||||
|
|
|
|||
|
|
@ -34,6 +34,7 @@ Public Sub Plan(Tests As Integer, Optional Comment As String)
|
|||
$iPlan = Tests
|
||||
Print #$hOutput, "1.."; $iPlan;
|
||||
Print #$hOutput, IIf(Comment, " # " & Comment, "")
|
||||
Flush #$hOutput
|
||||
|
||||
End
|
||||
|
||||
|
|
@ -42,6 +43,7 @@ Public Sub Finish()
|
|||
If $iPlan > NO_PLAN Then Return ' already printed the "plan" line
|
||||
$iPlan = $iTestsRun
|
||||
Print #$hOutput, "1.."; $iPlan
|
||||
Flush #$hOutput
|
||||
|
||||
End
|
||||
|
||||
|
|
@ -71,24 +73,28 @@ Public Sub Test(Result As Boolean, Optional TestNr As Integer, Optional Descript
|
|||
|
||||
Print #$hOutput, Subst$("&1 &2 - &3", IIf(Result, "ok", "not ok"), TestNr, Description);
|
||||
Print #$hOutput, IIf(sDirective, Subst$(" # &1&2", sDirective, IIf(Comment, " " & Comment, "")), "")
|
||||
Flush #$hOutput
|
||||
|
||||
End
|
||||
|
||||
Public Sub BailOut(Optional Comment As String)
|
||||
|
||||
Print #$hOutput, "Bail out!";; Comment
|
||||
Flush #$hOutput
|
||||
|
||||
End
|
||||
|
||||
Public Sub Diagnostic(Comment As String)
|
||||
|
||||
Print #$hOutput, "#";; Comment
|
||||
Flush #$hOutput
|
||||
|
||||
End
|
||||
|
||||
Public Sub Print({Line} As String)
|
||||
|
||||
Print #$hOutput, {Line}
|
||||
Flush #$hOutput
|
||||
|
||||
End
|
||||
|
||||
|
|
|
|||
|
|
@ -46,6 +46,7 @@ End Struct
|
|||
Property Read Tests As TestStats[]
|
||||
Property Read Current As TestStats
|
||||
|
||||
Private $hParser As TapParser
|
||||
Private $aTests As New TestStats[]
|
||||
Private $hCurrent As TestStats
|
||||
Private $bLastOk As Boolean
|
||||
|
|
@ -60,9 +61,10 @@ End
|
|||
|
||||
Public Sub Run(Project As String, Test As String)
|
||||
|
||||
' Dim hProc As Process
|
||||
Dim sOutput As String, hStream As Stream
|
||||
Dim hParser As TapParser
|
||||
Dim hProc As Process
|
||||
|
||||
' FIXME: 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
|
||||
' TODO: Process Is Stream but what about error management when the TapParser tries to read from a crashed process?
|
||||
|
|
@ -70,28 +72,43 @@ Public Sub Run(Project As String, Test As String)
|
|||
$hCurrent.Plan = [1, 0]
|
||||
$hCurrent.Failures = New String[]
|
||||
$hCurrent.Started = Now()
|
||||
Exec ["gbx3", "-s", Test, Project] To sOutput
|
||||
hProc = Exec ["gbx3", "-s", Test, Project] For Read As "TapStream"
|
||||
hProc.Wait()
|
||||
$hCurrent.Ended = Now()
|
||||
$hCurrent.ExitCode = Process.LastValue
|
||||
|
||||
hStream = Open String sOutput For Read
|
||||
' FIXME: If a class inherits this, it can override/claim event handlers and our statistics aren't accurate.
|
||||
hParser = New TapParser(hStream) As "Parser"
|
||||
hParser.Parse()
|
||||
Close #hStream
|
||||
|
||||
' Important: Do not replace the last condition with $hCurrent.Failed = 0.
|
||||
' That wouldn't verify if all tests actually ran or if the plan was wrong.
|
||||
With $hCurrent
|
||||
.ExitCode = hProc.Value
|
||||
' Important: Do not replace the last condition with $hCurrent.Failed = 0.
|
||||
' That wouldn't verify if all tests actually ran or if the plan was wrong.
|
||||
.Success = .ExitCode = 0 And .Planned > 0 And .Passed = .Planned
|
||||
.Delta = .Planned - .Passed - .Failed - .Todo - .Skipped
|
||||
End With
|
||||
$aTests.Push($hCurrent)
|
||||
|
||||
Catch
|
||||
Debug Subst$(("Test harness failure: [&1:&2] &3"), Error.Class, Error.Where, Error.Text)
|
||||
Debug Error.Backtrace.Join("\n")
|
||||
Error.Raise(Subst$(("Test harness failure: [&1:&2] &3"), Error.Class, Error.Where, Error.Text))
|
||||
' 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 TapStream_Read()
|
||||
|
||||
Dim sLine As String = Last.ReadLine()
|
||||
|
||||
$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
|
||||
$hParser.ParseLine(sLine)
|
||||
Next
|
||||
|
||||
End
|
||||
|
||||
|
|
|
|||
Loading…
Reference in a new issue