hg/stx-libtool: comparison Tools_

equal deleted inserted replaced

-:2593d0a1f4e8
+:ec549f688c75
 name: 'RunnerInfoBox'
 backgroundChannel: resultBackgroundColorAspect
 component:
 (SpecCollection
 collection: (
-(ViewSpec
-name: 'ProgressPanel'
-layout: (LayoutFrame 0 0 0 0 0 1 0 1)
-initiallyInvisible: true
-visibilityChannel: progressIndicatorShownHolder
-backgroundChannel: resultBackgroundColorAspect
-component:
-(SpecCollection
-collection: (
-(ProgressIndicatorSpec
-name: 'RunningProgress'
-layout: (LayoutFrame 5 0 -10 0.5 -5 1 10 0.5)
-model: progressHolder
-postBuildCallback: postBuildProgressIndicator:
-)
-)
-)
-)
 (LabelSpec
 label: 'Run tests first!!'
 name: 'ResultName'
 layout: (LayoutFrame 22 0 0 0 0 1 -10 1)
 backgroundChannel: resultBackgroundColorAspect
 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)
+initiallyInvisible: true
+visibilityChannel: progressIndicatorShownHolder
+backgroundChannel: resultBackgroundColorAspect
+component:
+(SpecCollection
+collection: (
+(ProgressIndicatorSpec
+name: 'RunningProgress'
+layout: (LayoutFrame 5 0 -10 0.5 -5 1 10 0.5)
+model: progressHolder
+postBuildCallback: postBuildProgressIndicator:
+)
+)
+)
 )
 )
 )
 extent: (Point 296 30)
 self updateTestCases
 ].
 ^ allTestCases
 !
+allTestCases:something
+allTestCases := something.
+!
 infoHolder:something
 "to show something in the browsers info area (near the bottom"
 infoHolder := something.
 "Created: / 05-07-2011 / 16:22:24 / cg"
-!
-invalidateAllTestCases
-allTestCases := nil
 !
 selectedTestMethods
 | selectedClass |
 pin
 | runner screen |
 runner := TestRunnerMini new.
-runner selectedMethodsHolder: self selectedMethodsHolder copy asValue.
+runner resultHolder value: self resultHolder value copy.
-runner selectedProtocolsHolder: self selectedProtocolsHolder copy asValue.
-runner selectedClassesHolder: self selectedClassesHolder copy asValue.
 runner allButOpen.
 screen := Screen current.
 (screen notNil and:[ screen platformName == #X11 ]) ifTrue:[
 ].
 screen setWindowType:#'_NET_WM_WINDOW_TYPE_UTILITY' in:runner window id.
 ].
 runner open.
-"Modified: / 23-09-2014 / 10:13:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+"Modified: / 23-09-2014 / 12:05:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 run
 |suite|
 invalidateSuiteAndResult
 self resultHolder value:nil.
 !
-invalidateTestCases
-allTestCases := nil.
-!
 update:aspect with:param from:sender
 sender == Smalltalk ifTrue:[
 aspect == #lastTestRunResult ifTrue:[
 allTestCases notNil ifTrue:[
 "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 ? #())
+"/ Nothing to do here
-select:[:cls | self isTestCaseLike:cls ]).
-allTestCases := allTestCases asArray
+"Created: / 23-09-2014 / 12:02:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-"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"
 !
 updateTestSuiteAndResult
 | suite suiteAndResult |
 "Modified: / 02-08-2011 / 18:20:00 / cg"
 "Modified: / 20-08-2011 / 14:30:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 suiteForRun
-"if methods are selected, a suite for those methods is built and returned.
+^ self resultHolder value suiteForRun
-If protocoly are selected, a suite for all methods in those protocols
-is built and returned.
+"Modified: / 23-09-2014 / 12:07:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-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|
+"raise an error: must be redefined in concrete subclass(es)"
-allTestCases isNil ifTrue:[
+^ self suiteForRun
-self updateTestCases.
-].
+"Modified: / 23-09-2014 / 12:07:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-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"
 !
 suiteForRunFailed
 |suite numTests|
 suite := TestSuite named:(self suiteNameFromClasses: self allTestCases).
 numTests := 0.
-self allTestCases do:[:testCase |
+self suiteForRunAll tests do:[:eachTest |
-(self buildSuiteFromClass:testCase) tests do:[:eachTest |
+| sel cls |
-| sel cls |
+sel := eachTest selector.
-sel := eachTest selector.
+cls := eachTest class.
-cls := eachTest class.
+(cls testSelectorPassed:sel) ifFalse:[
-(cls testSelectorPassed:sel) ifFalse:[
+suite addTest:eachTest.
-suite addTest:eachTest.
+numTests := numTests + 1.
-numTests := numTests + 1.
-]
 ]
 ].
 numTests == 1 ifTrue:[
 suite name:(suite tests first selector)
 ] ifFalse:[
 suite name:(suite tests size printString,' tests')
 ].
 ^suite
-"Modified: / 04-03-2011 / 06:57:09 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+"Modified: / 23-09-2014 / 12:09:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-"Created: / 04-06-2012 / 18:32:40 / cg"
 ! !
 !TestRunnerMini::SuiteAndResult class methodsFor:'instance creation'!
 suite: suite result: result
 ! !
 !TestRunnerMini class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerMini.st,v 1.1 2014-09-23 09:29:37 vrany Exp $'
+^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerMini.st,v 1.2 2014-09-23 11:14:52 vrany Exp $'
 !
 version_CVS
-^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerMini.st,v 1.1 2014-09-23 09:29:37 vrany Exp $'
+^ '$Header: /cvs/stx/stx/libtool/Tools__TestRunnerMini.st,v 1.2 2014-09-23 11:14:52 vrany Exp $'
 !
 version_SVN
-^ '$Id: Tools__TestRunnerMini.st,v 1.1 2014-09-23 09:29:37 vrany Exp $'
+^ '$Id: Tools__TestRunnerMini.st,v 1.2 2014-09-23 11:14:52 vrany Exp $'
 ! !

changeset 14739	ec549f688c75
parent 14728	1c798d251860
child 14831	17e27adfbd3d