"{ 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 comment:'A TestCase is a Command representing the future running of a test case. Create one with the class method #selector: aSymbol, passing the name of the method to be run when the test case runs.

When you discover a new fixture, subclass TestCase, declare instance variables for the objects in the fixture, override #setUp to initialize the variables, and possibly override# tearDown to deallocate any external resources allocated in #setUp.

When you are writing a test case method, send #assert: aBoolean when you want to check for an expected value. For example, you might say "self assert: socket isOpen" to test whether or not a socket is open at a point in a test.'

!

!TestCase class methodsFor:'initialization'!

initialize

    ResumableTestFailure 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

! !

!TestCase class methodsFor:'accessing'!

allTestSelectors

!

forgetLastTestRunResult

    lastTestRunResultOrNil ~~ nil ifTrue:[

        lastTestRunResultOrNil := nil.

        self changed:#lastTestRunResult.

    ]

!

lastTestRunResultOrNil

    ^ lastTestRunResultOrNil

!

rememberFailedTest:selector

    lastTestRunsFailedTests isNil ifTrue:[

        lastTestRunsFailedTests := Set new.

    ].

    self rememberFailedTestRun

!

rememberFailedTestRun

    lastTestRunResultOrNil ~~ false ifTrue:[

        lastTestRunResultOrNil := false.

        self changed:#lastTestRunResult.

    ]

!

rememberFailedTestRunWithResult:result

    self rememberFailedTestRun.

    ].

!

rememberPassedTest:selector

    lastTestRunsFailedTests notNil ifTrue:[

    ].

!

rememberPassedTestRun

    lastTestRunResultOrNil ~~ true ifTrue:[

        lastTestRunResultOrNil := true.

        lastTestRunsFailedTests := nil.

        self changed:#lastTestRunResult.

    ]

!

resources

	^#()

!

sunitVersion

	^'3.1'

!

testSelectorFailed:selector

    ^ lastTestRunsFailedTests notNil and:[lastTestRunsFailedTests includes:selector]

!

testSelectors

        ^ (self selectors select: [:each | 'test*' match: each]) asOrderedCollection sort

! !

!TestCase class methodsFor:'building suites'!

buildSuite

	| suite |

	^self isAbstract

		ifTrue: 

			[suite := self suiteClass named: 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: (self suiteClass named: self name asString)

		into: [:suite :selector |

			suite

				addTest: (self selector: selector);

				yourself]

!

buildSuiteFromSelectors

	^self shouldInheritSelectors

		ifTrue: [self buildSuiteFromAllSelectors]

		ifFalse: [self buildSuiteFromLocalSelectors]

!

suiteClass

	^TestSuite

! !

!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

!

    result hasPassed ifTrue:[

        self rememberPassedTestRun

    ] ifFalse:[

        self rememberFailedTestRunWithResult:result

    ].

!

shouldInheritSelectors

	"I should inherit from an Abstract superclass but not from a concrete one by default, unless I have no testSelectors in which case I must be expecting to inherit them from my superclass.  If a test case with selectors wants to inherit selectors from a concrete superclass, override this to true in that subclass."

	^self superclass isAbstract

		or: [self testSelectors isEmpty]

"$QA Ignore:Sends system method(superclass)$"

! !

!TestCase methodsFor:'accessing'!

resources

	| allResources resourceQueue |

	allResources := Set new.

	resourceQueue := OrderedCollection new.

	resourceQueue addAll: self class resources.

	[resourceQueue isEmpty] whileFalse: [

		| next |

		next := resourceQueue removeFirst.

		allResources add: next.

		resourceQueue addAll: next resources].

	^allResources

!

selector

	^testSelector

! !

!TestCase methodsFor:'accessing & queries'!

unfinished

	"indicates an unfinished test"

! !

!TestCase methodsFor:'assertions'!

assert: aBoolean

    "fail, if the argument is not true"

"/        aBoolean ifFalse: [self signalFailure: 'Assertion failed']

    self assert: aBoolean message:'Assertion failed'

!

assert:aBlock completesInSeconds:aNumber

    "fail, if aBlock does not finish its work in aNumber seconds"

    |done process semaphore|

    done := false.

    semaphore := Semaphore new.

    [

        process := Processor activeProcess.

        aBlock value.

        done := true.

        semaphore signal

    ] fork.

    semaphore waitWithTimeout: aNumber.

    process terminate.

    self assert: done       

    "

     self new assert:[Delay waitForSeconds:2] completesInSeconds:1

    "

    "

     self new assert:[Delay waitForSeconds:1] completesInSeconds:2

    "

!

assert: aBoolean description: aString

        aBoolean ifFalse: [

                self logFailure: aString.

!

assert: aBoolean description: aString resumable: resumableBoolean 

        aBoolean

                ifFalse: 

                        [self logFailure: aString.

                         self signalFailure:aString resumable:resumableBoolean]

!

assert: aBoolean message:messageIfFailing

    "fail, if the argument is not true"

    "check the testCase itself"

    (aBoolean isBoolean) ifFalse:[ self error:'non boolean assertion' ].

!

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

!

deny: aBoolean description: aString

	self assert: aBoolean not description: aString

!

deny: aBoolean description: aString resumable: resumableBoolean 

	self

		assert: aBoolean not

		description: aString

		resumable: resumableBoolean

!

should:aBlock 

    "fail, if the block does not evaluate to true"

    self assert:aBlock value

!

should: aBlock description: aString

	self assert: aBlock value description: aString

!

should:aBlock raise:anExceptionalEvent 

    "fail, if the block does not raise the given event"

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

!

should: aBlock raise: anExceptionalEvent description: aString 

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

		description: aString

!

shouldnt:aBlock 

    "fail, if the block does evaluate to true"

    self deny:aBlock value

!

shouldnt: aBlock description: aString

	self deny: aBlock value description: aString

!

shouldnt:aBlock raise:anExceptionalEvent 

    "fail, if the block does raise the given event"

    ^ self 

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

!

shouldnt: aBlock raise: anExceptionalEvent description: aString 

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

! !

!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 printString;

"/                nextPutAll: '>>#';

"/                nextPutAll: testSelector

        aStream nextPutAll: self name.

        aStream nextPutAll: '>>'.

        testSelector printOn: aStream

!

testName

        ^ testSelector.

! !

!TestCase methodsFor:'private'!

executeShould: aBlock inScopeOf: anExceptionalEvent