--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__TestRunnerEmbedded.st Thu Jun 30 21:52:51 2011 +0200
@@ -0,0 +1,845 @@
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+AbstractTestRunner subclass:#TestRunnerEmbedded
+ instanceVariableNames:'runnerPanel selectedTestCases selectedClassesHolder
+ selectedProtocolsHolder selectedMethodsHolder
+ methodGeneratorHolder resultHolder resultInfoHolder
+ resultBackgroundColorHolder runningHolder progressHolder'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Test Runner 2'
+!
+
+Object subclass:#SuiteAndResult
+ instanceVariableNames:'suite result'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:TestRunnerEmbedded
+!
+
+!TestRunnerEmbedded class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+! !
+
+!TestRunnerEmbedded class methodsFor:'interface specs'!
+
+windowSpec
+ "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."
+
+ "
+ UIPainter new openOnClass:Tools::TestRunnerEmbedded andSelector:#windowSpec
+ Tools::TestRunnerEmbedded new openInterface:#windowSpec
+ Tools::TestRunnerEmbedded open
+ "
+
+ <resource: #canvas>
+
+ ^
+ #(FullSpec
+ name: windowSpec
+ window:
+ (WindowSpec
+ label: 'Test Runner Embedded'
+ name: 'Test Runner Embedded'
+ min: (Point 10 10)
+ bounds: (Rectangle 0 0 350 50)
+ )
+ component:
+ (SpecCollection
+ collection: (
+ (VerticalPanelViewSpec
+ name: 'Runners'
+ layout: (LayoutFrame 5 0 0 0 -5 1 0 1)
+ horizontalLayout: fit
+ verticalLayout: topSpaceFit
+ horizontalSpace: 0
+ verticalSpace: 5
+ elementsChangeSize: true
+ component:
+ (SpecCollection
+ collection: (
+ (ViewSpec
+ name: 'Runner'
+ backgroundChannel: resultBackgroundColorAspect
+ component:
+ (SpecCollection
+ collection: (
+ (HorizontalPanelViewSpec
+ name: 'RunnerInnerBox'
+ layout: (LayoutFrame 5 0 0 0 -5 1 0 1)
+ horizontalLayout: rightSpaceFit
+ verticalLayout: center
+ horizontalSpace: 0
+ elementsChangeSize: true
+ component:
+ (SpecCollection
+ collection: (
+ (ViewSpec
+ name: 'RunnerInfoBox'
+ backgroundChannel: resultBackgroundColorAspect
+ component:
+ (SpecCollection
+ collection: (
+ (LabelSpec
+ label: 'Run tests first!!'
+ name: 'ResultName'
+ layout: (LayoutFrame 0 0 0 0 0 1 -10 1)
+ backgroundChannel: resultBackgroundColorAspect
+ foregroundColor: (Color 100.0 100.0 100.0)
+ translateLabel: true
+ labelChannel: resultNameAspect
+ adjust: left
+ )
+ (LabelSpec
+ name: 'ResultInfo'
+ layout: (LayoutFrame 0 0 -10 1 0 1 0 1)
+ style: (FontDescription helvetica medium roman 8)
+ backgroundChannel: resultBackgroundColorAspect
+ foregroundColor: (Color 100.0 100.0 100.0)
+ translateLabel: true
+ labelChannel: resultInfoAspect
+ adjust: left
+ )
+ (ViewSpec
+ name: 'ProgressPanel'
+ layout: (LayoutFrame 0 0 0 0 0 1 0 1)
+ visibilityChannel: runningHolder
+ backgroundChannel: resultBackgroundColorAspect
+ component:
+ (SpecCollection
+ collection: (
+ (ProgressIndicatorSpec
+ name: 'RunningProgress'
+ layout: (LayoutFrame 5 0 -10 0.5 -5 1 10 0.5)
+ model: progressHolder
+ )
+ )
+
+ )
+ )
+ )
+
+ )
+ extent: (Point 151 30)
+ )
+ (ActionButtonSpec
+ label: 'Debug'
+ name: 'DebugButton'
+ initiallyInvisible: true
+ visibilityChannel: debugVisibleAspect
+ translateLabel: true
+ model: debug
+ extent: (Point 60 25)
+ )
+ (ActionButtonSpec
+ label: 'Run'
+ name: 'Run'
+ translateLabel: true
+ model: run
+ enableChannel: runEnabledHolder
+ extent: (Point 60 25)
+ )
+ (ActionButtonSpec
+ label: 'Run all'
+ name: 'RunAll'
+ translateLabel: true
+ model: runAll
+ enableChannel: runAllEnabledHolder
+ extent: (Point 60 25)
+ )
+ )
+
+ )
+ postBuildCallback: postBuildRunnerPanel:
+ )
+ )
+
+ )
+ extent: (Point 340 40)
+ )
+ )
+
+ )
+ )
+ )
+
+ )
+ )
+
+! !
+
+!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:'accessing'!
+
+selectedTestMethods
+ ^ (self selectedMethodsHolder value ? #()) select:
+ [:mthd |
+ (self isTestCaseLike:mthd mclass)
+ and:[ mthd mclass isTestSelector:mthd selector ] ]
+
+ "Created: / 15-03-2010 / 13:21:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-09-2010 / 08:30:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+selectedTestMethodsFromProtocols:protocols
+ |methods generator|
+
+ methods := Set new.
+ generator := self methodGeneratorHolder value.
+ generator ifNotNil:
+ [ generator do:
+ [:cls :cat :sel :mthd |
+ (mthd notNil
+ and:[ (self isTestCaseLike:cls) and:[ cls isTestSelector:sel ] ])
+ ifTrue:[ methods add:mthd ] ] ]
+ ifNil:
+ [ selectedTestCases do:
+ [:cls |
+ cls methodsDo:
+ [:mthd |
+ ((protocols includes:mthd category)
+ and:[ cls isTestSelector:mthd selector ]) ifTrue:[ methods add:mthd ] ] ] ].
+ ^ methods
+
+ "Created: / 15-03-2010 / 19:50:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-09-2010 / 08:29:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!TestRunnerEmbedded methodsFor:'actions'!
+
+debug
+
+ | suiteAndResult |
+ suiteAndResult := self resultHolder value.
+ suiteAndResult suite tests size ~= 1 ifTrue:[^self breakPoint: #jv].
+ [suiteAndResult suite tests anyOne debug] fork
+
+ "Created: / 15-03-2010 / 15:43:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 15-03-2010 / 20:09:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+run
+
+ self run: resultHolder value suite
+
+ "Created: / 10-03-2010 / 19:42:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 15-03-2010 / 20:00:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+run: suite
+
+ | process suiteAndResult |
+
+ suite tests size == 0 ifTrue:[^self].
+
+ process :=
+ [| result incr run |
+ [
+ self progressHolder value: 0.
+ self runningHolder value: true.
+ incr := 100 / suite tests size.
+ run := 0.
+ result := suite runAfterEachDo:
+ [:test :result|
+ run := run + 1.
+ self progressHolder value: (incr * run) rounded].
+ suiteAndResult := SuiteAndResult
+ suite: suite
+ result: result.
+ ] ensure:[
+ self resultHolder value: suiteAndResult.
+ self runningHolder value: false.
+ ]
+ ] newProcess.
+
+ process resume.
+
+ "Created: / 11-03-2010 / 10:22:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 06-09-2010 / 21:48:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+runAll
+
+ self run: self suiteForRunAll.
+
+ "Created: / 10-03-2010 / 19:42:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 15-03-2010 / 13:12:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!TestRunnerEmbedded methodsFor:'aspects'!
+
+debugVisibleAspect
+
+ ^BlockValue
+ with:
+ [:model|
+ model
+ ifNil:[false]
+ ifNotNil:[model testCount == 1 and:[model hasFailuresOrErrors]]]
+ argument:
+ self resultHolder
+
+ "Created: / 15-03-2010 / 15:40:54 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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.
+ ].
+!
+
+progressHolder
+ "return/create the 'progressHolder' value holder (automatically generated)"
+
+ progressHolder isNil ifTrue:[
+ progressHolder := ValueHolder new.
+ ].
+ ^ progressHolder
+!
+
+resultBackgroundColorAspect
+ <resource: #uiAspect>
+
+ resultBackgroundColorHolder isNil ifTrue:[
+ resultBackgroundColorHolder := BlockValue
+ with:
+ [:result :running|
+ running
+ ifTrue:
+ [View defaultBackgroundColor]
+ ifFalse:
+ [result
+ ifNil:[self class notRunColor]
+ ifNotNil:[result color]]]
+ argument: self resultHolder
+ argument: self runningHolder.
+ resultBackgroundColorHolder onChangeEvaluate:
+ [runnerPanel ifNotNil:[runnerPanel backgroundColor: resultBackgroundColorHolder value]].
+ ].
+ ^ resultBackgroundColorHolder.
+
+ "Created: / 15-03-2010 / 15:22:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 15-03-2010 / 21:02:22 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+resultHolder
+ "return/create the 'resultHolder' value holder (automatically generated)"
+
+ resultHolder isNil ifTrue:[
+ resultHolder := ValueHolder new.
+ ].
+ ^ resultHolder
+!
+
+resultInfoAspect
+
+ ^BlockValue
+ with:
+ [:model|
+ model
+ ifNil:['']
+ ifNotNil:[model info]]
+ argument:
+ self resultHolder
+
+ "Created: / 15-03-2010 / 20:22:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+resultNameAspect
+
+ ^BlockValue
+ with:
+ [:model|
+ model
+ ifNil:['Run the tests!!']
+ ifNotNil:[model name]]
+ argument:
+ self resultHolder
+
+ "Created: / 15-03-2010 / 14:57:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 15-03-2010 / 20:17:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+runAllEnabledHolder
+
+ ^true
+
+ "Created: / 07-09-2010 / 09:15:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+runEnabledHolder
+
+ ^BlockValue
+ with:
+ [:resultHolder | | result |
+ (result := resultHolder value) notNil and:[result testCount > 0 ]]
+ argument: self resultHolder
+
+ "Created: / 07-09-2010 / 09:15:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+runningHolder
+ "return/create the 'runningHolder' value holder (automatically generated)"
+
+ runningHolder isNil ifTrue:[
+ runningHolder := ValueHolder with: false.
+ ].
+ ^ runningHolder
+
+ "Modified: / 15-03-2010 / 20:29:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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:'change & update'!
+
+update:aspect with:param from: sender
+ "Invoked when an object that I depend upon sends a change notification."
+
+ sender == selectedClassesHolder ifTrue:[
+ self
+ updateTestCases;
+ updateTestSuiteAndResult;
+ updateVisibility.
+ ^ self.
+ ].
+ sender == selectedProtocolsHolder ifTrue:[
+ self updateTestSuiteAndResult.
+ ^self
+ ].
+
+ sender == selectedMethodsHolder ifTrue:[
+ self updateTestSuiteAndResult.
+ ^self
+ ].
+ sender == methodGeneratorHolder ifTrue:[
+ self updateTestSuiteAndResult.
+ ^self
+ ].
+
+
+
+ super update:aspect with:param from: sender
+
+ "Modified: / 07-09-2010 / 08:18:11 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+updateTestCases
+ selectedTestCases := (self selectedClassesHolder value
+ select:[:cls | self isTestCaseLike:cls ]).
+ selectedTestCases := selectedTestCases isEmpty
+ ifTrue:[ nil ]
+ ifFalse:[ selectedTestCases asArray ]
+
+ "Created: / 11-03-2010 / 10:31:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 15-03-2010 / 20:53:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+updateTestSuiteAndResult
+
+ | suite suiteAndResult |
+ self runningHolder value ifTrue:[^self].
+ selectedTestCases ifNil:[^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>"
+!
+
+updateVisibility
+
+ self hasTestCaseSelected
+ ifTrue:[self show]
+ ifFalse:[self hide]
+
+ "Created: / 11-03-2010 / 09:02:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!TestRunnerEmbedded methodsFor:'hooks'!
+
+postBuildRunnerPanel: aView
+
+ runnerPanel := aView.
+ runnerPanel backgroundColor: self resultBackgroundColorAspect value
+
+ "Created: / 15-03-2010 / 14:26:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!TestRunnerEmbedded methodsFor:'private'!
+
+hide
+
+ self visibility: false height: 0
+
+ "Created: / 11-03-2010 / 09:07:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+isTestCaseLike:cls
+
+ ^(super isTestCaseLike: cls) and:
+ [(cls askFor: #isAbstract) not]
+
+ "Modified: / 04-03-2011 / 06:54:13 / 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
+ | container list h |
+ (container := self window container) ifNil:[^self].
+ h := visibility ifFalse:[0] ifTrue:[height].
+
+ container isVisible == visibility ifFalse:
+ [container isVisible: visibility].
+
+
+ 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>"
+! !
+
+!TestRunnerEmbedded methodsFor:'queries'!
+
+hasTestCaseSelected
+
+ ^selectedTestCases isNilOrEmptyCollection not
+
+ "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>"
+! !
+
+!TestRunnerEmbedded methodsFor:'utilities'!
+
+resultForSuite: suite
+
+ | result |
+ result := TestResult new.
+ suite tests do:
+ [:test|
+ (test class testSelectorPassed: test selector)
+ ifTrue:
+ [result passed add: test]
+ ifFalse:
+ [(test class testSelectorError: test selector)
+ ifTrue:
+ [result errors add: test]
+ ifFalse:
+ [(test class testSelectorFailed: test selector)
+ ifTrue:
+ [result failures add: test]]]].
+ ^result
+
+ "Created: / 15-03-2010 / 19:46:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+suiteForRun
+ | methods protocols suite |
+ (methods := selectedMethodsHolder value) isNilOrEmptyCollection ifFalse:
+ [suite := TestSuite named: (self suiteNameFromMethods: methods).
+ self selectedTestMethods do:
+ [:mthd| | selector |
+ suite addTest: (mthd mclass asTestCase selector: mthd selector)].
+ ^suite].
+
+ (protocols := selectedProtocolsHolder value) isNilOrEmptyCollection ifFalse:
+ [suite := TestSuite named: (self suiteNameFromProtocols: protocols).
+ (self selectedTestMethodsFromProtocols: protocols) do:
+ [:mthd| | selector |
+ suite addTest: (mthd mclass asTestCase selector: mthd selector)].
+ ^suite].
+ ^self suiteForRunAll
+
+ "Created: / 15-03-2010 / 13:13:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 04-03-2011 / 08:24:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+suiteForRunAll
+ |suite|
+ suite := TestSuite named:(self suiteNameFromClasses: selectedTestCases).
+ selectedTestCases
+ do:[:testCase | suite addTests:(self buildSuiteFromClass:testCase) tests].
+ ^suite
+
+ "Modified: / 04-03-2011 / 06:57:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!TestRunnerEmbedded::SuiteAndResult class methodsFor:'instance creation'!
+
+suite: suite result: result
+
+ ^self new
+ suite: suite;
+ result: result.
+
+ "Modified: / 15-03-2010 / 15:27:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!TestRunnerEmbedded::SuiteAndResult methodsFor:'accessing'!
+
+color
+
+ self testCount == 0 ifTrue:
+ [^TestRunnerEmbedded notRunColor].
+
+ result ifNil:[^TestRunnerEmbedded notRunColor].
+ self hasErrors ifTrue:[^TestRunnerEmbedded errorColor].
+ self hasFailures ifTrue:[^TestRunnerEmbedded failedColor].
+ self hasPassed ifTrue:[^TestRunnerEmbedded passedColor].
+ ^TestRunnerEmbedded notRunColor
+
+ "Created: / 15-03-2010 / 15:24:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 07-09-2010 / 08:25:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+info
+
+ result ifNil:[^''].
+ (result passedCount + result failureCount + result errorCount) = 1 ifTrue:[^''].
+ ^'%1 tests, %2 passed, %3 failed, %4 errors'
+ bindWith: suite tests size
+ with: result passedCount
+ with: result failureCount
+ with: result errorCount
+
+ "Created: / 15-03-2010 / 20:23:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+name
+
+ ^suite name
+
+ "Created: / 15-03-2010 / 15:12:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+result
+ ^ result
+!
+
+result:aTestResult
+ result := aTestResult.
+!
+
+suite
+ ^ suite
+!
+
+suite:aTestSuite
+ suite := aTestSuite.
+!
+
+testCount
+
+ ^suite tests size
+
+ "Created: / 15-03-2010 / 15:44:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!TestRunnerEmbedded::SuiteAndResult methodsFor:'queries'!
+
+hasErrors
+
+ ^result errorCount > 0
+
+ "Created: / 15-03-2010 / 15:21:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+hasFailures
+
+ ^result failureCount > 0
+
+ "Created: / 15-03-2010 / 15:21:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+hasFailuresOrErrors
+
+ ^self hasErrors or:[self hasFailures]
+
+ "Created: / 15-03-2010 / 15:45:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+hasPassed
+
+ ^result passedCount > 0
+
+ "Created: / 15-03-2010 / 22:06:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!TestRunnerEmbedded class methodsFor:'documentation'!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerEmbedded.st,v 1.1 2011-06-30 19:52:51 cg Exp $'
+!
+
+version_SVN
+ ^ '§Id: Tools__TestRunnerEmbedded.st 7681 2011-03-04 11:30:02Z vranyj1 §'
+! !