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

Object subclass:#TestCase
	instanceVariableNames:'testSelector'
	classVariableNames:''
	poolDictionaries:''
	category:'SUnit-Base'
!

TestCase class instanceVariableNames:'lastTestRunResultOrNil lastTestRunsFailedTests'

"
 No other class instance variables are inherited by this class.
"
!


!TestCase class methodsFor:'initialization'!

initialize
    "ensure, that the sunit extensions are loaded"

    (Class includesSelector:#sunitName) ifFalse:[
        Smalltalk fileIn:'extensions.st' inPackage:(self package)
    ].    
    TestFailure autoload

    "
     self initialize
    "
! !

!TestCase class methodsFor:'instance creation'!

debug: aSymbol
	^(self selector: aSymbol) debug
!

run: aSymbol
	^(self selector: aSymbol) run
!

selector: aSymbol
	^self new setTestSelector: aSymbol
!

suite
        ^self buildSuite
"/        | testSelectors result |
"/
"/        testSelectors := self testSelectors.
"/        testSelectors sort.
"/        
"/        result := TestSuite new.
"/        result name:self name.
"/        testSelectors do: [:each | result addTest: (self selector: each)].
"/        ^result

    "Modified: / 21.6.2000 / 10:05:24 / Sames"
! !

!TestCase class methodsFor:'accessing'!

allTestSelectors
        ^self sunitAllSelectors select: [:each | 'test*' match: each]
!

forgetLastTestRunResult
    lastTestRunResultOrNil ~~ nil ifTrue:[
        lastTestRunResultOrNil := nil.
        Smalltalk changed:#lastTestRunResult with:self.
        self changed:#lastTestRunResult.
    ]
!

lastTestRunResultOrNil
    ^ lastTestRunResultOrNil
!

rememberFailedTest:selector
    lastTestRunsFailedTests isNil ifTrue:[
        lastTestRunsFailedTests := Set new.
    ].
    lastTestRunsFailedTests add:selector.
    self rememberFailedTestRun
!

rememberFailedTestRun
    lastTestRunResultOrNil ~~ false ifTrue:[
        lastTestRunResultOrNil := false.
        Smalltalk changed:#lastTestRunResult with:self.
        self changed:#lastTestRunResult.
    ]
!

rememberFailedTestRunWithResult:result
    self rememberFailedTestRun.
    (result failures , result errors) do:[:eachFailedTest |
        |sel|

        sel := eachFailedTest selector.
        self rememberFailedTest:sel.
    ].
!

rememberPassedTest:selector
    lastTestRunsFailedTests notNil ifTrue:[
        lastTestRunsFailedTests remove:selector ifAbsent:nil.
        lastTestRunsFailedTests isEmpty ifTrue:[
            lastTestRunsFailedTests := nil
        ]
    ].
!

rememberPassedTestRun
    lastTestRunResultOrNil ~~ true ifTrue:[
        lastTestRunResultOrNil := true.
        lastTestRunsFailedTests := nil.
        Smalltalk changed:#lastTestRunResult with:self.
        self changed:#lastTestRunResult.
    ]
!

resources
	^#()
!

testSelectorFailed:selector
    ^ lastTestRunsFailedTests notNil and:[lastTestRunsFailedTests includes:selector]
!

testSelectors
        ^self sunitSelectors select: [:each | 'test*' match: each]
! !

!TestCase class methodsFor:'building Suites'!

buildSuite

        | suite |
        ^self isAbstract 
                ifTrue: 
                        [suite := TestSuite new.
self halt.
                        suite name: self name asString.
                        self allSubclasses do: [:each | each isAbstract ifFalse: [suite addTest: each buildSuiteFromSelectors]].
                        suite]
                ifFalse: [self buildSuiteFromSelectors]
!

buildSuiteFromAllSelectors
	^self buildSuiteFromMethods: self allTestSelectors
!

buildSuiteFromLocalSelectors
	^self buildSuiteFromMethods: self testSelectors
!

buildSuiteFromMethods: testMethods 
	^testMethods 
		inject: ((TestSuite new)
				name: self name asString;
				yourself)
		into: 
			[:suite :selector | 
			suite
				addTest: (self selector: selector);
				yourself]
!

buildSuiteFromSelectors
	^self shouldInheritSelectors
		ifTrue: [self buildSuiteFromAllSelectors]
		ifFalse: [self buildSuiteFromLocalSelectors]
! !

!TestCase class methodsFor:'testing'!

isAbstract
        "Override to true if a TestCase subclass is Abstract and should not have
        TestCase instances built from it"

        ^self name = #TestCase.
!

runTests
    |result|

    result := self suite run.

    result hasPassed ifTrue:[
        self rememberPassedTestRun
    ] ifFalse:[
        self rememberFailedTestRunWithResult:result
    ].
!

