TestCase.st
changeset 222 8e6f482297fa
parent 221 914934672e32
child 224 cd0749fcea80
--- a/TestCase.st	Wed Jun 29 20:38:32 2011 +0200
+++ b/TestCase.st	Wed Jun 29 21:15:49 2011 +0200
@@ -1,24 +1,21 @@
 "{ Package: 'stx:goodies/sunit' }"
 
-Object subclass:#TestCase
+TestAsserter subclass:#TestCase
 	instanceVariableNames:'testSelector'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'SUnit-Base'
 !
 
-TestCase class instanceVariableNames:'lastTestRunResultOrNil lastTestRunsFailedTests'
+TestCase class instanceVariableNames:'lastTestRunResultOrNil lastTestRunsPassedTests lastTestRunsFailedTests
+	lastTestRunsErrorTests'
 
 "
  No other class instance variables are inherited by this class.
 "
 !
 
-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 comment:''
 !
 
 
@@ -37,41 +34,42 @@
 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"
+	| answer pivotClass lookupRoot |
+	answer := Set withAll: self testSelectors.
+	self shouldInheritSelectors ifTrue:
+		[pivotClass := self.
+		lookupRoot := self lookupHierarchyRoot.
+		[pivotClass == lookupRoot] whileFalse:
+			[pivotClass := pivotClass superclass.
+			answer addAll: pivotClass testSelectors]].
+	^answer asSortedCollection asOrderedCollection
 !
 
 forgetLastTestRunResult
     lastTestRunResultOrNil ~~ nil ifTrue:[
-        lastTestRunResultOrNil := nil.
-        Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
-        self changed:#lastTestRunResult.
+	lastTestRunResultOrNil := nil.
+	Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
+	self changed:#lastTestRunResult.
     ]
 
     "Modified: / 06-08-2006 / 11:40:07 / cg"
@@ -79,37 +77,79 @@
 
 isTestSelector:aSelector
 
-    ^aSelector ~= #testName 
-        and:[aSelector startsWith: 'test']
+    ^aSelector startsWith:'test'
 
     "Created: / 06-08-2006 / 11:46:17 / cg"
-    "Modified: / 19-08-2009 / 14:42:58 / Jan Vrany <vranyj1@fel.cvut.cz>"
+    "Modified: / 05-12-2009 / 18:50:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+lastTestRunResult
+
+    | result |
+    result := TestResult new.
+    lastTestRunsPassedTests ? #() do:
+	[:selector|result passed add: (self selector: selector)].
+    lastTestRunsFailedTests ? #() do:
+	[:selector|result failures add: (self selector: selector)].
+    lastTestRunsErrorTests ? #() do:
+	[:selector|result errors add: (self selector: selector)].
+
+    "Created: / 15-03-2010 / 19:12:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 lastTestRunResultOrNil
     ^ lastTestRunResultOrNil
 !
 
