"{ Package: 'stx:goodies/sunit' }"
Object subclass:#TestResult
instanceVariableNames:'name timestamp failures errors passed 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 == #TestCase 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:'exceptions'!
error
^self exError
!
exError
^SUnitNameResolver errorObject
!
failure
^TestFailure
!
resumableFailure
^ResumableTestFailure
!
signalErrorWith: aString
self error sunitSignalWith: aString
!
signalFailureWith: aString
self failure sunitSignalWith: aString
! !
!TestResult methodsFor:'accessing'!
defects
^OrderedCollection new
addAll: self errors;
addAll: self failures; yourself
!
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: [^#()].
^errors collect:[:outcome|outcome testCase]
"Modified: / 16-08-2011 / 15:54:31 / 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>"
!
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: [^#()].
^failures collect:[:outcome|outcome testCase]
"Modified: / 16-08-2011 / 15:54:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
name
^ name
!
name:aString
name := aString.
!
outcomes
^OrderedCollection new
addAll: failures;
addAll: errors;
addAll: passed;
yourself
"Created: / 20-08-2011 / 14:00:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
outcomesDo: 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:[:outcome|outcome testCase]
"Modified: / 16-08-2011 / 15:54:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 07-11-2011 / 11:19:57 / cg"
!
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
!
testOutcomes
^(OrderedCollection new: self runCount)
addAll: self passedOutcomes;
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 errors;
addAll: self failures;
yourself
!
timestamp
^ timestamp
!
timestamp:something
timestamp := something.
! !
!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 result: #error.
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 result: #fail.
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: #pass.
outcome remember.
^ self passedOutcomes add: outcome
"Modified: / 20-08-2011 / 12:44:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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: 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
^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
^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 correctCount printString;
nextPutAll: ' passed, ';
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.
self rememberEndTime.
self addPass:aTestCase.
outcome := nil.
] sunitOn:self exceptions do: [:ex |
self rememberEndTime.
self rememberException: ex.
debugged ifTrue:[ ex reject ].
ex sunitAnnounce:aTestCase toResult:self.
].
] sunitOn: self exceptions do:[:ex|
self remove: aTestCase.
debugged ifTrue:[ ex reject ].
ex sunitAnnounce:aTestCase toResult:self.
]
"Created: / 21-08-2011 / 17:48:19 / cg"
"Modified: / 16-01-2012 / 20:37:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TestResult methodsFor:'testing'!
hasErrors
^self errors size > 0
!
hasFailures
^self failures size > 0
!
hasPassed
^self hasErrors not and: [self hasFailures not]
!
isError: aTestCase
^self errors includes: aTestCase
!
isFailure: aTestCase
^self failures includes: aTestCase
!
isPassed: aTestCase
^self passed includes: aTestCase
! !
!TestResult class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/goodies/sunit/TestResult.st,v 1.39 2012-01-16 20:45:45 vrany Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/goodies/sunit/TestResult.st,v 1.39 2012-01-16 20:45:45 vrany Exp $'
!
version_SVN
^ '§Id: TestResult.st 205 2010-09-11 15:23:01Z vranyj1 §'
! !