asynchronous update of testSuite and suiteAndResult
dto fix a race condition, when switching between instance and
class protocols, in a Suite which has test_xxx methods on the
class side. In this case, the updateSuite was triggered and
called while at the same time (in another update), the
methodListGenerator was switched. This lead to metaclass-methods
to be added to the suite (and a DNU, when sending asTestCase to
that metaclass).
Please verify, if the fix works correctly, as the code here is
quite heavily fragile (using self selectedClass etc. at many places,
in which it could change underneath by another update from a separate
thread...)
--- a/Tools__TestRunnerEmbedded.st Wed Oct 31 11:22:31 2012 +0100
+++ b/Tools__TestRunnerEmbedded.st Wed Oct 31 14:33:51 2012 +0100
@@ -300,6 +300,13 @@
!TestRunnerEmbedded methodsFor:'accessing'!
+allTestCases
+ allTestCases isNil ifTrue:[
+ self updateTestCases
+ ].
+ ^ allTestCases
+!
+
infoHolder:something
"to show something in the browsers info area (near the bottom"
@@ -308,39 +315,26 @@
"Created: / 05-07-2011 / 16:22:24 / cg"
!
-selectedTestMethods
-
- | selectedClass |
- selectedClass := self theSingleTestCase.
-
- ^ (self selectedMethodsHolder value ? #()) select:
- [:mthd | | cls |
- (cls := selectedClass) isNil ifTrue:[cls := mthd mclass].
- (self isTestCaseLike:selectedClass)
- and:[ selectedClass isTestSelector:mthd selector ] ]
-
- "Created: / 15-03-2010 / 13:21:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 22-07-2011 / 15:46:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 02-08-2011 / 17:46:38 / cg"
+invalidateAllTestCases
+ allTestCases := nil
!
-selectedTestMethodsFromProtocols:protocols
+selectedTestMethodsFromProtocols:protocols inClass:aTestClass
- |methods generator selectedClass|
+ |methods generator|
methods := Set new.
generator := self methodGeneratorHolder value.
- selectedClass := self theSingleTestCase.
generator notNil ifTrue:[
generator do: [:cls :cat :sel :mthd |
(mthd notNil
- and:[ (self isTestCaseLike:(selectedClass ? cls))
- and:[ (selectedClass ? cls) isTestSelector:sel ] ])
+ and:[ (self isTestCaseLike:(aTestClass ? cls))
+ and:[ (aTestClass ? cls) isTestSelector:sel ] ])
ifTrue:[ methods add:mthd ]
]
] ifFalse:[
- allTestCases do: [:cls |
+ self allTestCases do: [:cls |
cls methodsDo: [:mthd |
((protocols includes:mthd category) and:[ cls isTestSelector:mthd selector ])
ifTrue:[
@@ -356,9 +350,21 @@
"Modified (format): / 04-06-2012 / 19:05:32 / cg"
!
+selectedTestMethodsInClass:testClass
+ ^ (self selectedMethodsHolder value ? #()) select:
+ [:mthd | | cls |
+ (cls := testClass) isNil ifTrue:[cls := mthd mclass].
+ (self isTestCaseLike:testClass)
+ and:[ testClass isTestSelector:mthd selector ] ]
+
+ "Created: / 15-03-2010 / 13:21:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 22-07-2011 / 15:46:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 02-08-2011 / 17:46:38 / cg"
+!
+
theSingleTestCase
- allTestCases isEmptyOrNil ifTrue:[^nil].
+ self allTestCases isEmptyOrNil ifTrue:[^nil].
allTestCases size > 1 ifTrue:[^nil].
^allTestCases anyOne.
@@ -795,36 +801,51 @@
!TestRunnerEmbedded methodsFor:'change & update'!
+invalidateSuiteAndResult
+ self resultHolder value:nil.
+!
+
+invalidateTestCases
+ allTestCases := nil.
+!
+
update:aspect with:param from: sender
"Invoked when an object that I depend upon sends a change notification."
sender == selectedClassesHolder ifTrue:[
self
- updateTestCases;
- updateTestSuiteAndResult;
+ invalidateTestCases; "/ updateTestSuite;
+ invalidateSuiteAndResult; "/ updateTestSuiteAndResult;
updateVisibility.
+ self enqueueDelayedAction:[ self updateTestCases; updateSuiteAndResult ].
^ self.
].
sender == selectedProtocolsHolder ifTrue:[
- self updateTestSuiteAndResult.
+ self invalidateSuiteAndResult. "/ updateTestSuiteAndResult.
+ self enqueueDelayedAction:[ self updateSuiteAndResult ].
^self
].
sender == selectedMethodsHolder ifTrue:[
- self updateTestSuiteAndResult.
+ self invalidateSuiteAndResult. "/ updateTestSuiteAndResult.
+ self enqueueDelayedAction:[ self updateSuiteAndResult ].
^self
].
sender == methodGeneratorHolder ifTrue:[
- self updateTestSuiteAndResult.
+ self invalidateSuiteAndResult. "/ updateTestSuiteAndResult.
+ self enqueueDelayedAction:[ self updateSuiteAndResult ].
^self
].
sender == Smalltalk ifTrue:[
aspect == #lastTestRunResult ifTrue:[
- (allTestCases includesIdentical: param first) ifTrue:[
- self updateTestSuiteAndResult.
- ^self
- ]
+ allTestCases notNil ifTrue:[
+ (allTestCases includesIdentical: param first) ifTrue:[
+ self invalidateSuiteAndResult. "/ updateTestSuiteAndResult.
+ self enqueueDelayedAction:[ self updateSuiteAndResult ].
+ ^self
+ ]
+ ].
]
].
@@ -836,6 +857,22 @@
"Modified: / 04-06-2012 / 19:03:34 / cg"
!
+updateSuiteAndResult
+ | suite suiteAndResult |
+
+ self runningHolder value ifTrue:[^self].
+ self allTestCases isEmptyOrNil ifTrue:[^self].
+
+ suiteAndResult := SuiteAndResult
+ suite: (suite := self suiteForRun)
+ result: (self resultForSuite: suite).
+ self resultHolder value: suiteAndResult.
+
+ "Created: / 15-03-2010 / 19:41:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 15-03-2010 / 20:55:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-06-2012 / 19:03:15 / cg"
+!
+
updateTestCases
allTestCases := ((self selectedClassesHolder value ? #())
select:[:cls | self isTestCaseLike:cls ]).
@@ -846,21 +883,6 @@
"Modified: / 04-06-2012 / 19:02:52 / cg"
!
-updateTestSuiteAndResult
-
- | suite suiteAndResult |
- self runningHolder value ifTrue:[^self].
- allTestCases isEmptyOrNil ifTrue:[^self].
- suiteAndResult := SuiteAndResult
- suite: (suite := self suiteForRun)
- result: (self resultForSuite: suite).
- self resultHolder value: suiteAndResult.
-
- "Created: / 15-03-2010 / 19:41:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 15-03-2010 / 20:55:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 04-06-2012 / 19:03:15 / cg"
-!
-
updateVisibility
self hasTestCaseSelected
@@ -940,7 +962,7 @@
hasTestCaseSelected
- ^allTestCases notEmptyOrNil
+ ^self allTestCases notEmptyOrNil
"Created: / 11-03-2010 / 09:06:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 15-03-2010 / 20:54:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -981,9 +1003,10 @@
| methods protocols suite selectedClass |
selectedClass := self theSingleTestCase.
+
(methods := selectedMethodsHolder value) notEmptyOrNil ifTrue:[
suite := TestSuite named: (self suiteNameFromMethods: methods).
- self selectedTestMethods do:[:mthd|
+ (self selectedTestMethodsInClass:selectedClass) do:[:mthd|
| class selector |
class := selectedClass ifNil:[mthd mclass].
suite addTest: (class asTestCase selector: mthd selector)
@@ -993,7 +1016,7 @@
(protocols := selectedProtocolsHolder value) isEmptyOrNil ifFalse:[
suite := TestSuite named: (self suiteNameFromProtocols: protocols).
- (self selectedTestMethodsFromProtocols: protocols) do:[:mthd|
+ (self selectedTestMethodsFromProtocols: protocols inClass:selectedClass) do:[:mthd|
| class selector |
class := selectedClass ifNil:[mthd mclass].
suite addTest: (mthd mclass asTestCase selector: mthd selector)
@@ -1010,10 +1033,11 @@
suiteForRunAll
|suite|
- suite := TestSuite named:(self suiteNameFromClasses: allTestCases).
+
allTestCases isNil ifTrue:[
self updateTestCases.
].
+ suite := TestSuite named:(self suiteNameFromClasses: self allTestCases).
allTestCases do:[:testCase |
suite addTests:(self buildSuiteFromClass:testCase) tests
@@ -1027,8 +1051,8 @@
suiteForRunFailed
|suite|
- suite := TestSuite named:(self suiteNameFromClasses: allTestCases).
- allTestCases do:[:testCase |
+ suite := TestSuite named:(self suiteNameFromClasses: self allTestCases).
+ self allTestCases do:[:testCase |
(self buildSuiteFromClass:testCase) tests do:[:eachTest |
| sel cls |
@@ -1160,11 +1184,11 @@
!TestRunnerEmbedded class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.30 2012-10-23 19:01:57 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.31 2012-10-31 13:33:51 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.30 2012-10-23 19:01:57 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.31 2012-10-31 13:33:51 cg Exp $'
!
version_SVN