-rememberFailedTest:selector
-    lastTestRunsFailedTests isNil ifTrue:[
-        lastTestRunsFailedTests := Set new.
+lookupHierarchyRoot
+	^TestCase
+!
+
+rememberErrorTest:selector
+
+    | emitChange |
+
+    lastTestRunsErrorTests isNil ifTrue:[
+	lastTestRunsErrorTests := Set new.
     ].
-    
-    (lastTestRunsFailedTests includes:selector) ifFalse:[
-        lastTestRunsFailedTests add:selector.
-        Smalltalk changed:#lastTestRunResult with:(Array with:self with:selector).
-        self changed:#lastTestRunResult with:selector.
-    ].
+
+    emitChange := (self removeSelector: selector from: lastTestRunsPassedTests).
+    emitChange := (self removeSelector: selector from: lastTestRunsFailedTests) or:[emitChange].
+    emitChange := (self addSelector: selector to: lastTestRunsErrorTests) or:[emitChange].
+
+    emitChange ifTrue:[self lastTestRunResultChanged: selector].
+
     self rememberFailedTestRun
 
     "Modified: / 06-08-2006 / 11:01:08 / cg"
+    "Created: / 15-03-2010 / 19:16:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+rememberFailedTest:selector
+
+    | emitChange |
+
+    lastTestRunsFailedTests isNil ifTrue:[
+	lastTestRunsFailedTests := Set new.
+    ].
+
+    emitChange := (self removeSelector: selector from: lastTestRunsPassedTests).
+    emitChange := (self removeSelector: selector from: lastTestRunsErrorTests) or:[emitChange].
+    emitChange := (self addSelector: selector to: lastTestRunsFailedTests) or:[emitChange].
+
+    emitChange ifTrue:[self lastTestRunResultChanged: selector].
+
+    self rememberFailedTestRun
+
+    "Modified: / 06-08-2006 / 11:01:08 / cg"
+    "Modified: / 15-03-2010 / 19:15:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 rememberFailedTestRun
     lastTestRunResultOrNil ~~ false ifTrue:[
-        lastTestRunResultOrNil := false.
-        Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
-        self changed:#lastTestRunResult.
+	lastTestRunResultOrNil := false.
+	Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
+	self changed:#lastTestRunResult.
     ]
 
     "Modified: / 06-08-2006 / 11:00:42 / cg"
@@ -124,7 +164,7 @@
 
 rememberFailedTestsFromResult:result
     (result failures union:result errors) do:[:eachFailedTest |
-        self rememberFailedTest:(eachFailedTest selector).
+	self rememberFailedTest:(eachFailedTest selector).
     ].
 
     "Created: / 05-08-2006 / 12:45:01 / cg"
@@ -132,35 +172,40 @@
 !
 
 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.
-            ].
-        ].
+
+    | emitChange |
+
+    lastTestRunsPassedTests isNil ifTrue:[
+	lastTestRunsPassedTests := Set new.
     ].
 
-    "Modified: / 06-08-2006 / 11:40:16 / cg"
+    emitChange := (self removeSelector: selector from: lastTestRunsFailedTests).
+    emitChange := (self removeSelector: selector from: lastTestRunsErrorTests) or:[emitChange].
+    emitChange := (self addSelector: selector to: lastTestRunsPassedTests) or:[emitChange].
+
+    emitChange ifTrue:[self lastTestRunResultChanged: selector].
+
+    self rememberPassedTestRun
+
+    "Modified: / 06-08-2006 / 11:01:08 / cg"
+    "Modified: / 15-03-2010 / 19:15:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 rememberPassedTestRun
     lastTestRunResultOrNil ~~ true ifTrue:[
-        lastTestRunResultOrNil := true.
-        lastTestRunsFailedTests := nil.
-        Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
-        self changed:#lastTestRunResult.
+	lastTestRunResultOrNil := true.
+	"/lastTestRunsFailedTests := nil.
+	Smalltalk changed:#lastTestRunResult with:(Array with:self with:nil).
+	self changed:#lastTestRunResult.
     ]
 
     "Modified: / 06-08-2006 / 11:01:22 / cg"
+    "Modified: / 15-03-2010 / 18:22:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 rememberPassedTestsFromResult:result
     (result passed) do:[:eachPassedTest |
-        self rememberPassedTest:(eachPassedTest selector).
+	self rememberPassedTest:(eachPassedTest selector).
     ].
 
     "Created: / 06-08-2006 / 10:29:47 / cg"
@@ -170,32 +215,36 @@
 resources
 
 	^#()
-			
+!
+
+shouldFork
+
+    ^false
+
+    "Created: / 13-06-2011 / 16:46:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 sunitVersion
-	^'3.1'
-			
+	^'4.0'
+!
+
+testSelectorError:selector
+    ^ lastTestRunsErrorTests notNil and:[lastTestRunsErrorTests includes:selector]
+
+    "Created: / 15-03-2010 / 19:44:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 testSelectorFailed:selector
-    ^ lastTestRunsFailedTests notNil and:[lastTestRunsFailedTests includes:selector]
+    ^ (lastTestRunsFailedTests notNil and:[lastTestRunsFailedTests includes:selector]) or:
+      [lastTestRunsErrorTests notNil and:[lastTestRunsErrorTests includes:selector]]
+
+    "Modified: / 15-03-2010 / 19:44:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
-testSelectors
-    "the default here is all methods in a test*-category;
-     this can, of course, be redefined in a testCase-class, which knows better"
-
-    ^ (self selectors select: [:each | 'test*' match: each]) asOrderedCollection sort
+testSelectorPassed:selector
+    ^ lastTestRunsPassedTests notNil and:[lastTestRunsPassedTests includes:selector]
 
