Compare commits

...

88 commits

Author SHA1 Message Date
Tobias Boege
eaad6a640f gb.test: Add test for subtest printing
[GB.TEST]
* NEW: Add test for subtest printing
* OPT: Prefix test classes run by self-tests with an underscore so that they don't interfere with class and struct names
2018-06-09 23:50:53 +02:00
Tobias Boege
7e1a24bc81 gb.test: do not nest assertion methods and add test plan to Assert.Subtest()
[GB.TEST]
* BUG: Assert: do not re-use assertions in other assertions; they have side-effects!
* NEW: add optional argument to Assert.Subtest() to give the test plan
2018-06-09 23:37:38 +02:00
Tobias Boege
0c151bc812 gb.test: Subtest support for Assert
[GB.TEST]
* OPT: TapPrinter: use the Print method everywhere
* NEW: Add the TapPrinter_Filter event
* NEW: Assert: add subtest support
2018-06-09 22:42:27 +02:00
Tobias Boege
5e171d5a1c gb.test: Fix accounting in TestHarness
[GB.TEST]
* BUG: The test bonus is calculated correctly now
* BUG: Fix test success detection: all planned tests ran and no failures occurred
2018-05-25 14:40:16 +02:00
Tobias Boege
1ed40b6c85 gb.test: Simplify names for the "crashing test" test
[GB.TEST]
* OPT: Simplify names for the "crashing test" test
2018-05-25 14:30:15 +02:00
Tobias Boege
5613b9920d gb.test: Add Run member to TestStats
[GB.TEST]
* NEW: TestStats.Run counts the number of tests that were actually run
2018-05-23 22:36:03 +02:00
Tobias Boege
bf0e19c514 gb.test: Add a SelfTest for a crashing test
[GB.TEST]
* NEW: Add a SelfTest for a crashing test

Reported by Christof Thalhofer
2018-05-23 22:34:20 +02:00
Tobias Boege
78ade59842 gb.test: Fix test summary of startup class
[GB.TEST]
* BUG: Tester: The "Run Tests" statistic was calculated wrongly
2018-05-23 22:26:53 +02:00
Tobias Boege
33baf4da3a gb.test: Process a TAP stream in realtime and capture stderr
[GB.TEST]
* NEW: TestHarness: Don't buffer process output
* NEW: The testee's stderr is converted into diagnostic messages
* BUG: Remove (incorrect) usage of Error.Class from error reporting, Error.Where is sufficient
* BUG: TapPrinter: Always flush output in case the process dies suddenly
2018-05-23 22:25:39 +02:00
Tobias Boege
3097bf1ea2 gb.test: Assert.StringEquals for comparing long strings
[GB.TEST]
* NEW: Add Assert.StringEquals which writes diagnostics for why two strings are unequal

Sample output for a subtle case where it was helpful:

  not ok 2 - Output as expected
  # Strings are of different length.
  #   Got:      219
  #   Expected: 218
  # Strings differ at position 216
  #   Got:      " \n# "
  #   Expected: "\n# "
2018-05-23 22:12:29 +02:00
Tobias Boege
7dbb378ffb gb.test: Assert routines return the ok-ness
[GB.TEST]
* NEW: All routines in Assert return whether the assertion was positive
2018-05-23 22:11:01 +02:00
Tobias Boege
f30a3c1834 gb.test: Delete README
[GB.TEST]
* OPT: Delete README.md. Everything in it is obsolete
2018-05-19 02:18:08 +02:00
Tobias Boege
9a3ea3e4cb gb.test: Begin self-tests
[GB.TEST]
* NEW: Add self-tests
* NEW: Add provisional test runner
* BUG: TestHarness: Correctly initialise TestStats and actually run the parser
2018-05-19 02:14:55 +02:00
Tobias Boege
43fc4a56b2 gb.test: More cleanup
[GB.TEST]
* OPT: Delete TAP-incompatible classes and add TODOs
* BUG: Forgot to Export Tap
* NEW: Add comparisons to Assert
2018-05-19 01:52:38 +02:00
Tobias Boege
4c695dc703 gb.test: Fix compilation
[GB.TEST]
* BUG: 6a9035 and 1c2d0b did not compile
2018-05-19 00:26:36 +02:00
Tobias Boege
2e3a5aeb62 gb.test: Various cleanups
[GB.TEST]
* OPT: Cleanup component description and dependencies
* OPT: Remove useless data files
2018-05-19 00:24:33 +02:00
Tobias Boege
3681e003d6 Merge remote-tracking branch 'gb.unittest/TAP' into gb.test
[GB.TEST]
* NEW: Import (my fork of) Christof's gb.unittest from github as a new gb.test component
2018-05-18 23:41:16 +02:00
Tobias Boege
6a90351e0d Start the Assert module 2018-05-18 23:14:43 +02:00
Tobias Boege
1c2d0b4d8e TapPrinter: add properties
Properties Output, Plan, Count and Last were added to read the current
test state (plan, how many tests were run, the test number of the last
run test). In particular, allow the reconfiguration of the Output stream
after the object is created.
2018-05-18 23:12:15 +02:00
Tobias Boege
888e880c23 Implement TestHarness
TestHarness is a class which runs multiple tests and collects statistics
about them. It is inspired by perl's Test::Harness. It is the main
component of a program which tests other programs which output TAP.