shouldInheritSelectors
	"answer true to inherit selectors from superclasses"

	^true
! !

!TestCase methodsFor:'accessing'!

assert: aBoolean
    "fail, if the argument is not true"

"/    "check the testCase itself"
"/    (aBoolean isBoolean) ifFalse:[ self error:'non boolean assertion' ].
"/    aBoolean ifFalse: [self signalFailure: 'Assertion failed']

    self assert: aBoolean message:'Assertion failed'
!

assert: aBoolean message:messageIfFailing
    "fail, if the argument is not true"

    "check the testCase itself"
    (aBoolean isBoolean) ifFalse:[ self error:'non boolean assertion' ].
    aBoolean ifFalse: [self signalFailure: messageIfFailing]

    "Modified: / 21.6.2000 / 10:00:05 / Sames"
!

assertFalse:aBoolean
    ^ self assert:aBoolean not
!

assertFalse:aBoolean named:testName
    ^ self assert:aBoolean not
!

assertTrue:aBoolean 
    ^ self assert:aBoolean
!

assertTrue:aBoolean named:testName
    ^ self assert:aBoolean
!

deny: aBoolean
    "fail, if the argument is not false"

    self assert: aBoolean not
!

resources
	^self class resources
!

selector
	^testSelector
!

should: aBlock
    "fail, if the block does not evaluate to true"

    self assert: aBlock value
!

should: aBlock raise: anExceptionalEvent 
    "fail, if the block does not raise the given event"

    ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)

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

shouldnt: aBlock
    "fail, if the block does evaluate to true"

    self deny: aBlock value
!

shouldnt: aBlock raise: anExceptionalEvent 
    "fail, if the block does raise the given event"

    ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not

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

signalFailure: aString
    "/ TestResult failure sunitSignalWith: aString
    TestResult failure raiseErrorString:aString in:thisContext sender sender .

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

!TestCase methodsFor:'accessing & queries'!

unfinished

	"indicates an unfinished test"
! !

!TestCase methodsFor:'dependencies'!

addDependentToHierachy: anObject 
	"an empty method. for Composite compability with TestSuite"
!

removeDependentFromHierachy: anObject 
	"an empty method. for Composite compability with TestSuite"
! !

!TestCase methodsFor:'printing'!

name
        ^ self class name.
!

printOn: aStream
	aStream nextPutAll: self class name.
	aStream nextPutAll: '>>'.
	aStream nextPutAll: testSelector

    "Modified: / 4.4.2000 / 18:59:53 / Sames"
! !

!TestCase methodsFor:'private'!

executeShould: aBlock inScopeOf: anExceptionalEvent 
	[[aBlock value]
		on: anExceptionalEvent
		do: [:ex | ^true]]
			on: TestResult error
			do: [:ex | ^false].
	^false.

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

performTest
        self perform: testSelector asSymbol
!

setTestSelector: aSymbol
	testSelector := aSymbol
! !

!TestCase methodsFor:'running'!

debug
        self debugUsing:#runCase.
"/        (self class selector: testSelector) runCase
!

debugAsFailure
        self debugUsing: #runCaseAsFailure
"/        (self class selector: testSelector) runCaseAsFailure
!

debugUsing: aSymbol 
        self areAllResourcesAvailable ifFalse: [^TestResult signalErrorWith: 'Resource could not be initialized'].
        [(self class selector: testSelector) perform: aSymbol] ensure: [self resources do: [:each | each reset]]
!

openDebuggerOnFailingTestMethod
        "SUnit has halted one step in front of the failing test method. 
        Step over the 'self halt' and send into 'self perform: testSelector' 
        to see the failure from the beginning"

        "/ self halt.
        self performTest "/ perform: testSelector asSymbol

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

run
	| result |
	result := TestResult new.
	self run: result.
	^result
!

run: aResult
	aResult runCase: self
!

run: aResult afterEachDo:block2
        aResult runCase: self.
        block2 value:self value:aResult.
!

run: aResult beforeEachDo:block1 afterEachDo:block2
        block1 value:self value:aResult.
"/testSelector == #testReadStatement ifTrue:[self halt].
        aResult runCase: self.
        block2 value:self value:aResult.
!

runCase
        self setUp.
        [self performTest "self perform: testSelector asSymbol"] ensure: [self tearDown]

    "Modified: / 21.6.2000 / 10:04:18 / Sames"
!

runCaseAsFailure
        self setUp.
        [[self openDebuggerOnFailingTestMethod] ensure: [self tearDown]] fork

    "Modified: / 21.6.2000 / 10:04:33 / Sames"
!

setUp
!

tearDown
! !

!TestCase methodsFor:'testing'!

areAllResourcesAvailable
	^self resources 
		inject: true
		into: [:total :each | each isAvailable & total]
! !

!TestCase class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.33 2002-12-10 10:06:06 cg Exp $'
! !

TestCase initialize!