remember individual failed cases.
--- a/TestCase.st Thu Nov 07 19:03:46 2002 +0100
+++ b/TestCase.st Mon Nov 11 10:50:19 2002 +0100
@@ -7,7 +7,7 @@
category:'SUnit-Base'
!
-TestCase class instanceVariableNames:'lastTestrunResultOrNil'
+TestCase class instanceVariableNames:'lastTestRunResultOrNil lastTestRunsFailedTests'
"
No other class instance variables are inherited by this class.
@@ -64,28 +64,56 @@
!
forgetLastTestRunResult
- lastTestrunResultOrNil ~~ nil ifTrue:[
- lastTestrunResultOrNil := nil.
+ lastTestRunResultOrNil ~~ nil ifTrue:[
+ lastTestRunResultOrNil := nil.
Smalltalk changed:#lastTestRunResult with:self.
self changed:#lastTestRunResult.
]
!
-lastTestrunResultOrNil
- ^ lastTestrunResultOrNil
+lastTestRunResultOrNil
+ ^ lastTestRunResultOrNil
+!
+
+rememberFailedTest:selector
+ lastTestRunsFailedTests isNil ifTrue:[
+ lastTestRunsFailedTests := Set new.
+ ].
+ lastTestRunsFailedTests add:selector.
+ self rememberFailedTestRun
!
rememberFailedTestRun
- lastTestrunResultOrNil ~~ false ifTrue:[
- lastTestrunResultOrNil := false.
+ lastTestRunResultOrNil ~~ false ifTrue:[
+ lastTestRunResultOrNil := false.
Smalltalk changed:#lastTestRunResult with:self.
self changed:#lastTestRunResult.
]
!
+rememberFailedTestRunWithResult:result
+ self rememberFailedTestRun.
+ (result failures , result errors) do:[:eachFailedTest |
+ |sel|
+
+ sel := eachFailedTest selector.
+ self rememberFailedTest:sel.
+ ].
+!
+
+rememberPassedTest:selector
+ lastTestRunsFailedTests notNil ifTrue:[
+ lastTestRunsFailedTests remove:selector ifAbsent:nil.
+ lastTestRunsFailedTests isEmpty ifTrue:[
+ lastTestRunsFailedTests := nil
+ ]
+ ].
+!
+
rememberPassedTestRun
- lastTestrunResultOrNil ~~ true ifTrue:[
- lastTestrunResultOrNil := true.
+ lastTestRunResultOrNil ~~ true ifTrue:[
+ lastTestRunResultOrNil := true.
+ lastTestRunsFailedTests := nil.
Smalltalk changed:#lastTestRunResult with:self.
self changed:#lastTestRunResult.
]
@@ -95,6 +123,10 @@
^#()
!
+testSelectorFailed:selector
+ ^ lastTestRunsFailedTests notNil and:[lastTestRunsFailedTests includes:selector]
+!
+
testSelectors
^self sunitSelectors select: [:each | 'test*' match: each]
! !
@@ -147,6 +179,18 @@
^self name = #TestCase.
!
+runTests
+ |result|
+
+ result := self suite run.
+
+ result hasPassed ifTrue:[
+ self rememberPassedTestRun
+ ] ifFalse:[
+ self rememberFailedTestRunWithResult:result
+ ].
+!
+
shouldInheritSelectors
"answer true to inherit selectors from superclasses"
@@ -374,7 +418,7 @@
!TestCase class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.28 2002-11-04 21:29:56 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestCase.st,v 1.29 2002-11-11 09:50:11 cg Exp $'
! !
TestCase initialize!
--- a/TestRunner.st Thu Nov 07 19:03:46 2002 +0100
+++ b/TestRunner.st Mon Nov 11 10:50:19 2002 +0100
@@ -676,7 +676,7 @@
"/ testsWhichPassed add:caseName.
"/ testsWhichFailed remove:caseName ifAbsent:nil.
] ifFalse:[
- self testFailed:caseName
+ self testFailed:caseName withResult:result
].
errorCountBefore := errorCountAfter.
failureCountBefore := failureCountAfter
@@ -836,11 +836,15 @@
testsWhichFailed := Set new.
TestCase allSubclassesDo:[:cls |
- cls lastTestrunResultOrNil == true ifTrue:[
- testsWhichPassed add:(cls name)
- ] ifFalse:[
- cls lastTestrunResultOrNil == false ifTrue:[
- testsWhichFailed add:(cls name)
+ |lastResult className|
+
+ lastResult := cls lastTestRunResultOrNil.
+ lastResult notNil ifTrue:[
+ className := cls name.
+ lastResult == true ifTrue:[
+ testsWhichPassed add:className
+ ] ifFalse:[
+ testsWhichFailed add:className
]
]
].
@@ -902,14 +906,14 @@
^ self scriptModel value at:scriptIndex ifAbsent:nil.
!
-testFailed:caseName
+testFailed:caseName withResult:result
|cls|
-
+.
self removeFromPassedTests:caseName.
self addToFailedTests:caseName.
(cls := Smalltalk classNamed:caseName) notNil ifTrue:[
- cls rememberFailedTestRun
+ cls rememberFailedTestRunWithResult:result.
].
!
@@ -1107,7 +1111,7 @@
result hasPassed ifTrue:[
self testPassed:script
] ifFalse:[
- self testFailed:script
+ self testFailed:script withResult:result
].
].
!
@@ -1123,5 +1127,5 @@
!TestRunner class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/goodies/sunit/TestRunner.st,v 1.44 2002-11-07 18:03:46 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/goodies/sunit/TestRunner.st,v 1.45 2002-11-11 09:50:19 cg Exp $'
! !