--- a/TestCase.st Thu Aug 31 11:23:00 2006 +0200
+++ b/TestCase.st Thu Aug 31 11:23:04 2006 +0200
@@ -1,4 +1,4 @@
-"{ Package: 'stx:goodies/sunit' }"
+"{ Package: '__NoProject__' }"
Object subclass:#TestCase
instanceVariableNames:'testSelector'
@@ -21,285 +21,87 @@
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>
+
+ [author:]
+ Keith Hodges (kh@cuthbert)
+
+ [see also:]
+
+ [instance variables:]
-initialize
- ResumableTestFailure autoload
+ [class variables:]
+"
+!
- "
- self initialize
- "
+examples
+"
+ examples to be added.
+ [exBegin]
+ ... add code fragment for
+ ... executable example here ...
+ [exEnd]
+"
+!
+
+history
+ "Created: / 9.7.1999 / 17:28:21 / kh"
! !
+
!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
-
- ^ (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"
-!
+!TestCase class methodsFor:'running'!
-lastTestRunResultOrNil
- ^ lastTestRunResultOrNil
-!
+allSelectorsPrefixed: string
-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 |
-rememberFailedTestRunWithResult:result
- self rememberFailedTestRun.
- self rememberFailedTestsFromResult:result.
-
- "Modified: / 05-08-2006 / 12:45:19 / cg"
-!
+selectors := OrderedCollection new.
-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"
-!
+"/self superclasses do: [ :class | selectors addAll: (class 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 addAll: (self selectors select: [ :selector | selector startsWith: string ]).
-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"
-!
+^selectors
-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
+allTestCases
- ^ (self selectors select: [:each | 'test*' match: each]) asOrderedCollection sort
-! !
-
-!TestCase class methodsFor:'building suites'!
+^(self allSelectorsPrefixed: 'test') collect: [ :selector | self selector: selector ].
-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
+runAllUnitTests
+ | test |
+ test := TestSuite named: (self name).
+ test addTestCases: self allTestCases.
+ ^test run
+"
+self run.
+Transcript showCR: self runAll.
+"
- ^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"
-! !
!TestCase methodsFor:'assertions'!
@@ -311,161 +113,27 @@
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
@@ -476,29 +144,16 @@
aStream nextPutAll: self name.
aStream nextPutAll: '>>'.
testSelector printOn: aStream
-!
-
-testName
- ^ testSelector.
! !
!TestCase methodsFor:'private'!
-executeShould: aBlock inScopeOf: anExceptionalEvent
-"/ ^[aBlock value.
-"/ false] sunitOn: anExceptionalEvent
-"/ do: [:ex | ex sunitExitWith: true]
+errorException
-"/ [[aBlock value]
-"/ on: anExceptionalEvent
-"/ do: [:ex | ^true]]
-"/ on: TestResult exError
-"/ do: [:ex | ^false].
- [aBlock value]
- on: anExceptionalEvent
- do: [:ex | ^true].
+ ^self class errorSignal
- ^false.
+
+
!
performTest
@@ -506,115 +161,28 @@
self perform: testSelector asSymbol
!
-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
- ]
- ].
+setSelector: aSymbol
+ selector := aSymbol
! !
-!TestCase methodsFor:'queries'!
-
-isTestCase
- ^ true
-!
-
-isTestSuite
- ^ false
-! !
!TestCase methodsFor:'running'!
-debug
-
-"/ self signalUnavailableResources.
-"/ [(self class selector: testSelector) runCase]
-"/ sunitEnsure: [self resources do: [:each | each reset]]
- self debugUsing:#runCase.
-!
+defaultPrep
-debugAsFailure
- |semaphore|
-
- self signalUnavailableResources.
- semaphore := Semaphore new.
- [
- semaphore wait.
- self resources do:[:each |
- each reset
- ]
- ] fork.
- (self class selector:testSelector) runCaseAsFailure:semaphore.
+"prep methods are called before UnitTestCase-#setUp
+ this is the default prep method if there
+ is none defined for a unit test"
!
-debugUsing:aSymbol
- self signalUnavailableResources.
- [
- (self class selector:testSelector) perform:aSymbol
- ] ensure:[
- self resources do:[:each |
- each reset
- ]
- ]
-!
+prepTest
-failureLog
- ^SUnitNameResolver class >> #defaultLogDevice
-!
+| prepSelector |
-isLogging
- "By default, we're not logging failures. If you override this in
- a subclass, make sure that you override #failureLog"
- ^false
-
-!
+prepSelector := ('prepFor_', selector) asSymbol.
-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
+(self respondsTo: prepSelector) ifTrue: [ self perform: prepSelector ]
+ ifFalse: [ self defaultPrep ].
!
run
@@ -630,52 +198,6 @@
!
-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
!
@@ -684,10 +206,16 @@
! !
+!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.42 2006-08-07 10:59:21 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.43 2006-08-31 09:23:04 boris Exp $'
! !
TestCase initialize!