Compare commits
88 commits
Author | SHA1 | Date | |
---|---|---|---|
|
eaad6a640f | ||
|
7e1a24bc81 | ||
|
0c151bc812 | ||
|
5e171d5a1c | ||
|
1ed40b6c85 | ||
|
5613b9920d | ||
|
bf0e19c514 | ||
|
78ade59842 | ||
|
33baf4da3a | ||
|
3097bf1ea2 | ||
|
7dbb378ffb | ||
|
f30a3c1834 | ||
|
9a3ea3e4cb | ||
|
43fc4a56b2 | ||
|
4c695dc703 | ||
|
2e3a5aeb62 | ||
|
3681e003d6 | ||
|
6a90351e0d | ||
|
1c2d0b4d8e | ||
|
888e880c23 | ||
|
0929707aee | ||
|
2d591f341b | ||
|
80127af1c2 | ||
|
4a8c8c7efb | ||
|
129ff730a6 | ||
|
d96cd5c673 | ||
|
9d038cd8ed | ||
|
c5f1321f96 | ||
|
2904638697 | ||
|
f702aea4b1 | ||
|
9d851fc246 | ||
|
cd287cd68c | ||
|
74d2429fcc | ||
|
8e5baa5ce2 | ||
|
aaac105af8 | ||
|
ca3915fee0 | ||
|
715f8db1f0 | ||
|
85ac4a215c | ||
|
6041de65c9 | ||
|
cf84b875a4 | ||
|
8897198360 | ||
|
4c3c6222b4 | ||
|
e7de647892 | ||
|
cac2ef2a48 | ||
|
c7a274c7e2 | ||
|
6eb4dfe79a | ||
|
bca845af25 | ||
|
f8b3299971 | ||
|
fc7d05e679 | ||
|
4218805297 | ||
|
855d6e5473 | ||
|
515f28ac64 | ||
|
5be88f560b | ||
|
63b199dd70 | ||
|
da1ffe4091 | ||
|
afeda37c26 | ||
|
a4a12e1847 | ||
|
f911ca9072 | ||
|
cda14cd4d2 | ||
|
19a611cdc9 | ||
|
706ebc526b | ||
|
32563d94d3 | ||
|
2846f93fb4 | ||
|
f54d453b06 | ||
|
81782e1873 | ||
|
52d8c6d092 | ||
|
e4c5de85f7 | ||
|
54d915b487 | ||
|
4a77b3cb85 | ||
|
c476645823 | ||
|
f2126059c4 | ||
|
f28180617f | ||
|
81deebac76 | ||
|
032c1629ff | ||
|
f461e03d5d | ||
|
592111d922 | ||
|
e95524da23 | ||
|
1072a5b74f | ||
|
24d3897126 | ||
|
44442850b0 | ||
|
71fc541075 | ||
|
d135f97b1f | ||
|
66ff21de85 | ||
|
5f8eff8314 | ||
|
cff5d60fbb | ||
|
5111def64b | ||
|
38ca7e56f1 | ||
|
e2da39e818 |
23 changed files with 1648 additions and 0 deletions
5
comp/src/gb.test/.component
Normal file
5
comp/src/gb.test/.component
Normal file
|
@ -0,0 +1,5 @@
|
|||
[Component]
|
||||
Key=gb.test
|
||||
Version=3.11.90
|
||||
State=2
|
||||
Authors=Christof Thalhofer,Tobias Boege
|
2
comp/src/gb.test/.directory
Normal file
2
comp/src/gb.test/.directory
Normal file
|
@ -0,0 +1,2 @@
|
|||
[Desktop Entry]
|
||||
Icon=./.icon.png
|
17
comp/src/gb.test/.gitignore
vendored
Normal file
17
comp/src/gb.test/.gitignore
vendored
Normal file
|
@ -0,0 +1,17 @@
|
|||
#---- Gambas files to ignore (v4)
|
||||
*.gambas
|
||||
.lock
|
||||
*~
|
||||
core
|
||||
core.*
|
||||
vgcore
|
||||
vgcore.*
|
||||
.kdbg*
|
||||
.*.prof
|
||||
.lang/*.pot
|
||||
.gambas/*
|
||||
.settings
|
||||
.info
|
||||
.list
|
||||
.startup
|
||||
#----
|
6
comp/src/gb.test/.hidden/AUTHORS
Normal file
6
comp/src/gb.test/.hidden/AUTHORS
Normal file
|
@ -0,0 +1,6 @@
|
|||
Initially forked and inspired from COMUnit (http://comunit.sourceforge.net), which was inspired by JUnit, by Christof Thalhofer.
|
||||
Later ported to a TAP (https://testanything.org/) architecture by Tobias Boege.
|
||||
|
||||
Contributors in order of appearance:
|
||||
- Christof Thalhofer
|
||||
- Tobias Boege
|
BIN
comp/src/gb.test/.icon.png
Normal file
BIN
comp/src/gb.test/.icon.png
Normal file
Binary file not shown.
After Width: | Height: | Size: 10 KiB |
BIN
comp/src/gb.test/.lang/de.mo
Normal file
BIN
comp/src/gb.test/.lang/de.mo
Normal file
Binary file not shown.
99
comp/src/gb.test/.lang/de.po
Normal file
99
comp/src/gb.test/.lang/de.po
Normal file
|
@ -0,0 +1,99 @@
|
|||
#, fuzzy
|
||||
msgid ""
|
||||
msgstr ""
|
||||
"Project-Id-Version: gb.deg.unittest 3.9.2\n"
|
||||
"PO-Revision-Date: 2017-08-12 17:41 UTC\n"
|
||||
"Last-Translator: christof <christof@deganius.de>\n"
|
||||
"Language: de\n"
|
||||
"MIME-Version: 1.0\n"
|
||||
"Content-Type: text/plain; charset=UTF-8\n"
|
||||
"Content-Transfer-Encoding: 8bit\n"
|
||||
|
||||
#: .project:1
|
||||
msgid "gb.deg.unittest"
|
||||
msgstr "gb.deg.unittest"
|
||||
|
||||
#: .project:2
|
||||
msgid "A Gambas component for unittesting and test-driven programming. Forked and inspired from a quite old program: COMUnit (http://comunit.sourceforge.net) and mainly JUnit.\n\nAlpha state! Works good, but a project which uses a library which needs gb.deg.unittest requires to install gb.deg.unittest in the project also.\n\nIntended to be integrated into the Gambas IDE later on.\n\nLicense GPL V2"
|
||||
msgstr "Eine Gambas Komponente für Unittests und testgesteuerte Entwicklung. Inspiriert von einem älteren Programm: COMUnit (http://comunit.sourceforge.net) und hauptsächlich JUnit.\n\nImmer noch Alpha! Funktioniert hervorragend, aber ein Projekt, das eine \n\nBibliothek benutzt, die wiederum mit gb.deg.unittest getestet wird, benötigt ebenfalls die Installation dieser Komponente.\n\n\n\nDieses Projekt ist für die spätere Integration in Gambas.\n\nLizenz GPL V2"
|
||||
|
||||
#: FmRunner.class:89
|
||||
msgid "All Test Containers"
|
||||
msgstr "Alle Testcontainer"
|
||||
|
||||
#: FmRunner.class:108
|
||||
msgid "All Test Cases"
|
||||
msgstr "Alle Tests"
|
||||
|
||||
#: FmRunner.class:150
|
||||
msgid "Results"
|
||||
msgstr "Ergebnis"
|
||||
|
||||
#: FmRunner.class:168
|
||||
msgid "Trace"
|
||||
msgstr "Ablauf"
|
||||
|
||||
#: FmRunner.form:28
|
||||
msgid "Containers:"
|
||||
msgstr "Container:"
|
||||
|
||||
#: FmRunner.form:39
|
||||
msgid "Tests:"
|
||||
msgstr "Tests:"
|
||||
|
||||
#: FmRunner.form:63
|
||||
msgid "Run Tests (Ctrl-r)"
|
||||
msgstr "Starte Tests (Ctrl-r)"
|
||||
|
||||
#: FmRunner.form:72
|
||||
msgid "Press <Esc> to close"
|
||||
msgstr "Beenden mit <Esc>"
|
||||
|
||||
#: UnitTest.class:52
|
||||
msgid "--------------------------------- Test Result ----------------------------------"
|
||||
msgstr "-------------------------------- Testergebnis ----------------------------------"
|
||||
|
||||
#: UnitTest.class:53
|
||||
msgid "Tests done"
|
||||
msgstr "Tests beendet"
|
||||
|
||||
#: UnitTest.class:55
|
||||
msgid "--------------------------------------------------------------------------------"
|
||||
msgstr "--------------------------------------------------------------------------------"
|
||||
|
||||
#: UnitTest.class:58
|
||||
msgid "Error in:"
|
||||
msgstr "Fehler in:"
|
||||
|
||||
#: UnitTest.class:59
|
||||
msgid "Error:"
|
||||
msgstr "Fehler:"
|
||||
|
||||
#: UnitTest.class:62
|
||||
msgid "No Errors"
|
||||
msgstr "Keine Errors"
|
||||
|
||||
#: UnitTest.class:67
|
||||
msgid "Failure in:"
|
||||
msgstr "Fehlschlag in:"
|
||||
|
||||
#: UnitTest.class:68
|
||||
msgid "Failure:"
|
||||
msgstr "Fehlschlag:"
|
||||
|
||||
#: UnitTest.class:71
|
||||
msgid "No Failures"
|
||||
msgstr "Keine Fehlschläge"
|
||||
|
||||
#: UnitTest.class:73
|
||||
msgid "--------------------------------- Test End -----------------------------------"
|
||||
msgstr "--------------------------------- Ende Test -----------------------------------"
|
||||
|
||||
#: UnitTest.class:75
|
||||
msgid "Success!"
|
||||
msgstr "Erfolgreich!"
|
||||
|
||||
#: UnitTest.class:77
|
||||
msgid "Not successful... :-("
|
||||
msgstr "Nicht erfolgreich ... :-("
|
||||
|
13
comp/src/gb.test/.project
Normal file
13
comp/src/gb.test/.project
Normal file
|
@ -0,0 +1,13 @@
|
|||
# Gambas Project File 3.0
|
||||
Title=gb.test
|
||||
Startup=Tester
|
||||
Version=3.11.90
|
||||
Description="Unit testing component"
|
||||
Authors="Christof Thalhofer\nTobias Boege"
|
||||
TabSize=4
|
||||
Translate=1
|
||||
Language=en_US
|
||||
Type=Component
|
||||
Vendor=gb
|
||||
License=General Public License
|
||||
Packager=1
|
221
comp/src/gb.test/.src/Assert.class
Normal file
221
comp/src/gb.test/.src/Assert.class
Normal file
|
@ -0,0 +1,221 @@
|
|||
' Gambas class file
|
||||
|
||||
''' Assertions which print TAP.
|
||||
|
||||
Export
|
||||
Create Static
|
||||
|
||||
Public Struct Subtest
|
||||
Printer As TapPrinter
|
||||
Description As String
|
||||
Indent As Integer
|
||||
Success As Boolean
|
||||
' Directive to apply to the next "ok" line
|
||||
Directive As Integer
|
||||
Comment As String
|
||||
End Struct
|
||||
|
||||
Private $aActiveTests As New Subtest[]
|
||||
Private $hCurrent As New Subtest
|
||||
|
||||
Public Sub _new()
|
||||
|
||||
With $hCurrent = New Subtest
|
||||
.Printer = New TapPrinter As "Printer"
|
||||
.Indent = 0
|
||||
.Success = True
|
||||
.Directive = Tap.NONE
|
||||
End With
|
||||
|
||||
End
|
||||
|
||||
Public Sub Setup(Optional Tests As Integer, Optional Comment As String, Optional {Output} As Stream)
|
||||
|
||||
If IsMissing({Output}) Then
|
||||
{Output} = $hCurrent.Printer.Output
|
||||
If Not {Output} Then {Output} = File.Out
|
||||
Endif
|
||||
$hCurrent.Printer.Output = {Output}
|
||||
Plan(Tests, Comment)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Subtest(Description As String, Optional Tests As Integer)
|
||||
|
||||
Dim iIndent As Integer = $hCurrent.Indent
|
||||
|
||||
$aActiveTests.Push($hCurrent)
|
||||
With $hCurrent = New Subtest
|
||||
.Printer = New TapPrinter As "Printer"
|
||||
.Description = Description
|
||||
.Indent = iIndent + 1
|
||||
.Success = True
|
||||
.Directive = Tap.NONE
|
||||
End With
|
||||
If Tests Then Plan(Tests)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Finish()
|
||||
|
||||
Dim hFinished As Subtest
|
||||
|
||||
$hCurrent.Printer.Finish()
|
||||
hFinished = $hCurrent
|
||||
Try $hCurrent = $aActiveTests.Pop()
|
||||
If Not Error Then
|
||||
$hCurrent.Printer.Test(hFinished.Success,, hFinished.Description)
|
||||
Endif
|
||||
|
||||
End
|
||||
|
||||
Public Sub Printer_Filter()
|
||||
|
||||
Last.Line = String$($hCurrent.Indent, "\t") & Last.Line
|
||||
|
||||
End
|
||||
|
||||
Public Sub Plan(Tests As Integer, Optional Comment As String)
|
||||
|
||||
$hCurrent.Printer.Plan(Tests, Comment)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Ok(Result As Boolean, Optional Description As String) As Boolean
|
||||
|
||||
With $hCurrent
|
||||
If .Directive <> Tap.NONE Then
|
||||
.Printer.Test(Result,, Description, .Directive, .Comment)
|
||||
Else
|
||||
.Printer.Test(Result,, Description)
|
||||
.Success = .Success And Result
|
||||
Endif
|
||||
.Directive = Tap.NONE
|
||||
.Comment = Null
|
||||
End With
|
||||
Return Result
|
||||
|
||||
End
|
||||
|
||||
Public Sub Todo(Optional Comment As String)
|
||||
|
||||
$hCurrent.Directive = Tap.TODO
|
||||
$hCurrent.Comment = Comment
|
||||
|
||||
End
|
||||
|
||||
Public Sub Skip(Optional Comment As String)
|
||||
|
||||
$hCurrent.Directive = Tap.SKIP
|
||||
$hCurrent.Comment = Comment
|
||||
|
||||
End
|
||||
|
||||
Public Sub Diagnostic(Comment As String)
|
||||
|
||||
$hCurrent.Printer.Diagnostic(Comment)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Print({Line} As String)
|
||||
|
||||
$hCurrent.Printer.Print({Line})
|
||||
|
||||
End
|
||||
|
||||
' -------------------- High-level test functions --------------------
|
||||
|
||||
Public Sub NotOk(Result As Boolean, Optional Description As String) As Boolean
|
||||
|
||||
Return Ok(Not Result, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Equals(Got As Variant, Expected As Variant, Description As String) As Boolean
|
||||
|
||||
Return Ok(Got = Expected, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub LessEqual(Got As Variant, Bound As Variant, Description As String) As Boolean
|
||||
|
||||
Return Ok(Got <= Bound, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Less(Got As Variant, Bound As Variant, Description As String) As Boolean
|
||||
|
||||
Return Ok(Got < Bound, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub GreaterEqual(Got As Variant, Bound As Variant, Description As String) As Boolean
|
||||
|
||||
Return Ok(Got >= Bound, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Greater(Got As Variant, Bound As Variant, Description As String) As Boolean
|
||||
|
||||
Return Ok(Got > Bound, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Approximate(Got As Float, Expected As Float, Precision As Float, Description As String) As Boolean
|
||||
|
||||
Return Ok(Abs(Got - Expected) <= Precision, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub RelativeApproximate(Got As Float, Expected As Float, RelPrecision As Float, Description As String) As Boolean
|
||||
|
||||
Return Ok(Abs((Got - Expected) / Expected) <= RelPrecision, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub IsType(Got As Variant, Type As Integer, Description As String) As Boolean
|
||||
|
||||
Return Ok(TypeOf(Got) = Type, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Like(Got As String, Pattern As String, Description As String) As Boolean
|
||||
|
||||
Return Ok(Got Like Pattern, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Match(Got As String, Pattern As String, Description As String) As Boolean
|
||||
|
||||
Return Ok(Got Match Pattern, Description)
|
||||
|
||||
End
|
||||
|
||||
Public Sub StringEquals(Got As String, Expected As String, Description As String) As Boolean
|
||||
|
||||
Dim bRes As Boolean
|
||||
Dim iPos As Integer
|
||||
|
||||
bRes = Equals(Got, Expected, Description)
|
||||
If Not bRes Then
|
||||
If Len(Got) <> Len(Expected) Then
|
||||
Diagnostic("Strings are of different length.")
|
||||
Diagnostic(" Got: " & Len(Got))
|
||||
Diagnostic(" Expected: " & Len(Expected))
|
||||
Endif
|
||||
For iPos = 1 To Min(Len(Got), Len(Expected))
|
||||
If Mid$(Got, iPos, 1) <> Mid$(Expected, iPos, 1) Then Break
|
||||
Next
|
||||
Diagnostic("Strings differ at position " & iPos)
|
||||
Diagnostic(" Got: " & Quote$(Mid$(Got, iPos, 20)) & IIf(Len(Got) > iPos + 20, "...", ""))
|
||||
Diagnostic(" Expected: " & Quote$(Mid$(Expected, iPos, 20)) & IIf(Len(Expected) > iPos + 20, "...", ""))
|
||||
Endif
|
||||
Return bRes
|
||||
|
||||
End
|
||||
|
||||
' Public Sub EqualsDeeply()
|
||||
'
|
||||
'
|
||||
'
|
||||
' End
|
25
comp/src/gb.test/.src/SelfTest/TestAsserts.module
Normal file
25
comp/src/gb.test/.src/SelfTest/TestAsserts.module
Normal file
|
@ -0,0 +1,25 @@
|
|||
' Gambas module file
|
||||
|
||||
Public Sub Main()
|
||||
|
||||
Assert.Setup(11)
|
||||
|
||||
Assert.Ok(True, "True is ok")
|
||||
Assert.NotOk(False, "False is not ok")
|
||||
|
||||
Assert.Equals(7 * 6, 42, "Multiplication")
|
||||
Assert.Todo("We might need JIT")
|
||||
Assert.Less(Timer, 0.1, "Gambas is sufficiently fast")
|
||||
Assert.Approximate(0.555555, 0.555556, 1e-6, "Float absolute error")
|
||||
Assert.Skip("Intentionally wrong")
|
||||
Assert.RelativeApproximate(0.5555555, 0.5555565, 1e-6, "Float relative error")
|
||||
Assert.RelativeApproximate(0.5555555, 0.5555565, 1e-5, "Float relative error")
|
||||
|
||||
Assert.IsType(CStr(42), gb.String, "CStr returns a String")
|
||||
|
||||
Assert.Like("test@gambas-basic.org", "*@*", "LIKE email address")
|
||||
Assert.Match("test@gambas-basic.org", "^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\\.[a-zA-Z0-9-.]+$", "MATCH email address")
|
||||
' TODO: Do we need "Not" variants for all assertions...?
|
||||
Assert.NotOk("???@gambas-basic.org" Match "^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\\.[a-zA-Z0-9-.]+$", "not MATCH email address")
|
||||
|
||||
End
|
25
comp/src/gb.test/.src/SelfTest/TestCrash.module
Normal file
25
comp/src/gb.test/.src/SelfTest/TestCrash.module
Normal file
|
@ -0,0 +1,25 @@
|
|||
' Gambas module file
|
||||
|
||||
Private Const EXPECTED As String = ""
|
||||
"1..1\n"
|
||||
"# This is intended to fail\n"
|
||||
"# _Crash.Main.7: Like this Debug statement, the division by zero error should be captured and converted to a diagnostic\n"
|
||||
"# _Crash.Main.9: #26: Division by zero\n"
|
||||
"# _Crash.Main.9 \n"
|
||||
"# "
|
||||
|
||||
Public Sub Main()
|
||||
|
||||
Dim hHarness As New TestHarness
|
||||
|
||||
Assert.Setup(6)
|
||||
hHarness.Run(Application.Path, "_Crash")
|
||||
With hHarness.Current
|
||||
Assert.Equals(.ExitCode, 1, "exit code")
|
||||
Assert.Equals(.Planned, 1, "planned 1 test")
|
||||
Assert.Equals(.Run, 0, "none run")
|
||||
Assert.Equals(.Passed, 0, "none passed")
|
||||
Assert.Equals(.Failed, 0, "none failed")
|
||||
Assert.StringEquals(.Lines.Join("\n"), EXPECTED, "complete diagnostics")
|
||||
End With
|
||||
End
|
11
comp/src/gb.test/.src/SelfTest/TestCrash/_Crash.module
Normal file
11
comp/src/gb.test/.src/SelfTest/TestCrash/_Crash.module
Normal file
|
@ -0,0 +1,11 @@
|
|||
' Gambas module file
|
||||
|
||||
Public Sub Main()
|
||||
|
||||
Assert.Setup(1)
|
||||
Assert.Diagnostic("This is intended to fail")
|
||||
Debug "Like this Debug statement, the division by zero error should be captured and converted to a diagnostic"
|
||||
Assert.Skip("0 is not invertible in the Integers")
|
||||
Assert.IsType(1 / 0, gb.Integer, "Division by zero")
|
||||
|
||||
End
|
26
comp/src/gb.test/.src/SelfTest/TestSubtest.module
Normal file
26
comp/src/gb.test/.src/SelfTest/TestSubtest.module
Normal file
|
@ -0,0 +1,26 @@
|
|||
' Gambas module file
|
||||
|
||||
Private Const EXPECTED As String = ""
|
||||
"1..2\n"
|
||||
"\t1..3\n"
|
||||
"\tok 1 - Now is around Now\n"
|
||||
"\tok 2 - Now is a date\n"
|
||||
"\tok 3 - It is past 1970\n"
|
||||
"ok 1 - TestMethod1\n"
|
||||
"\t1..2\n"
|
||||
"\t\t1..2\n"
|
||||
"\t\tok 1 - 2 > -1\n"
|
||||
"\t\tok 2 - 2 is around -1\n"
|
||||
"\tok 1 - a subtest\n"
|
||||
"\tok 2 - True\n"
|
||||
"ok 2 - TestMethod2\n"
|
||||
|
||||
Public Sub Main()
|
||||
|
||||
Dim sOut As String
|
||||
|
||||
Assert.Plan(1)
|
||||
Exec ["gbx3", "-s", "_Subtest", Application.Path] To sOut
|
||||
Assert.StringEquals(sOut, EXPECTED, "Subtest printer")
|
||||
|
||||
End
|
37
comp/src/gb.test/.src/SelfTest/TestSubtest/_Subtest.module
Normal file
37
comp/src/gb.test/.src/SelfTest/TestSubtest/_Subtest.module
Normal file
|
@ -0,0 +1,37 @@
|
|||
' Gambas module file
|
||||
|
||||
Public Sub Main()
|
||||
|
||||
' TODO: This is a template for how the TestHarness should call test methods!
|
||||
Assert.Plan(2)
|
||||
|
||||
Assert.Subtest("TestMethod1")
|
||||
TestMethod1()
|
||||
Assert.Finish()
|
||||
|
||||
Assert.Subtest("TestMethod2")
|
||||
TestMethod2()
|
||||
Assert.Finish()
|
||||
|
||||
End
|
||||
|
||||
Public Sub TestMethod1()
|
||||
|
||||
Assert.Plan(3)
|
||||
Assert.Approximate(Now, Now, 1e-1, "Now is around Now")
|
||||
Assert.IsType(Now, gb.Date, "Now is a date")
|
||||
Assert.GreaterEqual(Now, Date(1970), "It is past 1970")
|
||||
|
||||
End
|
||||
|
||||
Public Sub TestMethod2()
|
||||
|
||||
Assert.Plan(2)
|
||||
|
||||
Assert.Subtest("a subtest", 2)
|
||||
Assert.Greater(2, -1, "2 > -1")
|
||||
Assert.Approximate(2, -1, 10, "2 is around -1")
|
||||
Assert.Finish()
|
||||
Assert.Ok(True, "True")
|
||||
|
||||
End
|
105
comp/src/gb.test/.src/SelfTest/TestTapParser.module
Normal file
105
comp/src/gb.test/.src/SelfTest/TestTapParser.module
Normal file
|
@ -0,0 +1,105 @@
|
|||
' Gambas module file
|
||||
|
||||
' TODO: These should be in external files.
|
||||
|
||||
Private Const TAP_INPUT As String = ""
|
||||
"ok - created Board\n"
|
||||
"ok\n"
|
||||
"ok - message\n"
|
||||
"ok 17\n"
|
||||
"ok\n"
|
||||
"ok\n"
|
||||
"not ok - gladly it's todo # TODO test\n"
|
||||
"# +------+------+------+------+\n"
|
||||
"# | |16G | |05C |\n"
|
||||
"# | |G N C | |C C G |\n"
|
||||
"# | | G | | C +|\n"
|
||||
"# +------+------+------+------+\n"
|
||||
"# |10C |01G | |03C |\n"
|
||||
"# |R N G |G A G | |C C C |\n"
|
||||
"# | R | G | | C +|\n"
|
||||
"# +------+------+------+------+\n"
|
||||
"# | |01G |17C |00C |\n"
|
||||
"# | |G A G |G N R |R N R |\n"
|
||||
"# | | G | R | G |\n"
|
||||
"# +------+------+------+------+\n"
|
||||
"ok - board has 7 tiles + starter tile\n"
|
||||
"1..8"
|
||||
|
||||
Private Const EXPECTED As String = ""
|
||||
"TAP version 12\n"
|
||||
"OK(1) - created Board\n"
|
||||
"OK(2) \n"
|
||||
"OK(3) - message\n"
|
||||
"OK(17) \n"
|
||||
"OK(5) \n"
|
||||
"OK(6) \n"
|
||||
"NOTOK(7) - gladly it's todo\n"
|
||||
"TODO(7) test\n"
|
||||
"DIAG +------+------+------+------+\n"
|
||||
"DIAG | |16G | |05C |\n"
|
||||
"DIAG | |G N C | |C C G |\n"
|
||||
"DIAG | | G | | C +|\n"
|
||||
"DIAG +------+------+------+------+\n"
|
||||
"DIAG |10C |01G | |03C |\n"
|
||||
"DIAG |R N G |G A G | |C C C |\n"
|
||||
"DIAG | R | G | | C +|\n"
|
||||
"DIAG +------+------+------+------+\n"
|
||||
"DIAG | |01G |17C |00C |\n"
|
||||
"DIAG | |G A G |G N R |R N R |\n"
|
||||
"DIAG | | G | R | G |\n"
|
||||
"DIAG +------+------+------+------+\n"
|
||||
"OK(8) - board has 7 tiles + starter tile\n"
|
||||
"PLAN(1,8)"
|
||||
|
||||
Private $aEvents As New String[]
|
||||
|
||||
Public Sub Main()
|
||||
Dim hStream As Stream
|
||||
Dim hParser As TapParser
|
||||
|
||||
Assert.Plan(1)
|
||||
|
||||
hStream = Open String TAP_INPUT For Read
|
||||
hParser = New TapParser As "Parser"
|
||||
hParser.Parse(hStream)
|
||||
Close #hStream
|
||||
|
||||
Assert.Equals($aEvents.Join("\n"), EXPECTED, "TAP Parser events")
|
||||
End
|
||||
|
||||
Public Sub Parser_Ok(TestNr As Integer, Description As String)
|
||||
$aEvents.Push(Subst$("OK(&1) &2", TestNr, Description))
|
||||
End
|
||||
|
||||
Public Sub Parser_NotOk(TestNr As Integer, Description As String)
|
||||
$aEvents.Push(Subst$("NOTOK(&1) &2", TestNr, Description))
|
||||
End
|
||||
|
||||
Public Sub Parser_Todo(TestNr As Integer, Comment As String)
|
||||
$aEvents.Push(Subst$("TODO(&1) &2", TestNr, Comment))
|
||||
End
|
||||
|
||||
Public Sub Parser_Skip(TestNr As Integer, Comment As String)
|
||||
$aEvents.Push(Subst$("SKIP(&1) &2", TestNr, Comment))
|
||||
End
|
||||
|
||||
Public Sub Parser_Version(Version As Integer)
|
||||
$aEvents.Push(Subst$("TAP version &1", Version))
|
||||
End
|
||||
|
||||
Public Sub Parser_Plan(Start As Integer, {End} As Integer)
|
||||
$aEvents.Push(Subst$("PLAN(&1,&2)", Start, {End}))
|
||||
End
|
||||
|
||||
Public Sub Parser_BailOut(Comment As String)
|
||||
$aEvents.Push(Subst$("BAIL &1", Comment))
|
||||
End
|
||||
|
||||
Public Sub Parser_Diagnostic(Comment As String)
|
||||
$aEvents.Push(Subst$("DIAG &1", Comment))
|
||||
End
|
||||
|
||||
Public Sub Parser_Else({Line} As String)
|
||||
$aEvents.Push(Subst$("ELSE &1", {Line}))
|
||||
End
|
31
comp/src/gb.test/.src/SelfTest/TestTapPrinter.module
Normal file
31
comp/src/gb.test/.src/SelfTest/TestTapPrinter.module
Normal file
|
@ -0,0 +1,31 @@
|
|||
' Gambas module file
|
||||
|
||||
' TODO: This should go into a file which is ignored when packaging the project.
|
||||
Private Const EXPECTED As String = ""
|
||||
"1..4\n"
|
||||
"# Testing TAP printer\n"
|
||||
"ok 1 - \n"
|
||||
"ok 2 - True is true\n"
|
||||
"not ok 3 - False is true # SKIP This is impossible\n"
|
||||
"# Omitting a test intentionally\n"
|
||||
|
||||
Public Sub Main()
|
||||
Dim hStream As Stream
|
||||
Dim hPrinter As TapPrinter
|
||||
Dim sTap As String
|
||||
|
||||
Assert.Plan(1)
|
||||
|
||||
hStream = Open String For Write
|
||||
hPrinter = New TapPrinter(4, "", hStream)
|
||||
hPrinter.Diagnostic("Testing TAP printer")
|
||||
hPrinter.Test(12 = 12)
|
||||
hPrinter.Test(True,, "True is true")
|
||||
hPrinter.Test(False,, "False is true", Tap.SKIP, "This is impossible")
|
||||
hPrinter.Diagnostic("Omitting a test intentionally")
|
||||
hPrinter.Finish()
|
||||
sTap = Close #hStream
|
||||
|
||||
Assert.Equals(sTap, EXPECTED, "TAP output")
|
||||
|
||||
End
|
9
comp/src/gb.test/.src/Tap/Tap.module
Normal file
9
comp/src/gb.test/.src/Tap/Tap.module
Normal file
|
@ -0,0 +1,9 @@
|
|||
' Gambas module file
|
||||
|
||||
Export
|
||||
|
||||
' Plan
|
||||
Public Const NO_PLAN As Integer = -1
|
||||
|
||||
' Directives
|
||||
Public Enum NONE = 0, TODO = 1, SKIP
|
172
comp/src/gb.test/.src/Tap/TapParser.class
Normal file
172
comp/src/gb.test/.src/Tap/TapParser.class
Normal file
|
@ -0,0 +1,172 @@
|
|||
' 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
|
||||
|
||||
Export
|
||||
|
||||
Event Version(Version As Integer)
|
||||
|
||||
Event Plan(Start As Integer, {End} As Integer)
|
||||
|
||||
Event Ok(TestNr As Integer, Description As String)
|
||||
Event NotOk(TestNr As Integer, Description As String)
|
||||
Event Todo(TestNr As Integer, Comment As String)
|
||||
Event Skip(TestNr 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 iTestNr As Integer
|
||||
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)
|
||||
|
||||
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)))
|
||||
|
||||
Else
|
||||
Raise Else(sLine)
|
||||
Endif
|
||||
|
||||
Inc $iLine
|
||||
|
||||
End
|
||||
|
||||
' This pattern works in perl but not in gb.pcre... So doing it by hand below.
|
||||
' Dim rTest As RegExp
|
||||
' Try rTest = New RegExp(sLine, Replace$("(ok|not ok)WS(\\d+WS)?([^#]+WS)?(?:#\\s*((?i)TODO|SKIP(?-i))WS(.*)?)?", "WS", "(?:\\s+|$)"))
|
||||
' Inc $iTestsRun
|
||||
' Try TestNr = CInt(rTest[2].Text)
|
||||
' If Error Then TestNr = $iTestsRun
|
||||
' Description = rTest[3].Text
|
||||
' Directive = IIf(rTest[4].Text, IIf(Upper$(rTest[4].Text) = "TODO", Tap.TODO, Tap.SKIP), Tap.NONE)
|
||||
' Comment = rTest[5].Text
|
||||
'
|
||||
' Return rTest[1].Text = "ok"
|
||||
|
||||
Private Function ParseTest(sLine As String, ByRef TestNr As Integer, 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
|
||||
TestNr = 0
|
||||
Description = ""
|
||||
Directive = Tap.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()
|
||||
|
||||
' TestNr
|
||||
Try sWord = aWords.Pop()
|
||||
Try TestNr = CInt(sWord)
|
||||
If Error Then
|
||||
aWords.Push(sWord)
|
||||
TestNr = $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 = Tap.TODO
|
||||
Case "skip"
|
||||
Directive = Tap.SKIP
|
||||
Default
|
||||
Error.Raise(Subst$(("Invalid directive '&1'"), sWord))
|
||||
End Select
|
||||
Endif
|
||||
|
||||
' Comment
|
||||
Comment = Trim$(aWords.Reverse().Join(" "))
|
||||
|
||||
Return bResult
|
||||
|
||||
End
|
153
comp/src/gb.test/.src/Tap/TapPrinter.class
Normal file
153
comp/src/gb.test/.src/Tap/TapPrinter.class
Normal file
|
@ -0,0 +1,153 @@
|
|||
' Gambas class file
|
||||
|
||||
''' Low-level class for planning and printing test results in Test Anything Protocol ([TAP]) format.
|
||||
'''
|
||||
''' [TAP]: http://testanything.org/tap-specification.html
|
||||
|
||||
Export
|
||||
|
||||
Event Filter
|
||||
|
||||
Property {Output} As Stream
|
||||
Property Read Planned As Integer
|
||||
Property Read Count As Integer
|
||||
Property Read Last As Integer
|
||||
Property Line As String
|
||||
|
||||
Private $hOutput As Stream
|
||||
Private $iPlan As Integer
|
||||
Private $iTestsRun As Integer
|
||||
Private $iLast As Integer
|
||||
Private $bFinished As Boolean
|
||||
Private $sLine As String
|
||||
|
||||
Public Sub _new(Optional Tests As Integer, Optional Comment As String, Optional {Output} As Stream = File.Out)
|
||||
|
||||
$hOutput = {Output}
|
||||
$iPlan = Tap.NO_PLAN
|
||||
$iTestsRun = 0
|
||||
$iLast = 0
|
||||
$bFinished = False
|
||||
If Not IsMissing(Tests) Then Plan(Tests, Comment)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Plan(Tests As Integer, Optional Comment As String)
|
||||
|
||||
If $iTestsRun Then Error.Raise(Subst$(("Tests already started, at test #&1"), $iTestsRun))
|
||||
' TAP specification lists '1..0 # Skipped: WWW::Mechanize not installed'
|
||||
' as a valid example.
|
||||
If Tests <= Tap.NO_PLAN Then Error.Raise(("Number of tests must be non-negative"))
|
||||
$iPlan = Tests
|
||||
Print(Subst$("1..&1&2", $iPlan, IIf(Comment, " # " & Comment, "")))
|
||||
|
||||
End
|
||||
|
||||
Public Sub Finish()
|
||||
|
||||
If $iPlan > Tap.NO_PLAN Then Return ' already printed the "plan" line
|
||||
If $bFinished Then Error.Raise(("Tests already finished"))
|
||||
$iPlan = $iTestsRun
|
||||
Print("1.." & $iPlan)
|
||||
$bFinished = True
|
||||
|
||||
End
|
||||
|
||||
Public Sub Test(Result As Boolean, Optional TestNr As Integer, Optional Description As String, Optional Directive As Integer, Optional Comment As String)
|
||||
|
||||
Dim sDirective As String
|
||||
Dim sLine As String
|
||||
|
||||
' It is not advised to start a description with a number token because
|
||||
' it will be interpreted as the (optional) test number. We issue a warning
|
||||
' about this but fix it anyway by always printing the TestNr before *and*
|
||||
' prefixing the Description with a dash, as is common.
|
||||
If Description Match "^[0-9]+(\\s|$)" Then
|
||||
Error Subst$(("Warning: Description '&1' should not start with a number"), Description)
|
||||
Endif
|
||||
If Description Like "*#*" Then
|
||||
Error.Raise(Subst$(("Description '&1' may not contain a '#' character"), Description))
|
||||
Endif
|
||||
|
||||
Inc $iTestsRun
|
||||
If Not TestNr Then TestNr = $iTestsRun
|
||||
$iLast = TestNr
|
||||
sLine = Subst$("&1 &2 - &3", IIf(Result, "ok", "not ok"), TestNr, Description)
|
||||
|
||||
If Not IsMissing(Directive) Then
|
||||
' Matches the values of the Enum Tap.Todo, Tap.Skip
|
||||
sDirective = Choose(Directive, "TODO", "SKIP")
|
||||
If Not sDirective Then Error.Raise(Subst$(("Unsupported directive '&1'"), Directive))
|
||||
sLine &= " # " & sDirective
|
||||
If Comment Then sLine &= " " & Comment
|
||||
Endif
|
||||
|
||||
Print(sLine)
|
||||
|
||||
End
|
||||
|
||||
Public Sub BailOut(Optional Comment As String)
|
||||
|
||||
Print("Bail out!" & IIf(Comment, " " & Comment, ""))
|
||||
|
||||
End
|
||||
|
||||
Public Sub Diagnostic(Comment As String)
|
||||
|
||||
Print("# " & Comment)
|
||||
|
||||
End
|
||||
|
||||
Public Sub Print({Line} As String)
|
||||
|
||||
Dim bCancel As Boolean
|
||||
|
||||
$sLine = {Line}
|
||||
bCancel = Raise Filter
|
||||
If bCancel Then Return
|
||||
Print #$hOutput, $sLine
|
||||
Flush #$hOutput
|
||||
|
||||
End
|
||||
|
||||
Private Function Output_Read() As Stream
|
||||
|
||||
Return $hOutput
|
||||
|
||||
End
|
||||
|
||||
Private Sub Output_Write(Value As Stream)
|
||||
|
||||
$hOutput = Value
|
||||
|
||||
End
|
||||
|
||||
Private Function Planned_Read() As Integer
|
||||
|
||||
Return $iPlan
|
||||
|
||||
End
|
||||
|
||||
Private Function Count_Read() As Integer
|
||||
|
||||
Return $iTestsRun
|
||||
|
||||
End
|
||||
|
||||
Private Function Last_Read() As Integer
|
||||
|
||||
Return $iLast
|
||||
|
||||
End
|
||||
|
||||
Private Function Line_Read() As String
|
||||
|
||||
Return $sLine
|
||||
|
||||
End
|
||||
|
||||
Private Sub Line_Write(Value As String)
|
||||
|
||||
$sLine = Value
|
||||
|
||||
End
|
201
comp/src/gb.test/.src/TestHarness.class
Normal file
201
comp/src/gb.test/.src/TestHarness.class
Normal file
|
@ -0,0 +1,201 @@
|
|||
' Gambas class file
|
||||
|
||||
''' Base class for a test harness. It collects statistics about the tests, inspired by perl's Test::Harness.
|
||||
|
||||
Export
|
||||
|
||||
Public Struct TestStats
|
||||
'' Name of the test
|
||||
Name As String
|
||||
'' Exit status of the test process
|
||||
ExitCode As Integer
|
||||
'' Whether the test was successful (all tests passed and at least one test was executed)
|
||||
Success As Boolean
|
||||
'' Number of run tests
|
||||
Run As Integer
|
||||
'' Difference between planned and run tests
|
||||
Delta As Integer
|
||||
'' Whether the test bailed out (aborted gracefully)
|
||||
BailedOut As Boolean
|
||||
'' If BailedOut, this contains the optional attached message
|
||||
BailMessage As String
|
||||
'' When the test started
|
||||
Started As Date
|
||||
'' When the test ended
|
||||
Ended As Date
|
||||
|
||||
'' TAP version in use
|
||||
Version As Integer
|
||||
'' Number of tests planned
|
||||
Planned As Integer
|
||||
'' Test range
|
||||
Plan As Integer[]
|
||||
'' Number of successful tests (not accounting for Todo or Skipped ones)
|
||||
Passed As Integer
|
||||
'' Number of failed tests (not accounting for Todo or Skipped ones)
|
||||
Failed As Integer
|
||||
'' Number of tested marked as to-do
|
||||
Todo As Integer
|
||||
'' Number of skipped tests
|
||||
Skipped As Integer
|
||||
'' Number of Todo tests which passed
|
||||
Bonus As Integer
|
||||
|
||||
'' Descriptions of failed tests
|
||||
Failures As String[]
|
||||
|
||||
'' A copy of the TAP stream
|
||||
Lines As String[]
|
||||
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
|
||||
|
||||
Public Sub RunAll(Project As String)
|
||||
|
||||
' TODO: How to reliably find all classes in a project that are unit tests? Conventions?
|
||||
Error.Raise(("NYI"))
|
||||
' Then iterate over tests, re-initialising the parser for every TAP stream.
|
||||
|
||||
End
|
||||
|
||||
Public Sub Run(Project As String, Test As String)
|
||||
|
||||
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?
|
||||
$hCurrent.Name = Test
|
||||
$hCurrent.Plan = [1, 0]
|
||||
$hCurrent.Failures = New String[]
|
||||
$hCurrent.Lines = New String[]
|
||||
$hCurrent.Started = Now()
|
||||
hProc = Exec ["gbx3", "-s", Test, Project] For Read As "TapStream"
|
||||
hProc.Wait()
|
||||
$hCurrent.Ended = Now()
|
||||
|
||||
With $hCurrent
|
||||
.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
|
||||
$aTests.Push($hCurrent)
|
||||
|
||||
' 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()
|
||||
|
||||
$hCurrent.Lines.Add(sLine)
|
||||
$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
|
||||
$hCurrent.Lines.Add(sLine)
|
||||
$hParser.ParseLine(sLine)
|
||||
Next
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parser_Version(Version As Integer)
|
||||
|
||||
$hCurrent.Version = Version
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parser_Plan(Start As Integer, {End} As Integer)
|
||||
|
||||
$hCurrent.Plan = [Start, {End}]
|
||||
$hCurrent.Planned = 1 + {End} - Start
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parser_Ok(TestNr As Integer, Description As String)
|
||||
|
||||
Inc $hCurrent.Passed
|
||||
$bLastOk = True
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parser_NotOk(TestNr As Integer, Description As String)
|
||||
|
||||
Inc $hCurrent.Failed
|
||||
$hCurrent.Failures.Push(Description)
|
||||
$bLastOk = False
|
||||
|
||||
End
|
||||
|
||||
'' Undoes the last increment.
|
||||
'' FIXME: This relies on an implementation detail of TapParser: a Todo or Skip event
|
||||
'' is always raised immediately after the Ok or NotOk event for that test.
|
||||
'' More properly, we would use the TestNr argument to determine which one to undo.
|
||||
Private Sub UndoOk()
|
||||
|
||||
If $bLastOk Then
|
||||
Dec $hCurrent.Passed
|
||||
Else
|
||||
Dec $hCurrent.Failed
|
||||
$hCurrent.Failures.Pop()
|
||||
Endif
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parser_Todo(TestNr As Integer, Comment As String)
|
||||
|
||||
UndoOk()
|
||||
Inc $hCurrent.Todo
|
||||
If $bLastOk Then Inc $hCurrent.Bonus
|
||||
' TODO: Add TestStats.Todos As String[], but list Description and Comment?
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parser_Skip(TestNr As Integer, Comment As String)
|
||||
|
||||
UndoOk()
|
||||
Inc $hCurrent.Skipped
|
||||
' TODO: Add TestStats.Skips As String[], but list Description and Comment?
|
||||
|
||||
End
|
||||
|
||||
Public Sub Parser_BailOut(Comment As String)
|
||||
|
||||
$hCurrent.BailedOut = True
|
||||
$hCurrent.BailMessage = Comment
|
||||
|
||||
End
|
||||
|
||||
' Diagnostic and Else messages are not handled here.
|
||||
|
||||
Private Function Tests_Read() As TestStats[]
|
||||
|
||||
Return $aTests
|
||||
|
||||
End
|
||||
|
||||
Private Function Current_Read() As TestStats
|
||||
|
||||
Return $hCurrent
|
||||
|
||||
End
|
46
comp/src/gb.test/.src/Tester.module
Normal file
46
comp/src/gb.test/.src/Tester.module
Normal file
|
@ -0,0 +1,46 @@
|
|||
' Gambas module file
|
||||
|
||||
Public Sub Main()
|
||||
|
||||
Dim hHarness As New TestHarness
|
||||
Dim sClass As String
|
||||
Dim iTest As Integer = 1
|
||||
Dim sFail As String
|
||||
|
||||
Dim iGood, iBad As Integer = 0
|
||||
|
||||
' TODO: Get a proper API from the interpreter(?) to list tests.
|
||||
For Each sClass In Dir("./.src/SelfTest", "*.module")
|
||||
hHarness.Run(Application.Path, File.BaseName(sClass))
|
||||
With hHarness.Current
|
||||
Print "Test #";; iTest; ":";; hHarness.Current.Name
|
||||
Print "Planned tests:";; .Planned
|
||||
Print "Run tests: ";; .Run
|
||||
Print "Exit code: ";; .ExitCode
|
||||
Print "Duration: ";; DateDiff(.Started, .Ended, gb.Second); "s"
|
||||
Print String$(20, "-")
|
||||
Print "Passed tests: ";; .Passed
|
||||
Print "Failed tests: ";; .Failed
|
||||
Print "Skipped tests:";; .Skipped
|
||||
Print "To-do tests: ";; .Todo
|
||||
Print "Bonus: ";; .Bonus
|
||||
For Each sFail In .Failures
|
||||
Print "Failure: ";; sFail
|
||||
Next
|
||||
Print "Status: ";;
|
||||
If .Success Then
|
||||
Print "PASSED"
|
||||
Inc iGood
|
||||
Else
|
||||
Print "FAILED"
|
||||
Inc iBad
|
||||
Endif
|
||||
End With
|
||||
Print String$(40, "*")
|
||||
Inc iTest
|
||||
Next
|
||||
|
||||
Print "Summary:"
|
||||
Print "Good:";; iGood; ",";; "Bad:";; iBad
|
||||
|
||||
End
|
10
comp/src/gb.test/TODO
Normal file
10
comp/src/gb.test/TODO
Normal file
|
@ -0,0 +1,10 @@
|
|||
* Integration into the IDE with bells and whistles and a command-line tool for automated testing
|
||||
* Compiler and interpreter support for test classes (list them), fixtures and data files (do not include them in installable packages)
|
||||
* Internal and external (wiki) documentation, test how-to
|
||||
* Test ourselves, including how well we interface with other TAP software
|
||||
|
||||
* More assertion convenience functions, use diagnostic messages to detail test failures for the user (Test::Differences in perl5)
|
||||
* Subtest support (see http://search.cpan.org/~exodist/Test-Simple-1.302136/lib/Test/More.pm)
|
||||
* Where is that in the TAP specification? Can they be nested arbitrarily?
|
||||
|
||||
* Get us listed on https://testanything.org
|
434
comp/src/gb.test/UnitTest.class
Normal file
434
comp/src/gb.test/UnitTest.class
Normal file
|
@ -0,0 +1,434 @@
|
|||
' Gambas class file
|
||||
|
||||
Export
|
||||
|
||||
'' Runs the Unittest and prints the result to the console. Optional limited to one testclass and/or one testmethod.
|
||||
|
||||
Static Public Sub Run(Optional ContainerName As String, Optional CaseName As String, Optional ShowDebug As Boolean, Optional DoSelfTest As Boolean)
|
||||
|
||||
Dim Res As New TestResult
|
||||
Dim Suite As TestSuite
|
||||
|
||||
Suite = RunTests(Res, ContainerName, CaseName, ShowDebug, DoSelfTest)
|
||||
PrintTapResult(Suite, Res)
|
||||
|
||||
'Return Suite
|
||||
|
||||
End
|
||||
|
||||
'' Prints a result as TAP
|
||||
'' https://testanything.org
|
||||
|
||||
Static Private Sub PrintTapResult(Suite As TestSuite, Res As TestResult)
|
||||
|
||||
Dim i As Integer = 1
|
||||
Dim Errs As TestErrors
|
||||
Dim Fails As TestErrors
|
||||
Dim Err As TestError
|
||||
Dim Fail As TestError
|
||||
Dim Test As TestCase
|
||||
Dim sName As String
|
||||
Dim NotOk As Boolean
|
||||
Dim sDesc As String
|
||||
Dim FailedNumbers As New String[]
|
||||
Dim sFailedNumbers As String
|
||||
|
||||
'TS.Run(Res)
|
||||
Errs = Res.Errors
|
||||
Fails = Res.Failures
|
||||
|
||||
Print "1.." & Suite.Tests.Count
|
||||
|
||||
For Each Test In Suite.Tests
|
||||
sName = Test.Name
|
||||
|
||||
Fail = Null
|
||||
GoSub FindFailureForName
|
||||
|
||||
Err = Null
|
||||
GoSub FindErrorForName
|
||||
|
||||
If Fail = Null And If Err = Null Then
|
||||
Print "ok " & i & " " & sName
|
||||
Endif
|
||||
|
||||
Inc i
|
||||
Next
|
||||
|
||||
Goto TheEnd
|
||||
|
||||
FindFailureForName:
|
||||
|
||||
For Each Fail In Fails.items
|
||||
If Fail.TestCase.Name = sName Then
|
||||
sDesc = Null
|
||||
If Fail.Description Then
|
||||
sDesc = " " & Fail.Description
|
||||
Endif
|
||||
Print "not ok " & i & " " & sName & sDesc
|
||||
NotOk = True
|
||||
FailedNumbers.Add(i)
|
||||
Break
|
||||
Else
|
||||
Fail = Null
|
||||
Endif
|
||||
Next
|
||||
Return
|
||||
|
||||
FindErrorForName:
|
||||
|
||||
For Each Err In Errs.items
|
||||
If Err.TestCase.Name = sName Then
|
||||
sDesc = Null
|
||||
If err.Description Then
|
||||
sDesc = " " & Err.Description
|
||||
Endif
|
||||
Print "not ok " & i & " " & sName & sDesc
|
||||
NotOk = True
|
||||
FailedNumbers.Add(i)
|
||||
Break
|
||||
Else
|
||||
err = Null
|
||||
Endif
|
||||
Next
|
||||
Return
|
||||
|
||||
'Return
|
||||
|
||||
TheEnd:
|
||||
|
||||
If FailedNumbers.Count > 0 Then
|
||||
sFailedNumbers = FailedNumbers.Join(",")
|
||||
Endif
|
||||
|
||||
If NotOk = True Then
|
||||
Print ""
|
||||
Print "# Failed tests " & sFailedNumbers
|
||||
Print "# ------- " & "No success! -------"
|
||||
Else
|
||||
Print ""
|
||||
Print "# ------- " & "Success! -------"
|
||||
Endif
|
||||
|
||||
End
|
||||
|
||||
' '' Prints a result.
|
||||
' Static Private Sub PrintResult(Suite As TestSuite, Res As TestResult)
|
||||
'
|
||||
' Dim Errs As TestErrors
|
||||
' Dim Fails As TestErrors
|
||||
' Dim Err As TestError
|
||||
' Dim Fail As TestError
|
||||
' ' Dim C As Class
|
||||
'
|
||||
' 'TS.Run(Res)
|
||||
' Errs = Res.Errors
|
||||
' Fails = Res.Failures
|
||||
'
|
||||
' Print ("--------------------------------- Test Result ----------------------------------")
|
||||
' Print " " & res.CountRunnedTests & " " & ("Tests done")
|
||||
' '80 Zeichen
|
||||
' Print ("--------------------------------------------------------------------------------")
|
||||
' If Errs.Count > 0 Then
|
||||
' For Each Err In Errs.Items
|
||||
' Print " " & ("Error in:");; Err.Source
|
||||
' Print " " & ("Error:");; Err.Description
|
||||
' Next
|
||||
' Else
|
||||
' Print " " & ("No Errors")
|
||||
' Endif
|
||||
' Print "\n"
|
||||
' If Fails.Count > 0 Then
|
||||
' For Each Fail In Fails.Items
|
||||
' Print " " & ("Failure in:");; Fail.Source
|
||||
' Print " " & ("Failure:");; Fail.Description
|
||||
' Next
|
||||
' Else
|
||||
' Print " " & ("No Failures")
|
||||
' Endif
|
||||
' Print ("--------------------------------- Test End -----------------------------------")
|
||||
' If res.WasSuccessful = True Then
|
||||
' Print " " & ("Success!")
|
||||
' Else
|
||||
' Print " " & ("Not successful... :-(")
|
||||
' Endif
|
||||
'
|
||||
' End
|
||||
|
||||
'' Run all tests, optional limited by Container or TestCaseName. TestResult contains .
|
||||
Static Private Function RunTests(Result As TestResult, Optional ContainerName As String, Optional CaseName As String, Optional ShowDebug As Boolean, Optional DoSelfTest As Boolean) As TestSuite
|
||||
|
||||
Dim Container As UnitTest
|
||||
Dim Suite As New TestSuite
|
||||
|
||||
If ContainerName = Null Then
|
||||
If CaseName = Null Then
|
||||
For Each ContainerName In UnitTest.GetAllTestContainerNames(DoSelfTest)
|
||||
Container = Object.New(ContainerName)
|
||||
Suite.AddAllTestCases(Container)
|
||||
Next
|
||||
Endif
|
||||
Else
|
||||
Container = Object.New(ContainerName)
|
||||
If CaseName = Null Then
|
||||
Suite.AddAllTestCases(Container)
|
||||
Else
|
||||
Suite.AddNewTestCase(CaseName, Container)
|
||||
Endif
|
||||
Endif
|
||||
|
||||
Suite.Run(Result, ShowDebug)
|
||||
Return Suite
|
||||
|
||||
End
|
||||
|
||||
' Static Public Function GetAllTestContainerNamesOld(Optional DoSelfTest As Boolean) As String[]
|
||||
'
|
||||
' Dim ret As New String[]
|
||||
' Dim C As Class
|
||||
'
|
||||
' For Each C In Classes
|
||||
' If C.Parent Then
|
||||
' If C.Parent.Name = "UnitTest" Then
|
||||
' If C.Exist("constDegUnittestSelftest") = True And DoSelfTest = True Then
|
||||
' ret.add(C.Name)
|
||||
' Else If C.Exist("constDegUnittestSelftest") = False Then
|
||||
' ret.add(C.Name)
|
||||
' Endif
|
||||
' Endif
|
||||
' Endif
|
||||
' Next
|
||||
' ret.Sort()
|
||||
'
|
||||
' Return ret
|
||||
'
|
||||
' End
|
||||
|
||||
Static Public Function GetAllTestContainerNames(Optional DoSelfTest As Boolean) As String[]
|
||||
|
||||
Dim hFile As File
|
||||
Dim sLine As String
|
||||
Dim TestClass As Class
|
||||
Dim TestContainernames As New String[]
|
||||
Dim strClassnames As String[]
|
||||
Dim strName As String
|
||||
|
||||
If DoSelfTest = False Then
|
||||
strClassnames = Dir("../.gambas")
|
||||
Else
|
||||
strClassnames = Dir(".gambas")
|
||||
Endif
|
||||
|
||||
For Each strName In strClassnames
|
||||
If Left(Lower(strName), Len("d8e8")) = "d8e8" Then
|
||||
If DoSelfTest = True Then
|
||||
If Not TestContainernames.Exist(strName) Then
|
||||
TestContainernames.Add(strName)
|
||||
Endif
|
||||
Endif
|
||||
Else
|
||||
If DoSelfTest = False Then
|
||||
Try TestClass = Class.Load(strName)
|
||||
If TestClass Then
|
||||
If TestClass.Parent Then
|
||||
If TestClass.Parent.Name = "UnitTest" Then
|
||||
strName = String.UCaseFirst(String.Lower(TestClass.Name))
|
||||
'Debug "Add to testclasses: ";; strName
|
||||
If Not TestContainernames.Exist(strName) Then
|
||||
TestContainernames.Add(strName)
|
||||
Endif
|
||||
Endif
|
||||
Endif
|
||||
Endif
|
||||
Endif
|
||||
Endif
|
||||
Next
|
||||
|
||||
Return TestContainernames
|
||||
Catch
|
||||
Error Error.Text
|
||||
|
||||
End
|
||||
|
||||
' Private Function Suite_Read() As TestSuite
|
||||
'
|
||||
' Return $Suite
|
||||
'
|
||||
' End
|
||||
'
|
||||
' Private Sub Suite_Write(Value As TestSuite)
|
||||
'
|
||||
' $Suite = Value
|
||||
'
|
||||
' End
|
||||
|
||||
' Private Function DoSelfTest_Read() As Boolean
|
||||
'
|
||||
' Return $DoSelfTest
|
||||
'
|
||||
' End
|
||||
'
|
||||
' Private Sub DoSelfTest_Write(Value As Boolean)
|
||||
'
|
||||
' $DoSelfTest = Value
|
||||
'
|
||||
' End
|
||||
|
||||
''' This abstract class identifies TestContainer classes. TestContainers are a
|
||||
''' classes that hold different test case methods.
|
||||
'''
|
||||
''' A TestContainer class hast to inherit UnitTest, its name has to start
|
||||
''' with "_GuTest"
|
||||
|
||||
Property Read Name As String
|
||||
|
||||
' Return the name of the different test case methods in this test container
|
||||
Property CaseNames As String[]
|
||||
Private $CaseNames As String[]
|
||||
|
||||
'' The current test case
|
||||
'Property Case As ITestCase
|
||||
Property Result, R As TestResult
|
||||
|
||||
''Set true for debug messages
|
||||
Property Debug As Boolean
|
||||
|
||||
Private $Case As ITestCase
|
||||
Private $Result As TestResult
|
||||
Private $Debug As Boolean
|
||||
|
||||
Public Sub _new(Optional ShowDebug As Boolean)
|
||||
|
||||
Dim symbols As String[]
|
||||
Dim symbol As String
|
||||
|
||||
'$Suite = New TestSuite
|
||||
|
||||
$Debug = ShowDebug
|
||||
|
||||
' ------------------------------------------------- Fill Cases by listing all Testmethods
|
||||
$CaseNames = New String[]
|
||||
symbols = Object.Class(Me).Symbols
|
||||
|
||||
For Each symbol In symbols
|
||||
If Left(symbol, 4) = "Test" Then
|
||||
$CaseNames.Add(symbol)
|
||||
Endif
|
||||
Next
|
||||
|
||||
End
|
||||
|
||||
' Run the specified test case methods in this test container
|
||||
Public Sub RunCase(oCase As ITestCase, oTestResult As TestResult)
|
||||
|
||||
Dim MethodName As String
|
||||
Dim hClass As Class
|
||||
|
||||
$Case = oCase
|
||||
Me.Result = oTestResult
|
||||
|
||||
' ------------------------------------------------- Iterate through test methods
|
||||
hClass = Object.Class(Me)
|
||||
For Each MethodName In $CaseNames
|
||||
If hClass[MethodName].Kind = Class.Method Then
|
||||
If MethodName = $Case.Name Then
|
||||
If Me.Debug Then
|
||||
Debug "Call";; MethodName
|
||||
Endif
|
||||
Object.Call(Me, MethodName)
|
||||
Endif
|
||||
Endif
|
||||
Next
|
||||
|
||||
End Sub
|
||||
|
||||
'Initialize the test fixture
|
||||
Public Sub SetupEach()
|
||||
|
||||
If Me.Debug Then
|
||||
Debug "Setup single Test"
|
||||
Endif
|
||||
|
||||
End Sub
|
||||
|
||||
'Destroy the test fixture
|
||||
Public Sub TearDownEach()
|
||||
|
||||
If Me.Debug Then
|
||||
Debug "Teardown single Test"
|
||||
Endif
|
||||
|
||||
End Sub
|
||||
|
||||
'Initialize the test fixture for container
|
||||
Public Sub SetupContainer()
|
||||
|
||||
If Me.Debug Then
|
||||
Debug "Setup Container " & Object.Class(Me).Name
|
||||
Endif
|
||||
|
||||
End Sub
|
||||
|
||||
'Destroy the test fixture for container
|
||||
Public Sub TearDownContainer()
|
||||
|
||||
If Me.Debug Then
|
||||
Debug "Teardown Container " & Object.Class(Me).Name
|
||||
Endif
|
||||
|
||||
End Sub
|
||||
|
||||
Private Function CaseNames_Read() As String[]
|
||||
|
||||
Return $CaseNames
|
||||
|
||||
End
|
||||
|
||||
Private Sub CaseNames_Write(Value As String[])
|
||||
|
||||
$CaseNames = value
|
||||
|
||||
End
|
||||
|
||||
' Private Function Case_Read() As ITestCase
|
||||
'
|
||||
' Return $Case
|
||||
'
|
||||
' End
|
||||
'
|
||||
' Private Sub Case_Write(Value As ITestCase)
|
||||
'
|
||||
' $Case = Value
|
||||
'
|
||||
' End
|
||||
|
||||
Private Function Result_Read() As TestResult
|
||||
|
||||
Return $Result
|
||||
|
||||
End
|
||||
|
||||
Private Sub Result_Write(Value As TestResult)
|
||||
|
||||
$Result = Value
|
||||
|
||||
End
|
||||
|
||||
'' Returns the classname of the TestContainer
|
||||
Private Function Name_Read() As String
|
||||
|
||||
Return Object.Class(Me).Name
|
||||
|
||||
End
|
||||
|
||||
Private Function Debug_Read() As Boolean
|
||||
|
||||
Return $Debug
|
||||
|
||||
End
|
||||
|
||||
Private Sub Debug_Write(Value As Boolean)
|
||||
|
||||
$Debug = Value
|
||||
|
||||
End
|
Loading…
Reference in a new issue