gambas-source-code/main/lib/test/gb.test/.src/Tap/TapParser.class

' 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
''' 
''' Supports parsing subtests as generated by TapPrinter:
''' A new subtest is announced by a "Test ..." line and the
''' whole subtest is on a new indentation level.

Event Version(Version As Integer)

Event Plan(Start As Integer, {End} As Integer, SkipAll As Boolean)
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)

' Subtest events
Event BeginSubtest(Description As String)
Event EndSubtest

Private $iLine As Integer = 0
Private $iTestsRun As Integer = 0
Private $iIndent 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 iStart, iEnd As Integer
    Dim bSkipAll As Boolean
    Dim sDescription As String
    Dim iDirective As Integer
    Dim sComment As String

    ' Subtract current subtest indentation. TapPrinter uses 2 spaces.
    If $iIndent > 0 And If Left$(sLine, 2 * $iIndent) Not Like " " Then
        Dec $iIndent
        If $iIndent > 0 And If Left$(sLine, 2 * $iIndent) Not Like " " Then Error.Raise(Subst$(("Indentation on line '&1' is malformed"), sLine))
        Raise EndSubtest
    Endif
    If $iIndent > 0 Then sLine = Right$(sLine, -2 * $iIndent)

    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
        bResult = ParsePlan(sLine, ByRef iStart, ByRef iEnd, ByRef bSkipAll)
        If Not bResult Then Error.Raise(Subst$(("Couldn't extract test plan from '&1'"), sLine))
        Raise Plan(iStart, iEnd, bSkipAll)

    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 If sLine Begins "Test " Then
        Raise BeginSubtest(Trim$(Mid$(sLine, 5)))
        Inc $iIndent

    Else
        Raise Else(sLine)
    Endif

    Inc $iLine

End

Private Function ParsePlan(sLine As String, ByRef Start As Integer, ByRef {End} As Integer, ByRef SkipAll As Boolean) As Boolean

    Dim sComment As String

    SkipAll = False
    With Scan(sLine, "*..*")
        If Not IsInteger(.[0]) Then Return False
        Start = CInt(.[0])
        If IsInteger(.[1]) Then
            {End} = CInt(.[1])
        Else If .[1] Match "^\\d+\\s*#"
            With Scan(.[1], "*#*")
                {End} = CInt(Trim$(.[0]))
                sComment = Trim$(.[1])
                If Upper$(sComment) Begins "SKIP" Then
                    SkipAll = True
                Endif
            End With
        Else
            Return False
        Endif
    End With

    Return True

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