{ import: _vtable }

"----------------------------------------------------------------"
"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 count next)

TestCase new
[
    self := super new.
    count := 0.
    failed := 0.
    next := nil.
]

TestCase count [ ^ next isNil ifTrue: [ count ] ifFalse: [ count + next count ] ]
TestCase failed [ ^ next isNil ifTrue: [ failed ] ifFalse: [ failed + next failed ] ]

TestCase + aCase "CAUTION: It has a side effect."
[
    next ifNil: [ next := aCase. ^self ].
    next + aCase.
]

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

TestCase run
[
    self runAll.
    self log: '# Summary: ', (self failed > 0
        ifTrue: [ 'Failed: ', self failed printString, '/', self count printString]
        ifFalse: [ 'All success' ]).
    self log: '1..', self count printString.
]

TestCase assert: result equals: expected
[
    count := count + 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.
]

TestCase setUp []
TestCase tearDown []

TestCase log: aString [ StdOut nextPutAll: aString; cr ]