-    "Modified: / 24-04-2010 / 14:04:51 / cg"
-!
-
-testedClasses
-    "for the browser and for coverage analysis:
-     return a collection of classNames, which are tested by this testCase"
-
-    ^ #()
+    "Created: / 15-03-2010 / 17:58:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !TestCase class methodsFor:'building suites'!
@@ -203,25 +252,12 @@
 buildSuite
 	| suite |
 	^self isAbstract
-		ifTrue: 
+		ifTrue:
 			[suite := self suiteClass named: self name asString.
-			self allSubclasses 
+			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
@@ -232,20 +268,14 @@
 			suite
 				addTest: (self selector: selector);
 				yourself]
-			
 !
 
 buildSuiteFromSelectors
-
-	^self shouldInheritSelectors
-		ifTrue: [self buildSuiteFromAllSelectors]
-		ifFalse: [self buildSuiteFromLocalSelectors]
-			
+	^self buildSuiteFromMethods: self allTestSelectors
 !
 
 suiteClass
 	^TestSuite
-			
 ! !
 
 !TestCase class methodsFor:'misc ui support'!
@@ -259,14 +289,56 @@
 
     lastResult := self lastTestRunResultOrNil.
     lastResult == true ifTrue:[
-        ^ #testCasePassedIcon
+	^ #testCasePassedIcon
     ].
     lastResult == false ifTrue:[
-        ^ #testCaseFailedIcon
+	^ #testCaseFailedIcon
     ].
     ^ #testCaseClassIcon
 ! !
 
+!TestCase class methodsFor:'private'!
+
+addSelector: selector to: collection
+
+    "Adds given selector from collection. Answers
+     true iff selector was really added"
+
+    ^(collection includes: selector)
+	ifTrue:[false]
+	ifFalse:[collection add: selector. true]
+
+    "Created: / 15-03-2010 / 18:06:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 21-04-2010 / 23:19:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+lastTestRunResultChanged: selector
+
+    Smalltalk changed:#lastTestRunResult with:(Array with:self with:selector).
+    self changed:#lastTestRunResult with:selector.
+
+    "Created: / 15-03-2010 / 19:15:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+removeSelector: selector from: collection
+
+    "Removes given selector from collection. Answers
+     true iff selector was really removed"
+
+    collection ifNil:[^false]." trivial case "
+    ^(collection includes: selector)
+	ifTrue:[collection remove: selector. true]
+	ifFalse:[false]
+
+    "Created: / 15-03-2010 / 18:05:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+testSelectors
+	"The API method is allTestSelectors which now includes #shouldInheritSelectors and so handles all cases.  Unlike that method, this does not guarantee to return a sorted ordered collection."
+
+	^self sunitSelectors select: [:each | 'test*' sunitMatch: each]
+! !
+
 !TestCase class methodsFor:'quick testing'!
 
 assert: aBoolean
@@ -288,17 +360,24 @@
 !TestCase class methodsFor:'testing'!
 
 isAbstract
-    "Override to true if a TestCase subclass is Abstract and should not have
-     TestCase instances built from it"
-    
-    ^ self == TestCase
+	"Override to true if a TestCase subclass is Abstract and should not have
+	TestCase instances built from it"
+
+	^self sunitName = #TestCase
+!
+
+isTestCaseLike
+
+    ^true
+
+    "Created: / 06-03-2011 / 00:16:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 rememberResult:result
     result hasPassed ifTrue:[
-        self rememberPassedTestRun
+	self rememberPassedTestRun
     ] ifFalse:[
-        self rememberFailedTestRunWithResult:result
+	self rememberFailedTestRunWithResult:result
     ].
 
     "Created: / 05-08-2006 / 12:33:08 / cg"
@@ -316,32 +395,28 @@
 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)$"
-			
+	^self ~~ self lookupHierarchyRoot
+		and: [self superclass isAbstract
+			or: [self testSelectors isEmpty]]
 ! !
 
 !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
