#REFACTORING by cg
class: Tools::CodeView2::TextView
changed: #updateReallyModified
"{ Package: 'stx:libtool' }"
"{ NameSpace: Tools }"
TestRunnerMini subclass:#TestRunnerEmbedded
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:'SUnit-UI'
!
!TestRunnerEmbedded class methodsFor:'plugIn spec'!
aspectSelectors
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this. If it is corrupted,
the UIPainter may not be able to read the specification."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#methodGeneratorHolder
#selectedClassesHolder
#selectedMethodsHolder
#selectedProtocolsHolder
).
! !
!TestRunnerEmbedded methodsFor:'aspects'!
methodGeneratorHolder
"return/create the 'methodGeneratorHolder' value holder (automatically generated)"
methodGeneratorHolder isNil ifTrue:[
methodGeneratorHolder := ValueHolder new.
methodGeneratorHolder addDependent:self.
].
^ methodGeneratorHolder
!
methodGeneratorHolder:something
"set the 'methodGeneratorHolder' value holder (automatically generated)"
|oldValue newValue|
methodGeneratorHolder notNil ifTrue:[
oldValue := methodGeneratorHolder value.
methodGeneratorHolder removeDependent:self.
].
methodGeneratorHolder := something.
methodGeneratorHolder notNil ifTrue:[
methodGeneratorHolder addDependent:self.
].
newValue := methodGeneratorHolder value.
oldValue ~~ newValue ifTrue:[
self update:#value with:newValue from:methodGeneratorHolder.
].
!
selectedClassesHolder
"return/create the 'selectedClassesHolder' value holder (automatically generated)"
selectedClassesHolder isNil ifTrue:[
selectedClassesHolder := ValueHolder new.
selectedClassesHolder addDependent:self.
].
^ selectedClassesHolder
!
selectedClassesHolder:something
"set the 'selectedClassesHolder' value holder (automatically generated)"
|oldValue newValue|
selectedClassesHolder notNil ifTrue:[
oldValue := selectedClassesHolder value.
selectedClassesHolder removeDependent:self.
].
selectedClassesHolder := something.
selectedClassesHolder notNil ifTrue:[
selectedClassesHolder addDependent:self.
].
newValue := selectedClassesHolder value.
oldValue ~~ newValue ifTrue:[
self update:#value with:newValue from:selectedClassesHolder.
].
!
selectedMethodsHolder
"return/create the 'selectedMethodsHolder' value holder (automatically generated)"
selectedMethodsHolder isNil ifTrue:[
selectedMethodsHolder := ValueHolder new.
selectedMethodsHolder addDependent:self.
].
^ selectedMethodsHolder
!
selectedMethodsHolder:something
"set the 'selectedMethodsHolder' value holder (automatically generated)"
|oldValue newValue|
selectedMethodsHolder notNil ifTrue:[
oldValue := selectedMethodsHolder value.
selectedMethodsHolder removeDependent:self.
].
selectedMethodsHolder := something.
selectedMethodsHolder notNil ifTrue:[
selectedMethodsHolder addDependent:self.
].
newValue := selectedMethodsHolder value.
oldValue ~~ newValue ifTrue:[
self update:#value with:newValue from:selectedMethodsHolder.
].
!
selectedProtocolsHolder
"return/create the 'selectedProtocolsHolder' value holder (automatically generated)"
selectedProtocolsHolder isNil ifTrue:[
selectedProtocolsHolder := ValueHolder new.
selectedProtocolsHolder addDependent:self.
].
^ selectedProtocolsHolder
!
selectedProtocolsHolder:something
"set the 'selectedProtocolsHolder' value holder (automatically generated)"
|oldValue newValue|
selectedProtocolsHolder notNil ifTrue:[
oldValue := selectedProtocolsHolder value.
selectedProtocolsHolder removeDependent:self.
].
selectedProtocolsHolder := something.
selectedProtocolsHolder notNil ifTrue:[
selectedProtocolsHolder addDependent:self.
].
newValue := selectedProtocolsHolder value.
oldValue ~~ newValue ifTrue:[
self update:#value with:newValue from:selectedProtocolsHolder.
].
! !
!TestRunnerEmbedded methodsFor:'aspects-visibility'!
pinButtonVisibleHolder
^ true
"Created: / 23-09-2014 / 10:11:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
runAllButtonVisibleHolder
^ true
"Created: / 23-09-2014 / 10:12:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
runFailedButtonVisibleHolder
^ true
"Created: / 23-09-2014 / 10:12:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TestRunnerEmbedded methodsFor:'change & update'!
invalidateTestCases
allTestCases := nil.
!
update:aspect with:param from: sender
"Invoked when an object that I depend upon sends a change notification."
sender == selectedMethodsHolder ifTrue:[
self enqueueMessage:#updateTestCases for:self arguments:#().
self enqueueMessage:#updateSuiteAndResult for:self arguments:#().
].
sender == selectedClassesHolder ifTrue:[
self
invalidateTestCases; "/ updateTestSuite;
invalidateSuiteAndResult; "/ updateTestSuiteAndResult;
updateVisibility.
self hasTestCaseSelected ifTrue:[
self enqueueMessage:#updateTestCases for:self arguments:#().
self enqueueMessage:#updateSuiteAndResult for:self arguments:#().
"/ self enqueueDelayedAction:[ self updateTestCases; updateSuiteAndResult ].
].
^ self.
].
self hasTestCaseSelected ifTrue:[
(sender == selectedProtocolsHolder
or:[ sender == selectedMethodsHolder
or:[ sender == methodGeneratorHolder ]]) ifTrue:[
self invalidateSuiteAndResult.
self enqueueMessage:#updateSuiteAndResult for:self arguments:#().
^self
].
sender == Smalltalk ifTrue:[
aspect == #lastTestRunResult ifTrue:[
allTestCases notNil ifTrue:[
(allTestCases includesIdentical: param first) ifTrue:[
self invalidateSuiteAndResult. "/ updateTestSuiteAndResult.
self enqueueMessage:#updateSuiteAndResult for:self arguments:#().
^self
]
].
]
].
].
super update:aspect with:param from: sender
"Modified: / 20-11-2011 / 12:40:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-06-2012 / 19:03:34 / cg"
!
updateTestCases
|classes|
classes := (self selectedClassesHolder value ? #())
select:[:cls | self isTestCaseLike:cls ] as:Set.
classes addAll:((self selectedMethodsHolder value ? #())
collect:[:mthd | mthd mclass ]
thenSelect:[:cls | self isTestCaseLike:cls ]).
allTestCases := classes asArray.
allTestCases sortBySelector:#name.
"Created: / 11-03-2010 / 10:31:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 24-01-2012 / 22:09:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-06-2012 / 19:02:52 / cg"
! !
!TestRunnerEmbedded methodsFor:'private'!
hide
self visibility: false height: 0
"Created: / 11-03-2010 / 09:07:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
show
self visibility: true height: 50
"Created: / 11-03-2010 / 09:07:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
visibility:visibility height:height
| window container list h|
window := self window.
window isNil ifTrue:[ ^ self ].
container := self window container.
container isNil ifTrue:[ ^ self ].
h := visibility ifFalse:[0] ifTrue:[ height ].
container isVisible == visibility ifFalse:[
container isVisible:visibility
].
"/ this is the kind of dangerous access which breaks, whenever some wrapping setup
"/ changes. Never do this!!!!!!!!
"/ I'd rather see code which refers to the widget by name,
"/ or if there is an explicit setter for the container, from which to steal the space.
list := container container subViews first.
(list layout bottomOffset ~= height negated) ifTrue:[
list layout:((list layout)
bottomOffset:height negated;
yourself)
].
"Created: / 11-03-2010 / 09:51:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 22-09-2014 / 13:47:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!TestRunnerEmbedded methodsFor:'utilities'!
suiteForRun
"if methods are selected, a suite for those methods is built and returned.
If protocols are selected, a suite for all methods in those protocols
is built and returned.
Otherwise, a suite for all methods in the class is built and returned"
| testMethods protocols suite selectedClass |
selectedClass := self theSingleTestCase.
selectedMethodsHolder value notEmptyOrNil ifTrue:[
testMethods := self selectedTestMethods.
suite := TestSuite named:(self suiteNameFromMethods:testMethods).
testMethods do:[:mthd |
| class selector |
class := selectedClass isNil ifTrue:[mthd mclass] ifFalse:[ selectedClass ].
suite addTest:(class asTestCase selector:mthd selector)
].
^ suite
].
(protocols := selectedProtocolsHolder value) notEmptyOrNil ifTrue:[
suite := TestSuite named:(self suiteNameFromProtocols:protocols).
(self selectedTestMethodsFromProtocols:protocols inClass:selectedClass) do:[:mthd |
| class selector |
class := selectedClass isNil ifTrue:[mthd mclass] ifFalse:[ selectedClass ].
suite addTest:(class asTestCase selector:mthd selector)
].
^ suite
].
^ self suiteForRunAll
"Created: / 15-03-2010 / 13:13:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-08-2011 / 19:06:42 / cg"
"Modified (format): / 23-09-2014 / 10:19:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
suiteForRunAll
|suite|
allTestCases isNil ifTrue:[
self updateTestCases.
].
suite := TestSuite named:(self suiteNameFromClasses: self allTestCases).
allTestCases do:[:testCase |
suite addTests:(self buildSuiteFromClass:testCase) tests
].
^suite
"Modified: / 04-03-2011 / 06:57:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 04-06-2012 / 19:01:48 / cg"
! !
!TestRunnerEmbedded class methodsFor:'documentation'!
version
^ '$Header$'
!
version_CVS
^ '$Header$'
! !