{ import: Utility }

"----------------------------------------------------------------"
"A unit test framework based on The Test Anything Protocal.
http://search.cpan.org/~petdance/TAP-1.00/TAP.pm

TestCase new run. -- test all methods which the name starts with #test.
TestCase new run: #testMethod. -- test one method.

Output of the test can be processed 'prove' command with a wrapper script.
"

TestCase : Object (failed all)

TestCase new
[
    self := super new.
    all := failed := 0.
]

TestCase all		[ ^ all ]
TestCase failed		[ ^ failed ]
TestCase setUp		[]
TestCase tearDown	[]
TestCase run		[ (TestSuite new + self) run ]
TestCase + aTestCase	[ ^ TestSuite new + self + aTestCase ]
TestCase log: aString	[ StdOut nextPutAll: aString; cr ]

TestCase runAll
[
    self _vtable allSelectors do: [ :aSymbol |
        (aSymbol asString beginsWith: 'test')
            ifTrue: [ self run: aSymbol ]].
]

TestCase assert: result equals: expected
[
    all := all + 1.
    result = expected ifTrue: [ ^self log: 'ok' ].
    failed := failed + 1.
    self log: 'not ok: expected = ', expected printString, ' result = ', result printString.
]

TestCase run: aSymbol
[
    self log: '# Testing ...', self debugName, '>>', aSymbol printString.
    self setUp.
    self perform: aSymbol.
    self tearDown.
]

TestSuite : Object (tests)

TestSuite new
[
    self := super new.
    tests := OrderedCollection new.
]

TestSuite + aTestCase [ tests add: aTestCase. ^self ]

TestSuite run
[
    | failed all |
    tests do: [ :aTestCase | aTestCase runAll ].
    failed := tests inject: 0 into: [ :sum :aTestCase | sum + aTestCase failed ].
    all    := tests inject: 0 into: [ :sum :aTestCase | sum + aTestCase all ].
    TestCase log: '# Summary: '.
    TestCase log: (failed > 0 ifTrue: [ 'Failed: ', failed printString, '/', all printString ] ifFalse: [ 'All success' ]).
    TestCase log: '1..', all printString.
]

TestCaseTest : TestCase ()
TestCaseTest testNumber [ self assert: 42 equals: 42 ]
TestCaseTest testString [ self assert: 'Hello' equals: 'Hello' ]