--- a/TestCase.st Fri Aug 29 20:36:18 2003 +0200
+++ b/TestCase.st Fri Sep 26 17:53:45 2003 +0200
@@ -14,6 +14,13 @@
"
!
+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'!
@@ -33,36 +40,34 @@
!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"
+ ^self buildSuite
+
! !
!TestCase class methodsFor:'accessing'!
allTestSelectors
- ^self sunitAllSelectors select: [:each | 'test*' match: each]
+
+ ^ (self allSelectors select: [:each | 'test*' match: each]) asOrderedCollection sort
!
forgetLastTestRunResult
@@ -95,7 +100,7 @@
rememberFailedTestRunWithResult:result
self rememberFailedTestRun.
- (result failures , result errors) do:[:eachFailedTest |
+ (result failures union:result errors) do:[:eachFailedTest |
|sel|
sel := eachFailedTest selector.
@@ -122,7 +127,14 @@
!
resources
+
^#()
+
+!
+
+sunitVersion
+ ^'3.1'
+
!
testSelectorFailed:selector
@@ -130,57 +142,67 @@
!
testSelectors
- ^self sunitSelectors select: [:each | 'test*' match: each]
+
+ ^ (self selectors select: [:each | 'test*' match: each]) asOrderedCollection sort
! !
-!TestCase class methodsFor:'building Suites'!
+!TestCase class methodsFor:'building suites'!
buildSuite
-
- | suite |
- ^self isAbstract
- ifTrue:
- [suite := TestSuite new.
-self halt.
- suite name: self name asString.
- self allSubclasses do: [:each | each isAbstract ifFalse: [suite addTest: each buildSuiteFromSelectors]].
- suite]
- ifFalse: [self buildSuiteFromSelectors]
+ | 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: ((TestSuite new)
- name: self name asString;
- yourself)
- into:
- [:suite :selector |
+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.
+ "Override to true if a TestCase subclass is Abstract and should not have
+ TestCase instances built from it"
+
+ ^ self name = #TestCase
!
runTests
@@ -196,9 +218,34 @@
!
shouldInheritSelectors
- "answer true to inherit selectors from superclasses"
+ "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'!
- ^true
+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'!
@@ -213,9 +260,7 @@
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']
+"/ aBoolean ifFalse: [self signalFailure: 'Assertion failed']
self assert: aBoolean message:'Assertion failed'
!
@@ -245,6 +290,20 @@
"
!
+assert: aBoolean description: aString
+ aBoolean ifFalse: [
+ self logFailure: aString.
+ self signalFailure: 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"
@@ -271,63 +330,85 @@
^ self assert:aBoolean
!
-deny: aBoolean
+deny:aBoolean
"fail, if the argument is not false"
+
+ self assert:aBoolean not
+!
- self assert: aBoolean not
+deny: aBoolean description: aString
+ self assert: aBoolean not description: aString
+
!
-resources
- ^self class resources
+deny: aBoolean description: aString resumable: resumableBoolean
+ self
+ assert: aBoolean not
+ description: aString
+ resumable: resumableBoolean
+
!
-selector
- ^testSelector
+should:aBlock
+ "fail, if the block does not evaluate to true"
+
+ self assert:aBlock value
!
-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
+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"
+
+ ^ self assert:(self executeShould:aBlock inScopeOf:anExceptionalEvent)
!
-shouldnt: aBlock
- "fail, if the block does evaluate to true"
-
- self deny: aBlock value
+should: aBlock raise: anExceptionalEvent description: aString
+ ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
+ description: aString
+
!
-shouldnt: aBlock raise: anExceptionalEvent
- "fail, if the block does raise the given event"
+shouldnt:aBlock
+ "fail, if the block does evaluate to true"
+
+ self deny:aBlock value
+!
- ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not
-
- "Modified: / 21.6.2000 / 10:01:16 / Sames"
+shouldnt: aBlock description: aString
+ self deny: aBlock value description: aString
+
!
-signalFailure: aString
- "/ TestResult failure sunitSignalWith: aString
- TestResult failure raiseErrorString:aString in:thisContext sender sender .
+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:34 / Sames"
+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'!
@@ -337,60 +418,136 @@
!
printOn: aStream
- aStream nextPutAll: self class name.
- aStream nextPutAll: '>>'.
- aStream nextPutAll: testSelector
- "Modified: / 4.4.2000 / 18:59:53 / Sames"
+"/ aStream
+"/ nextPutAll: self class printString;
+"/ nextPutAll: '>>#';
+"/ nextPutAll: testSelector
+
+ aStream nextPutAll: self name.
+ aStream nextPutAll: '>>'.
+ aStream nextPutAll: testSelector
! !
!TestCase methodsFor:'private'!
executeShould: aBlock inScopeOf: anExceptionalEvent
- [[aBlock value]
+"/ ^[aBlock value.
+"/ false] sunitOn: anExceptionalEvent
+"/ do: [:ex | ex sunitExitWith: true]
+
+"/ [[aBlock value]
+"/ on: anExceptionalEvent
+"/ do: [:ex | ^true]]
+"/ on: TestResult exError
+"/ do: [:ex | ^false].
+ [aBlock value]
on: anExceptionalEvent
- do: [:ex | ^true]]
- on: TestResult exError
- do: [:ex | ^false].
+ do: [:ex | ^true].
+
^false.
-
- "Modified: / 21.6.2000 / 10:03:03 / Sames"
!
performTest
+
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
+ ].
+!
+
+signalUnavailableResources
+
+ self resources do:[:res |
+ res isAvailable ifFalse:[
+ ^ res signalInitializationError
+ ]
+ ].
! !
!TestCase methodsFor:'running'!
debug
+
+"/ self signalUnavailableResources.
+"/ [(self class selector: testSelector) runCase]
+"/ sunitEnsure: [self resources do: [:each | each reset]]
self debugUsing:#runCase.
-"/ (self class selector: testSelector) runCase
!
debugAsFailure
- self debugUsing: #runCaseAsFailure
-"/ (self class selector: testSelector) runCaseAsFailure
+ |semaphore|
+
+ self signalUnavailableResources.
+ semaphore := Semaphore new.
+ [
+ semaphore wait.
+ self resources do:[:each |
+ each reset
+ ]
+ ] fork.
+ (self class selector:testSelector) runCaseAsFailure:semaphore.
!
-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]]
+debugUsing:aSymbol
+ self signalUnavailableResources.
+ [
+ (self class selector:testSelector) perform:aSymbol
+ ] ensure:[
+ self resources do:[:each |
+ each reset
+ ]
+ ]
+!
+
+failureLog
+ ^SUnitNameResolver class >> #defaultLogDevice
+!
+
+isLogging
+ "By default, we're not logging failures. If you override this in
+ a subclass, make sure that you override #failureLog"
+ ^false
+
+!
+
+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"
+ "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"
+ self
+ "halt;"
+ performTest
!
run
@@ -398,10 +555,12 @@
result := TestResult new.
self run: result.
^result
+
!
run: aResult
aResult runCase: self
+
!
run: aResult afterEachDo:block2
@@ -417,10 +576,9 @@
!
runCase
- self setUp.
- [self performTest "self perform: testSelector asSymbol"] ensure: [self tearDown]
- "Modified: / 21.6.2000 / 10:04:18 / Sames"
+ [self setUp.
+ self performTest] ensure: [self tearDown]
!
runCaseAsFailure
@@ -430,24 +588,25 @@
"Modified: / 21.6.2000 / 10:04:33 / Sames"
!
+runCaseAsFailure: aSemaphore
+ [self setUp.
+ self openDebuggerOnFailingTestMethod] ensure: [
+ self tearDown.
+ aSemaphore signal]
+!
+
setUp
+
!
tearDown
-! !
-
-!TestCase methodsFor:'testing'!
-
-areAllResourcesAvailable
- ^self resources
- inject: true
- into: [:total :each | each isAvailable & total]
+
! !
!TestCase class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.35 2003-08-25 11:44:02 tm Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.36 2003-09-26 15:53:09 stefan Exp $'
! !
TestCase initialize!