--- a/TestCase.st Thu Aug 31 11:23:04 2006 +0200
+++ b/TestCase.st Tue Sep 12 11:33:32 2006 +0200
@@ -1,4 +1,4 @@
-"{ Package: '__NoProject__' }"
+"{ Package: 'stx:goodies/sunit' }"
Object subclass:#TestCase
instanceVariableNames:'testSelector'
@@ -21,87 +21,285 @@
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:'documentation'!
+
+!TestCase class methodsFor:'initialization'!
-documentation
-"
- the concept of a prep, is to provide an opportunity to set up some UnitTestCase parameters
- before the fixture is setUp, there is a #defaultPrep, or a #prepFor_<eachTest>
+initialize
+ ResumableTestFailure autoload
- [author:]
- Keith Hodges (kh@cuthbert)
-
- [see also:]
+ "
+ self initialize
+ "
+! !
- [instance variables:]
+!TestCase class methodsFor:'instance creation'!
- [class variables:]
-"
+debug: aSymbol
+
+ ^(self selector: aSymbol) debug
+
!
-examples
-"
- examples to be added.
- [exBegin]
- ... add code fragment for
- ... executable example here ...
- [exEnd]
-"
+run: aSymbol
+
+ ^(self selector: aSymbol) run
+
!
-history
- "Created: / 9.7.1999 / 17:28:21 / kh"
-! !
-
-
-!TestCase class methodsFor:'instance creation'!
-
selector: aSymbol
^self new setTestSelector: aSymbol
+!
+
+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"
+!
-!TestCase class methodsFor:'running'!
+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"
+!
-allSelectorsPrefixed: string
+lastTestRunResultOrNil
+ ^ lastTestRunResultOrNil
+!
-| selectors |
+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"
+!
-selectors := OrderedCollection new.
+rememberFailedTestRunWithResult:result
+ self rememberFailedTestRun.
+ self rememberFailedTestsFromResult:result.
+
+ "Modified: / 05-08-2006 / 12:45:19 / cg"
+!
-"/self superclasses do: [ :class | selectors addAll: (class selectors select: [ :selector | selector startsWith: string ]) ].
+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"
+!
-selectors addAll: (self selectors select: [ :selector | selector startsWith: string ]).
+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"
+!
-^selectors
+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
+
+ ^#()
+
!
-allTestCases
+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]
+
+!
-^(self allSelectorsPrefixed: 'test') collect: [ :selector | self selector: selector ].
+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]
+
!
-runAllUnitTests
- | test |
- test := TestSuite named: (self name).
- test addTestCases: self allTestCases.
- ^test run
-"
-self run.
-Transcript showCR: self runAll.
-"
-
+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"
+! !
!TestCase methodsFor:'assertions'!
@@ -113,27 +311,161 @@
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.
+ 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
"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
@@ -144,16 +476,29 @@
aStream nextPutAll: self name.
aStream nextPutAll: '>>'.
testSelector printOn: aStream
+!
+
+testName
+ ^ testSelector.
! !
!TestCase methodsFor:'private'!
-errorException
+executeShould: aBlock inScopeOf: anExceptionalEvent
+"/ ^[aBlock value.
+"/ false] sunitOn: anExceptionalEvent
+"/ do: [:ex | ex sunitExitWith: true]
- ^self class errorSignal
+"/ [[aBlock value]
+"/ on: anExceptionalEvent
+"/ do: [:ex | ^true]]
+"/ on: TestResult exError
+"/ do: [:ex | ^false].
+ [aBlock value]
+ on: anExceptionalEvent
+ do: [:ex | ^true].
-
-
+ ^false.
!
performTest
@@ -161,28 +506,115 @@
self perform: testSelector asSymbol
!
-setSelector: aSymbol
- selector := aSymbol
+setTestSelector: aSymbol
+ testSelector := aSymbol
+
+!
+
+signalFailure: aString
+
+"/ TestResult failure sunitSignalWith: aString
+ TestResult failure raiseErrorString:aString in:thisContext sender sender .
+!
+
+signalFailure:aString resumable:isResumable
+ "/ TestResult failure sunitSignalWith: aString
+
+ isResumable ifTrue:[
+ TestResult resumableFailure
+ raiseRequestWith:nil
+ errorString:aString
+ in:thisContext sender sender
+ ] ifFalse:[
+ TestResult failure
+ raiseErrorString:aString
+ in:thisContext sender sender
+ ].
+
+ "Modified: / 06-08-2006 / 22:55:55 / cg"
+!
+
+signalUnavailableResources
+
+ self resources do:[:res |
+ res isAvailable ifFalse:[
+ ^ res signalInitializationError
+ ]
+ ].
! !
+!TestCase methodsFor:'queries'!
+
+isTestCase
+ ^ true
+!
+
+isTestSuite
+ ^ false
+! !
!TestCase methodsFor:'running'!
-defaultPrep
+debug
+
+"/ self signalUnavailableResources.
+"/ [(self class selector: testSelector) runCase]
+"/ sunitEnsure: [self resources do: [:each | each reset]]
+ self debugUsing:#runCase.
+!
-"prep methods are called before UnitTestCase-#setUp
- this is the default prep method if there
- is none defined for a unit test"
+debugAsFailure
+ |semaphore|
+
+ self signalUnavailableResources.
+ semaphore := Semaphore new.
+ [
+ semaphore wait.
+ self resources do:[:each |
+ each reset
+ ]
+ ] fork.
+ (self class selector:testSelector) runCaseAsFailure:semaphore.
!
-prepTest
+debugUsing:aSymbol
+ self signalUnavailableResources.
+ [
+ (self class selector:testSelector) perform:aSymbol
+ ] ensure:[
+ self resources do:[:each |
+ each reset
+ ]
+ ]
+!
-| prepSelector |
+failureLog
+ ^SUnitNameResolver class >> #defaultLogDevice
+!
-prepSelector := ('prepFor_', selector) asSymbol.
+isLogging
+ "By default, we're not logging failures. If you override this in
+ a subclass, make sure that you override #failureLog"
+ ^false
+
+!
-(self respondsTo: prepSelector) ifTrue: [ self perform: prepSelector ]
- ifFalse: [ self defaultPrep ].
+logFailure: aString
+ self isLogging ifTrue: [
+ self failureLog
+ cr;
+ nextPutAll: aString;
+ flush]
+
+!
+
+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;"
+ performTest
!
run
@@ -198,6 +630,52 @@
!
+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.
+!
+
+run: aResult beforeEachTestCaseDo:block1 afterEachTestCaseDo:block2
+ block1 value:self value:aResult.
+ aResult runCase: self.
+ block2 value:self value:aResult.
+!
+
+runCase
+ [
+ self setUp.
+ self performTest
+ ] ensure:[
+ Error , AbortOperationRequest
+ handle:[:ex |
+ ex signal ~~ AbortOperationRequest ifTrue:[
+ Transcript showCR:'Error during tearDown: "', ex description, '" - ignored'.
+ ]
+ ]
+ do:[ self tearDown ]
+ ]
+!
+
+runCaseAsFailure
+ self setUp.
+ [[self openDebuggerOnFailingTestMethod] ensure: [self tearDown]] fork
+
+ "Modified: / 21.6.2000 / 10:04:33 / Sames"
+!
+
+runCaseAsFailure: aSemaphore
+ [self setUp.
+ self openDebuggerOnFailingTestMethod] ensure: [
+ self tearDown.
+ aSemaphore signal]
+!
+
setUp
!
@@ -206,16 +684,10 @@
! !
-!TestCase methodsFor:'set up'!
-
-onSetUpFailed
- "Run whatever code you need to tidy up if the Setup procedure fails"
-! !
-
!TestCase class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.43 2006-08-31 09:23:04 boris Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.44 2006-09-12 09:33:32 cg Exp $'
! !
TestCase initialize!