TestResult.st
author Claus Gittinger <cg@exept.de>
Tue, 06 Aug 2002 10:48:49 +0200
changeset 74 0338bcb7bd2f
parent 70 2ff4508f476d
child 100 472b7bea9cad
permissions -rw-r--r--
fail on exception

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

Object subclass:#TestResult
	instanceVariableNames:'runCount passed failures errors'
	classVariableNames:''
	poolDictionaries:''
	category:'SUnit-Base'
!


!TestResult class methodsFor:'exceptions'!

error
       ^self exError

    "Modified: / 21.6.2000 / 10:07:16 / Sames"
!

exError
        "Change for Dialect"
        Smalltalk dialectName = 'SmalltalkX' ifTrue:[
            ^ Exception
        ].
        ^Error

    "Modified: / 21.6.2000 / 10:10:45 / Sames"
!

failure
       ^TestFailure

    "Modified: / 21.6.2000 / 10:07:03 / Sames"
!

signalErrorWith: aString 
        self error raiseErrorString: aString

    "Modified: / 21.6.2000 / 10:11:07 / Sames"
!

signalFailureWith: aString 
        self failure raiseErrorString: aString

    "Modified: / 21.6.2000 / 10:11:20 / Sames"
! !

!TestResult class methodsFor:'init / release'!

new
	^super new initialize

    "Modified: / 21.6.2000 / 10:11:50 / Sames"
! !

!TestResult methodsFor:'accessing'!

correctCount
        "depreciated - use #passedCount"
        ^self passedCount
"/        ^self runCount - self failureCount - self errorCount
!

defects
	^self errors, self failures

    "Modified: / 21.6.2000 / 10:07:56 / Sames"
!

errorCount
	^self errors size
!

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

failureCount
	^self failures size

    "Modified: / 21.6.2000 / 10:08:34 / Sames"
!

failures
	failures isNil ifTrue: [failures := OrderedCollection new].
	^failures
!

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

passedCount
        ^ self passed size
        "/ ^self runCount - self failureCount - self errorCount

    "Modified: / 21.6.2000 / 10:07:48 / Sames"
!

runCount
        (self passedCount + self failureCount + self errorCount) ~~ runCount
        ifTrue:[
            Transcript showCR:'oops - inconsistent runCount (errors in cleanup-ensures)'.
            "/ self halt:'oops - inconsistent runCount (errors in cleanup-ensures)'
        ].

        "/ ^self passedCount + self failureCount + self errorCount
        ^runCount
!

tests
	^(OrderedCollection new: self runCount)
		addAll: self passed;
		addAll: self errors;
		addAll: self defects;
		yourself
! !

!TestResult methodsFor:'init / release'!

initialize
	runCount := 0
! !

!TestResult methodsFor:'printing'!

printOn: aStream
	aStream
		nextPutAll: self runCount printString;
		nextPutAll: ' run, ';
		nextPutAll: self passedCount 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|

        runCount := runCount + 1.
        [
            [aTestCase runCase.
             testCasePassed := true.] 
                on: self class failure
                do:[:signal |   
                    self failures add: aTestCase.
                    testCasePassed := false.
                    signal returnWith: false]
        ] 
            on: self class error
            do:[:signal |  
                self errors add: aTestCase.
                testCasePassed := false.
                signal returnWith: false].

        testCasePassed ifTrue: [self passed add: aTestCase]

    "Modified: / 21.6.2000 / 10:10:06 / Sames"
! !

!TestResult methodsFor:'testing'!

hasErrors

	^self errors size > 0
!

hasFailures

	^self failures size > 0
!

hasPassed
        ^self hasErrors not and: [self hasFailures not]
"/        ^self runCount = self correctCount
!

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.11 2002-08-06 08:48:49 cg Exp $'
! !