"{ Package: 'stx:goodies/sunit' }"
Object subclass:#TestResult
instanceVariableNames:'failures errors passed'
classVariableNames:''
poolDictionaries:''
category:'SUnit-Base'
!
TestResult comment:'This is a Collecting Parameter for the running of a bunch of tests. TestResult is an interesting object to subclass or substitute. #runCase: is the external protocol you need to reproduce. Kent has seen TestResults that recorded coverage information and that sent email when they were done.'
!
!TestResult class methodsFor:'exceptions'!
error
^self exError
!
exError
^SUnitNameResolver errorObject
!
failure
^TestFailure
!
resumableFailure
^ResumableTestFailure
!
signalErrorWith: aString
"/ self error sunitSignalWith: aString
self exError raiseErrorString: aString
!
signalFailureWith: aString
"/ self failure sunitSignalWith: aString
self failure raiseErrorString: aString
! !
!TestResult class methodsFor:'initialization & release'!
new
^super new initialize
! !
!TestResult methodsFor:'accessing'!
correctCount
"depreciated - use #passedCount"
^self passedCount
!
defects
^OrderedCollection new
addAll: self errors;
addAll: self failures; yourself
!
errorCount
^self errors size
!
errors
errors isNil
ifTrue: [errors := OrderedCollection new].
^errors
!
failureCount
^self failures size
!
failures
failures isNil
ifTrue: [failures := Set new].
^failures
!
passed
passed isNil
ifTrue: [passed := OrderedCollection new].
^passed
!
passedCount
^self passed size
!
runCount
^self passedCount + self failureCount + self errorCount
!
tests
^(OrderedCollection new: self runCount)
addAll: self passed;
addAll: self errors;
addAll: self failures;
yourself
! !
!TestResult methodsFor:'init / release'!
initialize
! !
!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'!
runCase:aTestCase
|testCasePassed failure error|
testCasePassed := true.
failure := error := false.
[
[
aTestCase runCase.
] on:self class failure do:[:ex |
testCasePassed ifTrue:
[failure := true.
testCasePassed := false].
ex handleFailureWith:false
]
] on:self class error do:[:ex |
(AbortAllOperationRequest accepts:ex signal) ifTrue:[
(AbortOperationRequest accepts:ex signal) ifFalse:[
ex reject
].
].
(HaltInterrupt accepts:ex signal) ifTrue:[
ex reject
].
error := true.
testCasePassed := false.
ex returnWith:false
].
error
ifTrue:
[self errors add: aTestCase]
ifFalse:
[failure ifTrue: [self failures add: aTestCase]].
testCasePassed ifTrue:[
self passed add:aTestCase
]
"Modified: / 06-08-2006 / 10:42:42 / cg"
"Modified: / 28-08-2006 / 16:40:00 / boris"
" a test case should be registered either as passed or as failed or as error.
Note that several resumable failures may preceed one final error "
! !
!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.19 2008-09-03 08:50:25 cg Exp $'
! !