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.
135 lines
3.1 KiB
Text
135 lines
3.1 KiB
Text
' Gambas module file
|
|
|
|
''' Lists tests, Run tests, parse output and collect statistics.
|
|
|
|
Export
|
|
|
|
Private $hParser As TapParser
|
|
Private $hStats As TestStats
|
|
|
|
'' Returns all tests in a project given by path
|
|
Public Sub List(Project As String) As TestCommand[]
|
|
|
|
Dim sTests As String
|
|
Dim cmd As String
|
|
|
|
'triggers gb.test inside a project to inspect
|
|
'the project and return all tests inside as string
|
|
cmd = "/usr/bin/gbx3 -T '" & Test._TRIG_GETTESTS & "' " & Project
|
|
Shell cmd To sTests
|
|
|
|
If sTests Begins "Bail out!" Then
|
|
Error.Raise(Subst("gb.test crashed with this error: &1", sTests))
|
|
Endif
|
|
|
|
Return TestCommand.FromString(sTests)
|
|
|
|
End
|
|
|
|
'' Runs Tests in a project given by path
|
|
|
|
Public Sub Run(Project As String, Optional Tests As String) As TestStats
|
|
|
|
Dim hProc As Process
|
|
|
|
$hParser = New TapParser As "Parser"
|
|
With $hStats = New TestStats
|
|
.Name = Subst$(("&1 - &2"), Project, Tests)
|
|
.Plan = [1, 0]
|
|
.Started = Now()
|
|
End With
|
|
|
|
' Run the tests. Meanwhile the parser emits events which we handle to fill $hStats.
|
|
hProc = Exec ["gbx3", "-T", Tests, Project] For Input As "TapStream"
|
|
hProc.Wait()
|
|
|
|
With $hStats
|
|
.Ended = Now()
|
|
.ExitCode = hProc.Value
|
|
.Run = .Passed + .Failed + .Todo + .Skipped
|
|
.Delta = .Planned - .Run
|
|
.Success = .ExitCode = 0 And .Planned > 0 And .Run = .Planned And .Failed = 0
|
|
End With
|
|
Return $hStats
|
|
|
|
End
|
|
|
|
' -------------------- From TapStream to Parser --------------------
|
|
|
|
Private Sub AddLine(sLine As String)
|
|
|
|
$hStats.Lines.Add(sLine)
|
|
$hParser.ParseLine(sLine)
|
|
|
|
End
|
|
|
|
Public Sub TapStream_Read()
|
|
|
|
AddLine(Last.ReadLine())
|
|
|
|
End
|
|
|
|
Public Sub TapStream_Error(Message As String)
|
|
|
|
AddLine(Message)
|
|
|
|
End
|
|
|
|
' -------------------- From Parser to $hStats --------------------
|
|
|
|
Public Sub Parser_Version(Version As Integer)
|
|
|
|
$hStats.Version = Version
|
|
|
|
End
|
|
|
|
Public Sub Parser_Plan(Start As Integer, {End} As Integer)
|
|
|
|
$hStats.Plan = [Start, {End}]
|
|
$hStats.Planned = 1 + {End} - Start
|
|
|
|
End
|
|
|
|
' FIXME: It is an error if the test IDs are not sequential, according to prove.
|
|
' TODO: Subtests as produced by TapPrinter are not supported yet.
|
|
|
|
Public Sub Parser_Assert(Ok As Boolean, Id As Long, Description As String, Directive As Integer, Comment As String)
|
|
|
|
Dim hTest As New TestAssertion
|
|
|
|
With hTest
|
|
.Ok = Ok
|
|
.Id = Id
|
|
.Description = Description
|
|
.Directive = Directive
|
|
.Comment = Comment
|
|
End With
|
|
$hStats.Subtests.Push(hTest)
|
|
|
|
With $hStats
|
|
Select Case Directive
|
|
Case TestAssertion.NONE
|
|
If hTest.Success Then
|
|
Inc .Passed
|
|
Else
|
|
Inc .Failed
|
|
Endif
|
|
|
|
Case TestAssertion.TODO
|
|
Inc .Todo
|
|
If hTest.Success Then Inc .Bonus
|
|
|
|
Case TestAssertion.SKIP
|
|
Inc .Skipped
|
|
|
|
End Select
|
|
End With
|
|
|
|
End
|
|
|
|
Public Sub Parser_BailOut(Comment As String)
|
|
|
|
$hStats.BailedOut = True
|
|
$hStats.BailMessage = Comment
|
|
|
|
End
|