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

Object subclass:#TestCase

	instanceVariableNames:'testSelector'

	classVariableNames:''

	poolDictionaries:''

	category:'SUnit-Base'

!

!TestCase class methodsFor:'initialization'!

initialize

    "ensure, that the sunit extensions are loaded"

    (Class includesSelector:#sunitName) ifFalse:[

        Smalltalk fileIn:'extensions.st' inPackage:(self package)

    ].    

    TestFailure isLoaded ifFalse:[

        TestFailure autoload

    ].

    "

     self initialize

    "

! !

!TestCase class methodsFor:'Building Suites'!

buildSuite

	| suite |

	^self isAbstract 

		ifTrue: 

			[suite := TestSuite new.

			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:'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 sunitSelectors select: [:each | 'test*' match: each].

        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"

! !

isAbstract

	"Override to true if a TestCase subclass is Abstract and should not have

	TestCase instances built from it"

	^self name = #TestCase.

!

shouldInheritSelectors

	"answer true to inherit selectors from superclasses"

	^true

! !

!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 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.

        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

! !

areAllResourcesAvailable

	^self resources 

		inject: true

		into: [:total :each | each isAvailable & total]

! !

!TestCase class methodsFor:'documentation'!

version

! !

TestCase initialize!