TestSuite.st
changeset 222 8e6f482297fa
parent 202 46947f02aaa4
child 238 384805dcb5dd
--- a/TestSuite.st	Wed Jun 29 20:38:32 2011 +0200
+++ b/TestSuite.st	Wed Jun 29 21:15:49 2011 +0200
@@ -7,51 +7,54 @@
 	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 comment:''
 !
 
 
-!TestSuite class methodsFor:'Creation'!
+!TestSuite class methodsFor:'instance creation'!
 
 named: aString
 
 	^self new
 		name: aString;
 		yourself
-			
 ! !
 
 !TestSuite methodsFor:'accessing'!
 
 addTest: aTest
 	self tests add: aTest
-			
 !
 
-addTests: aCollection 
+addTests: aCollection
 	aCollection do: [:eachTest | self addTest: eachTest]
-			
 !
 
 defaultResources
-	^self tests 
-		inject: Set new
-		into: [:coll :testCase | 
-			coll
-				addAll: testCase resources;
-				yourself]
-			
+	^self tests
+		inject: OrderedCollection new
+		into:
+			[:coll :testCase |
+			testCase resources do:
+				[:each |
+				(coll includes: each) ifFalse: [coll add: each]].
+			coll]
+!
+
+getTestName
+    ^self name
+
+    "Created: / 12-09-2006 / 11:38:09 / cg"
 !
 
 name
 
-        ^ name ? 'a TestSuite'.
+	^name
 !
 
 name: aString
 
 	name := aString
-			
 !
 
 nameOfTest
@@ -61,36 +64,29 @@
 resources
 	resources isNil ifTrue: [resources := self defaultResources].
 	^resources
-			
 !
 
-resources: anObject
-	resources := anObject
-			
-!
+resources: someOrderedTestResourceClasses
+	"The parameter should understand reverseDo: and should not contain duplicates."
 
-testName
-    ^ self name
-
-    "Created: / 12-09-2006 / 11:38:09 / cg"
+	resources := someOrderedTestResourceClasses
 !
 
 tests
 	tests isNil ifTrue: [tests := OrderedCollection new].
 	^tests
-			
 ! !
 
 !TestSuite methodsFor:'dependencies'!
 
 addDependentToHierachy: anObject
-        self addDependent: anObject.
-        self tests do: [ :each | each addDependentToHierachy: anObject]
+	self sunitAddDependent: anObject.
+	self tests do: [ :each | each addDependentToHierachy: anObject]
 !
 
 removeDependentFromHierachy: anObject
-        self removeDependent: anObject.
-        self tests do: [ :each | each removeDependentFromHierachy: anObject]
+	self sunitRemoveDependent: anObject.
+	self tests do: [ :each | each removeDependentFromHierachy: anObject]
 ! !
 
 !TestSuite methodsFor:'queries'!
@@ -106,80 +102,117 @@
 !TestSuite methodsFor:'running'!
 
 run
-        | result |
-
-        self signalUnavailableResources.
+	| result |
+	result := TestResult new.
+	[self run: result]
+		"sunitEnsure: [self resources reverseDo: [:each | each reset]]."
+			sunitEnsure: [TestResource resetResources: self resources].
+	^result
 
-        result := TestResult new.
-        [self run: result] ensure: [self resources do: [:each | each reset]].
-        ^result
+    "Modified: / 11-09-2010 / 16:47:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
-run: aResult 
-        self tests do: [:each | 
-                self changed: each.
-                each run: aResult]
+run:aResult
+
+    aResult name:name.
+    self tests do:[:each |
+	self sunitChanged:each.
+	each run:aResult
+    ]
+
+    "Modified: / 19-03-2010 / 08:03:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 run: aResult afterEachDo:block2
-        self tests do: 
-                [:each | 
-                self changed: each.
-                each run: aResult afterEachDo:block2.
-"/                block2 value:each value:aResult
-                ]
 
-    "Modified: / 21.6.2000 / 10:14:01 / Sames"
+    aResult name: name.
+    self tests do:
+	[:each |
+	self changed: each.
+	each run: aResult afterEachDo:block2]
+
+    "Modified: / 21-06-2000 / 10:14:01 / Sames"
+    "Modified: / 19-03-2010 / 08:01:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
-run: aResult beforeEachDo:block1 afterEachDo:block2
-
-       |class|
-
-        class := Smalltalk classNamed:name.
-        class perform:#setUp ifNotUnderstood:nil.
+run:aResult beforeEachDo:block1 afterEachDo:block2
+    |class|
 
-        [
-            self tests do: 
-                    [:each | 
-                    self changed: each.
-                    block1 value:each value:aResult.
-                    each run: aResult beforeEachDo:block1 afterEachDo:block2.
-                    "/ each run: aResult.
-                    block2 value:each value:aResult.
-                    ].
-        ] ensure: [self resources do:[:e|e reset]].
+    aResult name: name.
+    class := name ifNotNil:[ Smalltalk classNamed:name ] ifNil:[ nil ].
+    class ifNotNil:[ class perform:#setUp ifNotUnderstood:nil ].
+    [
+	self tests do:[:each |
+	    self sunitChanged:each.
+	    block1 value:each value:aResult.
+	    each
+		run:aResult
+		beforeEachDo:block1
+		afterEachDo:block2.
 
-        class perform:#tearDown ifNotUnderstood:nil
+	    "/ each run: aResult.
+
+	    block2 value:each value:aResult.
+	].
+    ] ensure:[
+	self resources do:[:e |
+	    e reset
+	]
+    ].
+    class ifNotNil:[ class perform:#tearDown ifNotUnderstood:nil ]
+
+    "Modified: / 19-03-2010 / 08:02:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
-run: aResult beforeEachTestCaseDo:block1 afterEachTestCaseDo:block2
-        self tests do: 
-                [:each | 
-                self changed: each.
-                each run: aResult beforeEachTestCaseDo:block1 afterEachTestCaseDo:block2.
-                ]
+run:aResult beforeEachTestCaseDo:block1 afterEachTestCaseDo:block2
+
+    aResult name: name.
+    self tests do:[:each |
+	self changed:each.
+	each
+	    run:aResult
+	    beforeEachTestCaseDo:block1
+	    afterEachTestCaseDo:block2.
+    ]
+
+    "Modified: / 19-03-2010 / 08:02:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+runAfterEachDo: aBlock
+	| result |
+	result := TestResult new.
+	result name: name.
+	[self run: result afterEachDo: aBlock]
+		sunitEnsure: [self resources reverseDo: [:each | each reset]].
+	^result
+
+    "Created: / 15-03-2010 / 20:36:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 19-03-2010 / 08:02:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !TestSuite methodsFor:'testing'!
 
 areAllResourcesAvailable
-	^self resources 
+	^self resources
 		inject: true
 		into: [:total :each | each isAvailable & total]
 !
 
 signalUnavailableResources
 
-    self resources do:[:res | 
-        res isAvailable ifFalse:[
-            ^ res signalInitializationError
-        ]
+    self resources do:[:res |
+	res isAvailable ifFalse:[
+	    ^ res signalInitializationError
+	]
     ].
 ! !
 
 !TestSuite class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuite.st,v 1.18 2009-09-21 08:10:10 fm Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuite.st,v 1.19 2011-06-29 19:15:49 cg Exp $'
+!
+
+version_SVN
+    ^ '§Id: TestSuite.st 203 2010-09-11 14:49:03Z vranyj1 §'
 ! !