"{ 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

!

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

! !

TestCase initialize!