5004f20609
[INTERPRETER] * NEW: Remove the now useless testing specific code. * NEW: 'gbx3 -T' now just loads the 'gb.test' component and calls Test.Main() passing it the '-T' option argument. [GB.TEST] * NEW: Move 'gb.test' sources in '/main/lib'. * NEW: 'gb.test' has now a part written in C that allows him to load project classes on demand.
141 lines
4 KiB
Text
141 lines
4 KiB
Text
' 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
|
|
|
|
Event Version(Version As Integer)
|
|
|
|
Event Plan(Start As Integer, {End} As Integer)
|
|
Event Assert(Ok As Boolean, Id As Long, Description As String, Directive 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 iId As Long
|
|
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)
|
|
|
|
' TODO: This cannot parse SkipAll tests.
|
|
If sLine Match "^\\d+..\\d+" Then
|
|
With Scan(sLine, "*..*")
|
|
If Not IsLong(.[0]) Or If Not IsLong(.[1]) Then Error.Raise(Subst$(("Couldn't extract test plan from '&1'"), sLine))
|
|
Raise Plan(CLong(.[0]), CLong(.[1]))
|
|
End With
|
|
|
|
Else If sLine Begins "ok" Or If sLine Begins "not ok" Then
|
|
bResult = ParseTest(sLine, ByRef iId, ByRef sDescription, ByRef iDirective, ByRef sComment)
|
|
Raise Assert(bResult, iId, sDescription, iDirective, sComment)
|
|
|
|
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 Id As Long, 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
|
|
Id = 0
|
|
Description = ""
|
|
Directive = TestAssertion.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()
|
|
|
|
' Test ID
|
|
Try sWord = aWords.Pop()
|
|
Try Id = CLong(sWord)
|
|
If Error Then
|
|
aWords.Push(sWord)
|
|
Id = $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 = TestAssertion.TODO
|
|
Case "skip"
|
|
Directive = TestAssertion.SKIP
|
|
Default
|
|
Error.Raise(Subst$(("Invalid directive '&1'"), sWord))
|
|
End Select
|
|
Endif
|
|
|
|
' Comment
|
|
Comment = Trim$(aWords.Reverse().Join(" "))
|
|
|
|
Return bResult
|
|
|
|
End
|