--- 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!
--- a/TestResource.st Fri Aug 29 20:36:18 2003 +0200
+++ b/TestResource.st Fri Sep 26 17:53:45 2003 +0200
@@ -18,74 +18,117 @@
!TestResource class methodsFor:'accessing'!
current
- current isNil ifTrue: [current := self new].
+
+ current isNil
+ ifTrue: [current := self new].
+
^current
+
!
current: aTestResource
+
current := aTestResource
+
+!
+
+resources
+ ^#()
+
! !
!TestResource class methodsFor:'creation'!
new
+
^super new initialize
+
!
reset
- current notNil ifTrue:
- [current tearDown.
- current := nil]
- "self withAllSubclassesDo:[:each| each reset]"
+ current notNil ifTrue: [
+ [current tearDown] ensure: [
+ current := nil]]
+
+!
+
+signalInitializationError
+ ^TestResult signalErrorWith: 'Resource ' , self name , ' could not be initialized'
+
! !
!TestResource class methodsFor:'testing'!
isAbstract
- "Override to true if a TestCase subclass is Abstract and should not have
- TestCase instances built from it"
- ^self name = #TestResource
+ "Override to true if a TestResource subclass is Abstract and should not have
+ TestCase instances built from it"
+
+ ^ self name == #TestResource
!
isAvailable
- ^self current notNil
+ ^self current notNil and: [self current isAvailable]
+
!
isUnavailable
+
^self isAvailable not
+
! !
!TestResource methodsFor:'accessing'!
description
- description isNil ifTrue: [^''].
+
+ description isNil
+ ifTrue: [^''].
+
^description
+
!
description: aString
+
description := aString
+
!
name
- name isNil ifTrue: [^self printString].
+
+ name isNil
+ ifTrue: [^self printString].
+
^name
+
!
name: aString
+
name := aString
+
+!
+
+resources
+ ^self class resources
+
! !
!TestResource methodsFor:'init / release'!
initialize
- self setUp
+ self setUp
+
+
! !
!TestResource methodsFor:'printing'!
printOn: aStream
+
aStream nextPutAll: self class printString
+
! !
!TestResource methodsFor:'running'!
@@ -93,27 +136,40 @@
setUp
"Does nothing. Subclasses should override this
to initialize their resource"
+
+!
+
+signalInitializationError
+ ^self class signalInitializationError
+
!
tearDown
"Does nothing. Subclasses should override this
to tear down their resource"
+
! !
!TestResource methodsFor:'testing'!
isAvailable
- "override to provide information on the readiness of the resource"
+ "override to provide information on the
+ readiness of the resource"
+
^true
+
!
isUnavailable
- "override to provide information on the readiness of the resource"
+ "override to provide information on the
+ readiness of the resource"
+
^self isAvailable not
+
! !
!TestResource class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResource.st,v 1.3 2002-06-19 12:21:01 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestResource.st,v 1.4 2003-09-26 15:53:19 stefan Exp $'
! !
--- a/TestSuite.st Fri Aug 29 20:36:18 2003 +0200
+++ b/TestSuite.st Fri Sep 26 17:53:45 2003 +0200
@@ -1,96 +1,104 @@
"{ Package: 'stx:goodies/sunit' }"
Object subclass:#TestSuite
- instanceVariableNames:'name tests resources'
+ instanceVariableNames:'tests resources name'
classVariableNames:''
poolDictionaries:''
category:'SUnit-Base'
!
+TestSuite comment:'This is a Composite of Tests, either TestCases or other TestSuites. The common protocol is #run: aTestResult and the dependencies protocol'
+!
-!TestSuite class methodsFor:'creation'!
+
+!TestSuite class methodsFor:'Creation'!
named: aString
- ^self new
- name: aString;
- yourself
+
+ ^self new
+ name: aString;
+ yourself
+
! !
!TestSuite methodsFor:'accessing'!
addTest: aTest
self tests add: aTest
+
!
addTests: aCollection
aCollection do: [:eachTest | self addTest: eachTest]
+
!
defaultResources
^self tests
inject: Set new
- into:
- [:coll :testCase |
+ into: [:coll :testCase |
coll
addAll: testCase resources;
yourself]
+
!
name
+
^ name ? 'a TestSuite'.
!
-name:aString
- name := aString
+name: aString
+
+ name := aString
+
!
resources
resources isNil ifTrue: [resources := self defaultResources].
^resources
+
!
resources: anObject
resources := anObject
+
!
tests
tests isNil ifTrue: [tests := OrderedCollection new].
^tests
+
! !
!TestSuite methodsFor:'dependencies'!
addDependentToHierachy: anObject
self addDependent: anObject.
- self tests do: [:each | each addDependentToHierachy: anObject]
-
- "Modified: / 21.6.2000 / 10:13:35 / Sames"
+ self tests do: [ :each | each addDependentToHierachy: anObject]
!
removeDependentFromHierachy: anObject
self removeDependent: anObject.
- self tests do: [:each | each removeDependentFromHierachy: anObject]
-
- "Modified: / 21.6.2000 / 10:13:27 / Sames"
+ self tests do: [ :each | each removeDependentFromHierachy: anObject]
! !
!TestSuite methodsFor:'running'!
run
| result |
+
+ self signalUnavailableResources.
+
result := TestResult new.
- self areAllResourcesAvailable ifFalse: [^TestResult signalErrorWith: 'Resource could not be initialized'].
[self run: result] ensure: [self resources do: [:each | each reset]].
^result
!
run: aResult
- self tests do:
- [:each |
+ self tests do: [:each |
self changed: each.
each run: aResult]
-
- "Modified: / 21.6.2000 / 10:14:01 / Sames"
!
run: aResult afterEachDo:block2
@@ -121,10 +129,19 @@
^self resources
inject: true
into: [:total :each | each isAvailable & total]
+!
+
+signalUnavailableResources
+
+ self resources do:[:res |
+ res isAvailable ifFalse:[
+ ^ res signalInitializationError
+ ]
+ ].
! !
!TestSuite class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuite.st,v 1.12 2002-12-10 09:53:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuite.st,v 1.13 2003-09-26 15:53:45 stefan Exp $'
! !