The current design I'm implementing requires that unit tests are
implemented in classes outside of the unit they are testing, for the
following reasons:

  1. You should only test public interface anyway. Even if it is
     sometimes simpler to implement a test using private data of
     an object:
  2. It makes the class unnecessarily big and exposes methods which
     you don't want/need for a release.

This base class for implementing tests comes next. Tests are run in
an external process, by using the test as a startup class. This has
the benefit that the test harness isn't affected by a crash in the
test. It would be nice to have special treatment of tests in the
project directory structure, to list all tests in a project reliably
from the outside. IDE and compiler could benefit from that as well.
2018-04-27 01:15:15 +02:00
Tobias Boege
0929707aee Low-level printer and parser for TAP format
The Test Anything Protocol (TAP) is a text-based format for communicating
unit test results. It originated from perl and has a specification here:
http://testanything.org/
2018-04-25 13:05:09 +02:00
Christof Thalhofer
2d591f341b Refact 2018-04-22 15:38:27 +02:00
Christof Thalhofer
80127af1c2 Readme 2018-04-22 15:24:23 +02:00
Christof Thalhofer
4a8c8c7efb delete old gb.deg.unittest 2018-04-22 15:16:16 +02:00
Christof Thalhofer
129ff730a6 Correct TAP output 2018-04-22 15:13:55 +02:00
Christof Thalhofer
d96cd5c673 Unittest without GUI and with TAP output 2018-04-22 14:38:09 +02:00
Christof Thalhofer
9d038cd8ed Start developing gb.unittest
I first keep the two projects gb.deg.unittest and gb.unittest in parallel.
2018-04-22 12:08:31 +02:00
Christof Thalhofer
c5f1321f96 Last Version of gb.deg.unittest
Will be rewritten to gb.unittest
2018-04-22 12:02:31 +02:00
Christof Thalhofer
2904638697 Unittest.ShowTestForm ist static 2018-04-21 22:50:57 +02:00
Christof Thalhofer
f702aea4b1 Merged ATestContainer and UnitTest, static Run()
like Benoît recommended in
https://lists.gambas-basic.org/pipermail/user/2018-April/063734.html
2018-04-21 22:30:01 +02:00
Christof Thalhofer
9d851fc246 refact 2018-01-12 09:52:53 +01:00
Christof Thalhofer
cd287cd68c Better catching of errors 2017-08-12 19:08:00 +02:00
Christof Thalhofer
74d2429fcc Renaming of internal testclasses 2017-08-12 19:07:21 +02:00
Christof Thalhofer
8e5baa5ce2 inc version number 2017-07-01 10:20:15 +02:00
Christof Thalhofer
aaac105af8 Merge branch 'master' of degserv:gambas/gb.deg.unittest 2017-07-01 10:18:34 +02:00
Christof Thalhofer
ca3915fee0 No Unittests TextFile
That was a try for possible IDE-Integration. I deleted that code.
2017-07-01 10:11:06 +02:00
christof
715f8db1f0 refact 2017-02-24 14:52:40 +01:00
Christof Thalhofer
85ac4a215c license 2016-12-31 16:36:44 +01:00
Christof Thalhofer
6041de65c9 license GPL 2016-12-31 16:34:56 +01:00
Christof Thalhofer
cf84b875a4 Unittest finds testclasses by Dir .gambas 2016-09-29 09:14:38 +02:00
Christof Thalhofer
8897198360 geht nicht - testclasses per dir suchen 2016-09-28 23:42:25 +02:00
Christof Thalhofer
4c3c6222b4 Unittest example and small fix 2016-09-25 14:37:25 +02:00
Christof Thalhofer
e7de647892 project description: alpha 2016-09-25 12:52:07 +02:00
Christof Thalhofer
cac2ef2a48 Readme - alpha state 2016-09-25 12:48:35 +02:00
Christof Thalhofer
c7a274c7e2 After some testing: Unittests file is neccessary 2016-09-25 12:46:16 +02:00
Christof Thalhofer
6eb4dfe79a Unittest file with TestConteinerNames in project path 2016-09-25 12:11:44 +02:00
Christof Thalhofer
bca845af25 fewer exports 2016-09-24 22:03:36 +02:00
Christof Thalhofer
f8b3299971 refact 2016-09-24 20:07:05 +02:00
Christof Thalhofer
fc7d05e679 Translation german 2016-09-24 12:49:30 +02:00
Christof Thalhofer
4218805297 Translation german 2016-09-24 12:47:10 +02:00
Christof Thalhofer
855d6e5473 Typo - english as we know it ... 2016-09-23 22:23:19 +02:00
Christof Thalhofer
515f28ac64 Typo 2016-09-23 22:05:11 +02:00
Christof Thalhofer
5be88f560b keyboard control 2016-09-23 17:50:35 +02:00
Christof Thalhofer
63b199dd70 No prefix for TestContainers 2016-09-23 15:09:56 +02:00
Christof Thalhofer
da1ffe4091 example project 2016-09-23 15:07:55 +02:00
Christof Thalhofer
afeda37c26 Readme 2016-09-23 15:03:03 +02:00
Christof Thalhofer
a4a12e1847 Vendor gb 2016-09-23 15:00:11 +02:00
Christof Thalhofer
f911ca9072 No prefix for testcontainers 2016-09-23 14:50:10 +02:00
Christof Thalhofer
cda14cd4d2 AllAsserts 2016-09-23 14:47:10 +02:00
Christof Thalhofer
19a611cdc9 selftest only on DoSelftest = true 2016-09-23 14:44:19 +02:00
Christof Thalhofer
706ebc526b AlternatePrefix replaced with Selftest 2016-09-23 11:22:06 +02:00
Christof Thalhofer
32563d94d3 Readme ongoing 2016-09-23 08:56:22 +02:00
Christof Thalhofer
2846f93fb4 component needs form 2016-09-23 08:18:31 +02:00
Christof Thalhofer
f54d453b06 Readme Typo 2016-09-23 08:18:09 +02:00
Christof Thalhofer
81782e1873 Readme test fixture(s) 2016-09-23 08:12:43 +02:00
Christof Thalhofer
52d8c6d092 Readme again 2016-09-22 22:57:41 +02:00
Christof Thalhofer
e4c5de85f7 Readme going on ... 2016-09-22 22:55:54 +02:00
Christof Thalhofer
54d915b487 readme and testproj 2016-09-22 19:53:57 +02:00
Christof Thalhofer
4a77b3cb85 original files deleted, Readme 2016-09-22 19:37:43 +02:00
Christof Thalhofer
c476645823 Readme empty 2016-09-22 18:05:33 +02:00
Christof Thalhofer
f2126059c4 Rename to gb.deg.unittest 2016-09-22 17:40:01 +02:00
Christof Thalhofer
f28180617f Runner and Trace ready 2016-09-22 17:20:20 +02:00
Christof Thalhofer
81deebac76 Trace nearly ok 2016-09-22 16:47:43 +02:00
Christof Thalhofer
032c1629ff Fm Trace and some classes are visible again 2016-09-22 10:29:42 +02:00
Christof Thalhofer
f461e03d5d self testing disabled 2016-09-21 13:02:48 +02:00
Christof Thalhofer
592111d922 Gambas Unittest Component first release 2016-09-21 12:28:45 +02:00
Christof Thalhofer
e95524da23 Component, Runner, hidden exported Classes 2016-09-21 12:26:22 +02:00
Christof Thalhofer
1072a5b74f Me.R.Assert... in Testcontainer 2016-09-21 10:55:37 +02:00
Christof Thalhofer
24d3897126 Container Case private 2016-09-21 10:32:52 +02:00
Christof Thalhofer
44442850b0 All Tests run ok, Results are shown 2016-09-21 10:28:16 +02:00
Christof Thalhofer
71fc541075 FmResult Runs ok 2016-09-21 02:05:34 +02:00
Christof Thalhofer
d135f97b1f Text Commandline ok 2016-09-21 00:28:30 +02:00
Christof Thalhofer
66ff21de85 Tests ok on Commandline 2016-09-20 23:49:28 +02:00
Christof Thalhofer
5f8eff8314 weiter, tests init noch nicht ok, FmRunner 2016-09-20 18:15:58 +02:00
Christof Thalhofer
cff5d60fbb weiter, erster ExampleTestContainer ok 2016-09-19 23:42:46 +02:00
Christof Thalhofer
5111def64b Unittest weiter 2015-10-31 09:22:52 +01:00
Christof Thalhofer
38ca7e56f1 weiter, neue originalfiles dazu 2015-01-30 07:46:43 +01:00
Christof Thalhofer
e2da39e818 initialer Commit 2015-01-29 15:02:26 +01:00
23 changed files with 1648 additions and 0 deletions

View file

@ -0,0 +1,5 @@
[Component]
Key=gb.test
Version=3.11.90
State=2
Authors=Christof Thalhofer,Tobias Boege

View file

@ -0,0 +1,2 @@
[Desktop Entry]
Icon=./.icon.png

17
comp/src/gb.test/.gitignore vendored Normal file
View 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
#----

View 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

Binary file not shown.

After

Width:  |  Height:  |  Size: 10 KiB

Binary file not shown.

View 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
View 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

View 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

View 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

View 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

View 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

View 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

View 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

View 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

View 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

View 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

View 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

View 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

View 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

View 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
View 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

View 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