-			
+	"We give TestCase this instance-side method so that methods polymorphic with TestSuite can be code-identical.  Having this instance-side method also helps when writing tests of resource behaviour. Except for such tests, it is rare to override this method and should not be done without thought.  If there were a good reason why a single test case needed to share tests requiring different resources, it might be legitimate."
+
+	^self class resources
 !
 
 selector
 	^testSelector
-			
+!
+
+shouldFork
+
+    ^self class shouldFork
+
+    "Created: / 13-06-2011 / 16:45:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !TestCase methodsFor:'accessing & queries'!
@@ -353,16 +428,6 @@
 
 !TestCase methodsFor:'assertions'!
 
-assert: aBoolean
-    "fail, if the argument is not true"
-
-    <resource: #skipInDebuggersWalkBack>
-
-"/        aBoolean ifFalse: [self signalFailure: 'Assertion failed']
-
-    self assert: aBoolean message:'Assertion failed'
-!
-
 assert:aBlock completesInSeconds:aNumber
     "fail, if aBlock does not finish its work in aNumber seconds"
 
@@ -373,13 +438,13 @@
     done := false.
     semaphore := Semaphore new.
     process := [
-        aBlock value.
-        done := true.
-        semaphore signal
+	aBlock value.
+	done := true.
+	semaphore signal
     ] fork.
     semaphore waitWithTimeout: aNumber.
     process terminate.
-    self assert: done       
+    self assert: done
 
     "
      self new assert:[Delay waitForSeconds:2] completesInSeconds:1
@@ -389,37 +454,11 @@
     "
 !
 
-assert:aBoolean description:aString 
-    <resource: #skipInDebuggersWalkBack>
-
-    aBoolean ifFalse:[
-        self logFailure:aString.
-        self signalFailure:aString resumable:true
-    ]
-
-    "Modified: / 06-08-2006 / 22:56:27 / cg"
-!
-
-assert:aBoolean description:aString resumable:resumableBoolean 
-    <resource: #skipInDebuggersWalkBack>
+assert: aBoolean message:messageIfFailing
 
-    aBoolean ifFalse:[
-        self logFailure:aString.
-        self signalFailure:aString resumable:resumableBoolean
-    ]
-!
-
-assert: aBoolean message:messageIfFailing
-    "fail, if the argument is not true"
+    ^self assert: aBoolean description: messageIfFailing
 
-    <resource: #skipInDebuggersWalkBack>
-
-    "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"
+    "Modified: / 05-12-2009 / 18:16:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 assertFalse:aBoolean
@@ -434,7 +473,7 @@
     ^ self assert:aBoolean not
 !
 
-assertTrue:aBoolean 
+assertTrue:aBoolean
     <resource: #skipInDebuggersWalkBack>
 
     ^ self assert:aBoolean
@@ -444,130 +483,64 @@
     <resource: #skipInDebuggersWalkBack>
 
     ^ self assert:aBoolean
-!
-
-deny:aBoolean 
-    "fail, if the argument is not false"
-    
-    <resource: #skipInDebuggersWalkBack>
-
-    self assert:aBoolean not
-!
-
-deny: aBoolean description: aString
-    <resource: #skipInDebuggersWalkBack>
-
-    self assert: aBoolean not description: aString
-!
-
-deny: aBoolean description: aString resumable: resumableBoolean 
-    <resource: #skipInDebuggersWalkBack>
-
-    self
-            assert: aBoolean not
-            description: aString
-            resumable: resumableBoolean
-!
-
-should:aBlock 
-    "fail, if the block does not evaluate to true"
-    
-    <resource: #skipInDebuggersWalkBack>
-
-    self assert:aBlock value
-!
-
-should: aBlock description: aString
-    <resource: #skipInDebuggersWalkBack>
-
-    self assert: aBlock value description: aString
-!
-
-should:aBlock raise:anExceptionalEvent 
-    "fail, if the block does not raise the given event"
-    
-    <resource: #skipInDebuggersWalkBack>
-
-    ^ self assert:(self executeShould:aBlock inScopeOf:anExceptionalEvent)
-!
-
-should: aBlock raise: anExceptionalEvent description: aString 
-    <resource: #skipInDebuggersWalkBack>
-
-    ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent)
-            description: aString
-!
-
-shouldnt:aBlock 
-    "fail, if the block does evaluate to true"
-    
-    <resource: #skipInDebuggersWalkBack>
-
-    self deny:aBlock value
-!
-
-shouldnt: aBlock description: aString
-    <resource: #skipInDebuggersWalkBack>
-
-    self deny: aBlock value description: aString
-!
-
-shouldnt:aBlock raise:anExceptionalEvent 
-    "fail, if the block does raise the given event"
-    
-    <resource: #skipInDebuggersWalkBack>
-
-    ^ self 
-        assert:(self executeShould:aBlock inScopeOf:anExceptionalEvent) not
-!
-
-shouldnt: aBlock raise: anExceptionalEvent description: aString 
-    <resource: #skipInDebuggersWalkBack>
-
-    ^self assert: (self executeShould: aBlock inScopeOf: anExceptionalEvent) not            description: aString
 ! !
 
 !TestCase methodsFor:'dependencies'!
 
