"{ Package: 'stx:goodies/sunit' }"
Object subclass:#TestResult
instanceVariableNames:'name timestamp failures errors passed'
classVariableNames:''
poolDictionaries:''
category:'SUnit-Base'
!
TestResult comment:''
!
!TestResult class methodsFor:'instance creation'!
new
^super new initialize
! !
!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 errors size
!
errors
errors isNil ifTrue: [errors := OrderedCollection new].
^errors
!
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 failures size
!
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 := Set new].
^failures
!
name
^ name
!
name:aString
name := aString.
!
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
!
timestamp
^ timestamp
!
timestamp:something
timestamp := something.
! !
!TestResult methodsFor:'adding'!
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'"
self rememberExceptionIn:testcase detail:detail.
testcase class rememberErrorTest: testcase selector.
^self errors add: testcase
"Modified: / 11-09-2010 / 17:19:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Created: / 03-08-2011 / 13:50:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 06-08-2011 / 09:46:41 / cg"
!
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'"
self rememberExceptionIn:testcase detail:detail.
testcase class rememberFailedTest: testcase selector.
^self failures add: testcase
"Created: / 03-08-2011 / 13:53:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 06-08-2011 / 09:55:17 / cg"
!
addPass: testcase
testcase class rememberPassedTest: testcase selector.
^self passed add: testcase
"Modified: / 11-09-2010 / 17:19:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
rememberExceptionIn:testcase detail:detail
"common for failure and error:
called when a test fails. testCase is the failed
testcase, detail is platform specific object describing
the failure. Actually, on all platforms exeptt GemStone,
detail is an instance of an exception that caused the failure"
|backtrace|
((Smalltalk respondsTo:#isSmalltalkX) and:[Smalltalk isSmalltalkX]) ifTrue:[
"remember the backtrace (as string, to prevent objects from being kept forwever
from being garbage collected, the signal (i.e. the exception class) and the
exceptions message (description).
Would like to have an exceptionInfo obejct for that, but that might be hard to
get returned back into the main stream sunit package..."
backtrace := String streamContents:[:s |
detail suspendedContext printAllOn:s
].
testcase exceptionDetail:(Dictionary new
at:#exception put:detail signal;
at:#description put:detail description;
at:#backtrace put:backtrace;
yourself).
^ self.
].
"add other dialect specifics here"
"Created: / 06-08-2011 / 11:29:23 / cg"
! !
!TestResult methodsFor:'deprecated'!
correctCount
"deprecated - use #passedCount"
^self passedCount
! !
!TestResult methodsFor:'initialize-release'!
initialize
! !
!TestResult methodsFor:'printing'!
exceptionInfoStringFor:anException in:aTestCase
"the following should be pretty portable;
if not, comment the following, and uncomment the false
to return nil (thats what you had before)"
((Smalltalk respondsTo:#isSmalltalkX) and:[Smalltalk isSmalltalkX])
"false"
ifTrue:[
^ String streamContents:[:s |
|con endReached|
endReached := false.
con := anException suspendedContext.
[ con isNil or:[ endReached ]] whileFalse:[
con printOn:s.
s cr.
((con selector == aTestCase selector)
and:[ con receiver == aTestCase ]) ifTrue:[
endReached := true.
].
con := con sender.
]
].
].
^ nil
"Created: / 02-08-2011 / 18:10:46 / cg"
!
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 performCase:aTestCase.
self addPass:aTestCase
] sunitOn:self exceptions do: [:ex |
ex sunitAnnounce:aTestCase toResult:self
].
"Modified: / 03-08-2011 / 14:08:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 03-08-2011 / 17:20:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 06-08-2011 / 09:32:32 / cg"
! !
!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.30 2011-08-07 10:50:59 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/goodies/sunit/TestResult.st,v 1.30 2011-08-07 10:50:59 cg Exp $'
!
version_SVN
^ '§Id: TestResult.st 205 2010-09-11 15:23:01Z vranyj1 §'
! !