better update (name)
authorClaus Gittinger <cg@exept.de>
Wed, 21 Nov 2001 16:04:51 +0100
changeset 37 6da5b7e8e3ab
parent 36 6e7ee8f590b2
child 38 5fb751a669eb
better update (name)
TestCase.st
TestSuite.st
TestSuitesScripter.st
--- a/TestCase.st	Tue Oct 16 13:57:46 2001 +0200
+++ b/TestCase.st	Wed Nov 21 16:04:51 2001 +0100
@@ -40,12 +40,13 @@
 !
 
 suite
-	| testSelectors result |
-	testSelectors := self sunitSelectors select: [:each | 'test*' match: each].
-	testSelectors sort.
-	result := TestSuite new.
-	testSelectors do: [:each | result addTest: (self selector: each)].
-	^result
+        | testSelectors result |
+        testSelectors := self sunitSelectors select: [:each | 'test*' match: each].
+        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"
 ! !
@@ -130,6 +131,10 @@
 
 !TestCase methodsFor:'Printing'!
 
+name
+        ^ self class name.
+!
+
 printOn: aStream
 	aStream nextPutAll: self class name.
 	aStream nextPutAll: '>>'.
@@ -210,6 +215,6 @@
 !TestCase class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.14 2001-10-16 11:57:46 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.15 2001-11-21 15:04:51 cg Exp $'
 ! !
 TestCase initialize!
--- a/TestSuite.st	Tue Oct 16 13:57:46 2001 +0200
+++ b/TestSuite.st	Wed Nov 21 16:04:51 2001 +0100
@@ -1,7 +1,7 @@
 "{ Package: 'stx:goodies/sunit' }"
 
 Object subclass:#TestSuite
-	instanceVariableNames:'tests'
+	instanceVariableNames:'name tests'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'SUnit-Base'
@@ -18,6 +18,14 @@
 	aCollection do: [:eachTest | self addTest: eachTest]
 !
 
+name
+        ^ name ? 'a TestSuite'.
+!
+
+name:aString
+        name := aString
+!
+
 tests
 	tests isNil ifTrue: [tests := OrderedCollection new].
 	^tests
@@ -60,5 +68,5 @@
 !TestSuite class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuite.st,v 1.4 2001-09-04 13:07:06 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuite.st,v 1.5 2001-11-21 15:04:43 cg Exp $'
 ! !
--- a/TestSuitesScripter.st	Tue Oct 16 13:57:46 2001 +0200
+++ b/TestSuitesScripter.st	Wed Nov 21 16:04:51 2001 +0100
@@ -18,8 +18,8 @@
 
 !TestSuitesScripter class methodsFor:'Init / Release'!
 
-run: aString
-	^self new run: aString
+run: testClassNameString
+        ^self new run: testClassNameString
 !
 
 script: aString
@@ -69,6 +69,7 @@
 hierachyOfTestSuitesFrom: aTestCase 
         | subSuite |
         subSuite := TestSuite new.
+        subSuite name:aTestCase name.
         subSuite addTest: aTestCase suite.
         aTestCase allSubclasses do: [:each | subSuite addTest: each name asSymbol sunitAsClass suite].
         ^subSuite
@@ -95,10 +96,12 @@
 
 !TestSuitesScripter methodsFor:'Scripting'!
 
-run: aString
+run: testClassNameString
         | suite subSuite token |
         suite := TestSuite new.
-        stream := ReadStream on: aString asArrayOfSubstrings. 
+        suite name:testClassNameString.
+
+        stream := ReadStream on: testClassNameString asArrayOfSubstrings. 
         [stream atEnd] whileFalse: 
                 [token := self getNextToken.
                 token notNil ifTrue: [
@@ -116,5 +119,5 @@
 !TestSuitesScripter class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuitesScripter.st,v 1.4 2001-09-04 13:06:59 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/goodies/sunit/TestSuitesScripter.st,v 1.5 2001-11-21 15:04:36 cg Exp $'
 ! !