-addDependentToHierachy: anObject 
+addDependentToHierachy: anObject
 	"an empty method. for Composite compability with TestSuite"
+!
 
+removeDependentFromHierachy: anObject
+	"an empty method. for Composite compability with TestSuite"
+! !
 
-			
+!TestCase methodsFor:'deprecated'!
+
+should: aBlock
+	self assert: aBlock value
 !
 
-removeDependentFromHierachy: anObject 
-	"an empty method. for Composite compability with TestSuite"
+should: aBlock description: aString
+	self assert: aBlock value description: aString
+!
 
+shouldnt: aBlock
+	self deny: aBlock value
+!
 
-			
+shouldnt: aBlock description: aString
+	self deny: aBlock value description: aString
+!
+
+signalFailure: aString
+	TestResult failure sunitSignalWith: aString.
 ! !
 
 !TestCase methodsFor:'printing'!
 
+getTestName
+
+    ^testSelector.
+
+    "Modified: / 05-12-2009 / 17:47:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 name
-        ^ self class name.
+	^ self class name.
 !
 
 printOn: aStream
 
-"/        aStream
-"/                nextPutAll: self class printString;
-"/                nextPutAll: '>>#';
-"/                nextPutAll: testSelector
-                        
-        aStream nextPutAll: self name.
-        aStream nextPutAll: '>>'.
-        testSelector printOn: aStream
-!
-
-testName
-        ^ testSelector.
+	aStream
+		nextPutAll: self class printString;
+		nextPutAll: '>>#';
+		nextPutAll: testSelector
 ! !
 
 !TestCase methodsFor:'private'!
 
-executeShould: aBlock inScopeOf: anExceptionalEvent 
+executeShould: aBlock inScopeOf: anExceptionalEvent
 "/        ^[aBlock value.
 "/        false] sunitOn: anExceptionalEvent
 "/                do: [:ex | ex sunitExitWith: true]
@@ -577,43 +550,36 @@
 "/                do: [:ex | ^true]]
 "/                        on: TestResult exError
 "/                        do: [:ex | ^false].
-        aBlock
-                on: anExceptionalEvent
-                do: [:ex | ^true].
+	[aBlock value]
+		on: anExceptionalEvent
+		do: [:ex | ^true].
 
-        ^false.
+	^false.
 !
 
 performTest
 
-        self perform: testSelector asSymbol
+	self perform: testSelector sunitAsSymbol
 !
 
 setTestSelector: aSymbol
 	testSelector := aSymbol
-			
 !
 
-signalFailure: aString
-
-"/        TestResult failure sunitSignalWith: aString
-    TestResult failure raiseErrorString:aString in:thisContext sender sender .
-!
-
-signalFailure:aString resumable:isResumable 
+signalFailure:aString resumable:isResumable
     "/        TestResult failure sunitSignalWith: aString
 
     <resource: #skipInDebuggersWalkBack>
 
     isResumable ifTrue:[
-        TestResult resumableFailure 
-            raiseRequestWith:nil
-            errorString:aString
-            in:thisContext sender sender
+	TestResult resumableFailure
+	    raiseRequestWith:nil
+	    errorString:aString
+	    in:thisContext sender sender
     ] ifFalse:[
-        TestResult failure 
-            raiseErrorString:aString 
-            in:thisContext sender sender
+	TestResult failure
+	    raiseErrorString:aString
+	    in:thisContext sender sender
     ].
 
     "Modified: / 06-08-2006 / 22:55:55 / cg"
