"{ Package: 'stx:goodies/sunit' }"

Object subclass:#TestResult

	instanceVariableNames:'name timestamp failures errors passed skipped outcome'

	classVariableNames:'DefaultClass'

	poolDictionaries:''

	category:'SUnit-Base'

!

TestResult comment:''

!

!TestResult class methodsFor:'documentation'!

documentation

"

    runInfoPerTest:

        will keep additional info for a testCase run:

            startTime, endTime, backtrace (if fail or error) and collectedStdout

"

! !

!TestResult class methodsFor:'instance creation'!

new

    self sunitName == #TestResult ifTrue:[

        ^ self defaultResultClass basicNew initialize.

    ] ifFalse:[

        ^ self basicNew initialize

    ].

    "

        TestResult new.

        TestResultForRunWithDebug new.

    "

    "Modified (comment): / 20-08-2011 / 17:34:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestResult class methodsFor:'accessing'!

defaultResultClass

    DefaultClass notNil ifTrue:[^DefaultClass].

    ((Smalltalk respondsTo: #isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifTrue:[

        DefaultClass := TestResultStX.

        ^DefaultClass

    ].

    "Add more dialects here, if you want..."

    "Default"

    DefaultClass := self.

    "Created: / 16-08-2011 / 15:02:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestResult class methodsFor:'constants'!

stateError

    ^ #error

!

stateFail

    "this symbl used to freak around everywhere in the code;

     and I was never sure if #fail or #failed is to be used."

    ^ #fail

!

statePass

    "this symbl used to freak around everywhere in the code;

     and I was never sure if #pass or #passed is to be used."

    ^ #pass

!

stateSkip

    ^ #skip

! !

!TestResult class methodsFor:'exceptions'!

error

	^self exError

!

exError

	^SUnitNameResolver errorObject

!

failure

	^TestFailure

!

resumableFailure

	^ResumableTestFailure

!

signalErrorWith: aString

	self error sunitSignalWith: aString

!

signalFailureWith: aString

	self failure sunitSignalWith: aString

! !

!TestResult class methodsFor:'utilities'!

sourceFilenameOfClass:aClass

    ^ nil

    " use something like... "

    " ^ aClass classFilename asFilename pathName. "

! !

!TestResult methodsFor:'accessing'!

defects

	^OrderedCollection new

		addAll: self errors;

		addAll: self failures; yourself

!

endTime:aTimestamp

    "sets the overall (suite) end time"

    "/ ignored, for now (Neil should add it)

    "/ endTime := aTimestamp.

!

errorCount

        ^self errorOutcomes size

    "Modified: / 16-08-2011 / 15:58:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

errorOutcomes

    errors isNil ifTrue: [errors := OrderedCollection new].

    ^errors

    "Created: / 16-08-2011 / 15:55:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

errors

    errors isNil ifTrue: [^OrderedCollection new].

    ^errors collect:[:each|each testCase]

    "Modified (format): / 02-08-2012 / 15:40:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

exceptions

    "Returns a set of exceptions to be handled. Bu default,

     failure and generic error is handled. This method may

     be overriden by custom TestResult subclasses to add more.

     For example, a 'self halt' is not handled by default

     exceptions set"

    ^self class failure , self class error

    "Created: / 03-08-2011 / 14:11:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

executionTime

    "return the execution time (in seconds). 

     If unknown, or asked before or during a run, return nil"

    ^ nil

!

failureCount

        ^self failureOutcomes size

    "Modified: / 16-08-2011 / 15:58:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

failureOutcomes

    failures isNil ifTrue: [failures := Set new].

    ^failures

    "Created: / 16-08-2011 / 15:56:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

failures

    "We use a Set, not an OrderedCollection as #errors and #passed do, 

     because a resumable test failure in a loop can raise many failures against the same test.  

     In current Sunit UIs, this could result in bizarre test count reporting (-27 tests run, and suchlike).  

     This will be reviewed."

    failures isNil ifTrue: [^OrderedCollection new].

    ^failures collect:[:each|each testCase]

    "Modified (format): / 02-08-2012 / 14:55:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

name

    ^ name

!

name:aString

    name := aString.

!

outcomes

    |all|

    all := OrderedCollection new.

    self outcomesDo:[:each | all add:each].

    ^ all.

!

outcomesDo: aBlock

    skipped notNil ifTrue:[skipped do: aBlock].

    failures notNil ifTrue:[failures do: aBlock].

    errors notNil ifTrue:[errors do: aBlock].

    passed notNil ifTrue:[passed do: aBlock].

    "Created: / 20-08-2011 / 14:01:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

passed

        passed isNil ifTrue: [

            "/ cg: exposed and added to (see TestRunnerEmbedded>>debug)

            passed := OrderedCollection new.

            ^ passed.

        ].

        ^passed collect:[:each|each testCase]

    "Modified: / 16-08-2011 / 15:54:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 07-11-2011 / 11:19:57 / cg"

    "Modified (format): / 02-08-2012 / 14:55:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

passedCount

        ^self passedOutcomes size

    "Modified: / 16-08-2011 / 15:58:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

passedOutcomes

    passed isNil ifTrue: [passed := OrderedCollection new].

    ^passed

    "Created: / 16-08-2011 / 15:56:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

runCount

	^self passedCount + self failureCount + self errorCount

!

skipped

        skipped isNil ifTrue: [

            "/ cg: exposed and added to (see TestRunnerEmbedded>>debug)

            skipped := OrderedCollection new.

            ^ skipped.

        ].

        ^skipped collect:[:each|each testCase]

!

skippedCount

        ^self skippedOutcomes size

!

skippedOutcomes

    skipped isNil ifTrue: [skipped := OrderedCollection new].

    ^skipped

!

testOutcomes

        ^(OrderedCollection new: self runCount)

                addAll: self passedOutcomes;

                addAll: self skippedOutcomes;

                addAll: self errorOutcomes;

                addAll: self failureOutcomes;

                yourself

    "Created: / 16-08-2011 / 16:42:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

tests

        ^(OrderedCollection new: self runCount)

                addAll: self passed;

                addAll: self skipped;

                addAll: self errors;

                addAll: self failures;

                yourself

!

timestamp

    ^ timestamp

!

timestamp:aTimestamp

    timestamp := aTimestamp.

! !

!TestResult methodsFor:'adding / removing'!

addError:testcase detail:detail 

    "Called when a test outcome is error. testCase 

     is the errorneous testcase, detail is platform

     specific object describing the error. Actually,

     on all platforms exept GemStone, detail is an instance

     of an exception that caused the error"

    "JV2011-08-03: TODO: Validate the comment above with GS,

     possibly change name to 'exception'"

    outcome remember.

    ^ self errorOutcomes add:outcome.

    "Created: / 03-08-2011 / 13:50:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 06-08-2011 / 09:46:41 / cg"

    "Modified: / 20-08-2011 / 12:46:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

addFailure:testcase detail:detail 

    "Called when a test fails. testCase is the failed 

     testcase, detail is platform specific object describing

     the failure. Actually, on all platforms exept GemStone,

     detail is an instance of an exception that caused the failure"

    "JV2011-08-03: TODO: Validate the comment above with GS,

     possibly change name to 'exception'"

     "Special handling here, because failures can be resumable"

    self failureOutcomes do:[:outcome | 

        outcome testCase = testcase ifTrue:[

            ^ self

        ].

    ].

    outcome remember.

    ^ self failureOutcomes add: outcome

    "Created: / 03-08-2011 / 13:53:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 06-08-2011 / 09:55:17 / cg"

    "Modified: / 20-08-2011 / 12:46:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

addPass:testCase 

    outcome result: (TestResult statePass).

    outcome remember.

    ^ self passedOutcomes add: outcome

    "Modified: / 20-08-2011 / 12:44:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

addSkipped:testCase 

    outcome remember.

    ^ self skippedOutcomes add: outcome

!

remove: aTestCase

    "Removes an outcome for given testcase, if any.

    Use with care."

    | remover |

    remover := [:outcomes|

        | o |

        outcomes notNil ifTrue:[

            o := outcomes detect:[:each|each testCase == aTestCase] ifNone: [nil].

            o notNil ifTrue:[outcomes remove: o. ^self].

        ].

    ].

    remover value: skipped.

    remover value: errors.

    remover value: failures.

    remover value: passed.

    "Created: / 16-01-2012 / 20:36:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestResult methodsFor:'deprecated'!

correctCount

	"deprecated - use #passedCount"

	^self passedCount

! !

!TestResult methodsFor:'initialize-release'!

initialize

! !

!TestResult methodsFor:'outcome'!

createOutcome

    ^TestCaseOutcome new.

    "Created: / 16-08-2011 / 17:14:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

rememberEndTime

    "remembers the endTime of the current test (in outcome)"

    ^nil

    "Created: / 16-08-2011 / 17:31:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

rememberException:detail

    "Created: / 16-08-2011 / 17:35:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

rememberStartTime

    "remembers the startTime of the current test (in outcome)"

    ^nil

    "Created: / 16-08-2011 / 17:31:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestResult methodsFor:'printing'!

printOn: aStream

        aStream

                nextPutAll: self runCount printString;

                nextPutAll: ' run, ';

                nextPutAll: self passedCount printString;

                nextPutAll: ' passed, ';

                nextPutAll: self skippedCount printString;

                nextPutAll: ' skipped, ';

                nextPutAll: self failureCount printString;

                nextPutAll: ' failed, ';

                nextPutAll: self errorCount printString;

                nextPutAll: ' error'.

        self errorCount ~= 1

                ifTrue: [aStream nextPut: $s]

! !

!TestResult methodsFor:'running'!

performCase:aTestCase 

    "Actually performs the case. The TestCase>>runCase itself calls

     a setUp/tearDown methods. The possible error/failure is handled

     in TestResult>>runCase:. This method is meant to be overriden by

     custom TestResult subclasses."

    aTestCase runCase.

    "Modified: / 02-08-2011 / 18:10:09 / cg"

    "Created: / 03-08-2011 / 14:02:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

runCase:aTestCase 

    "run a testcase, catching exceptions"

    self runCase:aTestCase debugged:false

    "Modified: / 16-08-2011 / 17:35:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 21-08-2011 / 17:48:28 / cg"

!

runCase:aTestCase debugged:debugged

    "run a testcase, debugging exceptions"

    [

        [ 

            outcome := self createOutcome.

            outcome testCase: aTestCase.

            self rememberStartTime.

            self performCase:aTestCase.