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

!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

!

suite

	^self buildSuite

!TestCase class methodsFor:'accessing'!

allTestSelectors

        ^ (self allSelectors select: [:each | self isTestSelector:each]) asOrderedCollection sort

    "Modified: / 06-08-2006 / 11:46:32 / cg"

!

forgetLastTestRunResult

    lastTestRunResultOrNil ~~ nil ifTrue:[

        lastTestRunResultOrNil := nil.

        Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).

        self changed:#lastTestRunResult.

    ]

    "Modified: / 06-08-2006 / 11:40:07 / cg"

!

isTestSelector:aSelector

        ^ 'test*' match: aSelector

    "Created: / 06-08-2006 / 11:46:17 / cg"

!

lastTestRunResultOrNil

    ^ lastTestRunResultOrNil

!

rememberFailedTest:selector

    lastTestRunsFailedTests isNil ifTrue:[

        lastTestRunsFailedTests := Set new.

    ].

    (lastTestRunsFailedTests includes:selector) not ifTrue:[

        lastTestRunsFailedTests add:selector.

        Smalltalk changed:#lastTestRunResult with:(Array with:self with:selector).

        self changed:#lastTestRunResult with:selector.

    ].

    self rememberFailedTestRun

    "Modified: / 06-08-2006 / 11:01:08 / cg"

!

rememberFailedTestRun

    lastTestRunResultOrNil ~~ false ifTrue:[

        lastTestRunResultOrNil := false.

        Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).

        self changed:#lastTestRunResult.

    ]

    "Modified: / 06-08-2006 / 11:00:42 / cg"

!

rememberFailedTestRunWithResult:result

    self rememberFailedTestRun.

    self rememberFailedTestsFromResult:result.

    "Modified: / 05-08-2006 / 12:45:19 / cg"

!

rememberFailedTestsFromResult:result

    (result failures union:result errors) do:[:eachFailedTest |

        self rememberFailedTest:(eachFailedTest selector).

    ].

    "Created: / 05-08-2006 / 12:45:01 / cg"

    "Modified: / 06-08-2006 / 10:54:31 / cg"

!

rememberPassedTest:selector

    lastTestRunsFailedTests notNil ifTrue:[

        (lastTestRunsFailedTests includes:selector) ifTrue:[

            lastTestRunsFailedTests remove:selector ifAbsent:nil.

            Smalltalk changed:#lastTestRunResult with:(Array with:self with:selector).

            self changed:#lastTestRunResult with:selector.

            lastTestRunsFailedTests isEmpty ifTrue:[

                lastTestRunsFailedTests := nil.

                self forgetLastTestRunResult.

            ].

        ].

    ].

    "Modified: / 06-08-2006 / 11:40:16 / cg"

!

rememberPassedTestRun

    lastTestRunResultOrNil ~~ true ifTrue:[

        lastTestRunResultOrNil := true.

        lastTestRunsFailedTests := nil.

        Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).

        self changed:#lastTestRunResult.

    ]

    "Modified: / 06-08-2006 / 11:01:22 / cg"

!

rememberPassedTestsFromResult:result

    (result passed) do:[:eachPassedTest |

        self rememberPassedTest:(eachPassedTest selector).

    ].

    "Created: / 06-08-2006 / 10:29:47 / cg"

    "Modified: / 06-08-2006 / 11:42:01 / cg"

!

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

!

rememberResult:result

    result hasPassed ifTrue:[

        self rememberPassedTestRun

    ] ifFalse:[

        self rememberFailedTestRunWithResult:result

    ].

    "Created: / 05-08-2006 / 12:33:08 / cg"

!

runTests

    |result|

    result := self suite run.

    self rememberResult:result.

    "Modified: / 05-08-2006 / 12:33:20 / cg"

!

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"

! !

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.

                self signalFailure: aString resumable:true]

    "Modified: / 06-08-2006 / 22:56:27 / cg"

!

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' ].

    aBoolean ifFalse: [self signalFailure: messageIfFailing resumable:true]

    "Modified: / 21-06-2000 / 10:00:05 / Sames"

    "Modified: / 06-08-2006 / 22:56:21 / cg"

!

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 description: aString

	self assert: aBlock value description: aString

!

should: aBlock raise: anExceptionalEvent description: aString 

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

		description: aString

!

!

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"

! !

name

        ^ self class name.

!

!

testName

        ^ testSelector.

executeShould: aBlock inScopeOf: anExceptionalEvent 

"/        ^[aBlock value.

"/        false] sunitOn: anExceptionalEvent

"/                do: [:ex | ex sunitExitWith: true]