@@ -621,10 +587,10 @@
 
 signalUnavailableResources
 
-    self resources do:[:res | 
-        res isAvailable ifFalse:[
-            ^ res signalInitializationError
-        ]
+    self resources do:[:res |
+	res isAvailable ifFalse:[
+	    ^ res signalInitializationError
+	]
     ].
 ! !
 
@@ -647,52 +613,33 @@
 !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]
+		sunitEnsure: [TestResource resetResources: self resources].
 !
 
 debugAsFailure
-    |semaphore|
-
-    self signalUnavailableResources.
-    semaphore := Semaphore new.
-    [
-        semaphore wait.
-        self resources do:[:each | 
-            each reset
-        ]
-    ] fork.
-
-    "/ used to be: 
-    "/  (self class selector:testSelector) runCaseAsFailure:semaphore
-    "/ which is bad for subclasses which need more arguments.
-    "/ why not use:
-    "/  self copy perform:aSymbol
-    "/ or even
-    "/  self perform:aSymbol
-    "/ (self class selector:testSelector) runCaseAsFailure:semaphore.
-    self runCaseAsFailure:semaphore
+	| semaphore |
+	semaphore := Semaphore new.
+	[semaphore wait. TestResource resetResources: self resources] fork.
+	(self class selector: testSelector) runCaseAsFailure: semaphore.
 !
 
-debugUsing:aSymbol 
+debugUsing:aSymbol
     self signalUnavailableResources.
     [
-        "/ used to be: 
-        "/  (self class selector:testSelector) perform:aSymbol
-        "/ which is bad for subclasses which need more arguments.
-        "/ why not use:
-        "/  self copy perform:aSymbol
-        "/ or even
-        "/  self perform:aSymbol
-        "/ (self class selector:testSelector) perform:aSymbol
-        self perform:aSymbol
+	"/ used to be:
+	"/  (self class selector:testSelector) perform:aSymbol
+	"/ which is bad for subclasses which need more arguments.
+	"/ why not use:
+	"/  self copy perform:aSymbol
+	"/ or even
+	"/  self perform:aSymbol
+	"/ (self class selector:testSelector) perform:aSymbol
+	self perform:aSymbol
     ] ensure:[
-        self resources do:[:each | 
-            each reset
-        ]
+	self resources do:[:each |
+	    each reset
+	]
     ]
 
 
@@ -705,106 +652,101 @@
 
 !
 
-failureLog      
-        ^SUnitNameResolver class >> #defaultLogDevice
+failureLog
+	^SUnitNameResolver class >> #defaultLogDevice
 !
 
 isLogging
-	"By default, we're not logging failures. If you override this in 
+	"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; 
+		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;"
-                performTest
+	self
+		"/halt;
+		performTest
+
+    "Modified: / 05-12-2009 / 18:40:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 run
 	| result |
 	result := TestResult new.
-	self run: result.
+	[self run: result]
+		sunitEnsure: [TestResource resetResources: self resources].
 	^result
-			
 !
 
 run: aResult
 	aResult runCase: self
-			
 !
 
 run: aResult afterEachDo:block2
-        aResult runCase: self.
-        block2 value:self value:aResult.
+	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.
+	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.
+	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 ]
-    ]
+	self resources do: [:each | each availableFor: self].
+	[self setUp.
+	self performTest] sunitEnsure: [self tearDown]
 !
 
 runCaseAsFailure
-        self setUp.
-        [[self openDebuggerOnFailingTestMethod] ensure: [self tearDown]] fork
+	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]
+	[self resources do: [:each | each availableFor: self].
+	[self setUp.
+	self openDebuggerOnFailingTestMethod]
+		sunitEnsure: [self tearDown]]
+			sunitEnsure: [aSemaphore signal].
 !
 
 setUp
-			
 !
 
 tearDown
-			
 ! !
 
 !TestCase class methodsFor:'documentation'!
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.57 2011-06-29 18:38:32 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.58 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+    ^ '§Id: TestCase.st 218 2011-06-13 15:45:06Z vranyj1 §'
 ! !
 
 TestCase initialize!