' 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