"

 Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague

 Copyright (c) 2009-2010 eXept Software AG

 Permission is hereby granted, free of charge, to any person

 obtaining a copy of this software and associated documentation

 files (the 'Software'), to deal in the Software without

 restriction, including without limitation the rights to use,

 copy, modify, merge, publish, distribute, sublicense, and/or sell

 copies of the Software, and to permit persons to whom the

 Software is furnished to do so, subject to the following

 conditions:

 The above copyright notice and this permission notice shall be

 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,

 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES

 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND

 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT

 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,

 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING

 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR

 OTHER DEALINGS IN THE SOFTWARE.

"

"{ Package: 'stx:libtool' }"

"{ NameSpace: Tools }"

AbstractTestRunner subclass:#TestRunnerMini

	instanceVariableNames:'runnerPanel selectedClassesHolder selectedProtocolsHolder

		selectedMethodsHolder methodGeneratorHolder resultHolder

		resultInfoHolder resultBackgroundColorHolder runningHolder

		progressHolder progressIndicatorShownHolder infoHolder

		testProcess allTestCases progressIndicator'

	classVariableNames:''

	poolDictionaries:''

	category:'SUnit-UI'

!

Object subclass:#SuiteAndResult

	instanceVariableNames:'suite result'

	classVariableNames:''

	poolDictionaries:''

	privateIn:TestRunnerMini

!

!TestRunnerMini class methodsFor:'documentation'!

copyright

"

 Copyright (c) 2007-2010 Jan Vrany, SWING Research Group, Czech Technical University in Prague

 Copyright (c) 2009-2010 eXept Software AG

 Permission is hereby granted, free of charge, to any person

 obtaining a copy of this software and associated documentation

 files (the 'Software'), to deal in the Software without

 restriction, including without limitation the rights to use,

 copy, modify, merge, publish, distribute, sublicense, and/or sell

 copies of the Software, and to permit persons to whom the

 Software is furnished to do so, subject to the following

 conditions:

 The above copyright notice and this permission notice shall be

 included in all copies or substantial portions of the Software.

 THE SOFTWARE IS PROVIDED 'AS IS', WITHOUT WARRANTY OF ANY KIND,

 EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES

 OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND

 NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT

 HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,

 WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING

 FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR

 OTHER DEALINGS IN THE SOFTWARE.

"

!

documentation

"

    a tiny runner to be embedded in a system browser

"

! !

!TestRunnerMini class methodsFor:'help specs'!

flyByHelpSpec

    "This resource specification was automatically generated

     by the UIHelpTool of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the UIHelpTool may not be able to read the specification."

    "

     UIHelpTool openOnClass:Tools::TestRunnerEmbedded    

    "

    <resource: #help>

    ^ super flyByHelpSpec addPairsFrom:#(

#debugSelected

'Run the selected test(s) with debugging enabled.\A debugger is opened on error or assertion failure'

#runAll

'Run all tests.\No debugger is opened on error or assertion failure, but the test remembered as failing'

#runFailed

'Only rerun failed tests'

#runSelected

'Run the selected test(s)'

#stopRun

'Stop the test-run'

#pin

'Pin the runner for the selected testcase as floating window.'

#runAllWithCoverage

'Run all tests with coverage'

)

    "Created: / 04-06-2012 / 19:27:47 / cg"

! !

!TestRunnerMini class methodsFor:'image specs'!

pinIcon

    "This resource specification was automatically generated

     by the ImageEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the ImageEditor may not be able to read the specification."

    "

     self pinIcon inspect

     ImageEditor openOnClass:self andSelector:#pinIcon

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:'Tools::TestRunnerEmbedded pinIcon'

        ifAbsentPut:[(Depth8Image new) width:14; height:13; bits:(ByteArray fromPackedString:'

NC 8NC 8NC 8NB8/L# 8NC 8NC 8NC 8J3@1L# 8NC 8NC 8NB80J3@/APXDB@8OB3L+L3L0KB8RD1TVE1$ZJ2<0L2,8N@TGA@$JD@00KR<-M3 8M04MCP4M

CPD0KSL7NC 7CRD\HRDAHRD!!HS\8NCXMH!!4"H!!4TGQ4#M# 8M@4[IRP^IQ8XIRT5NC *CRX_I!!<_I!!<QG2$8N@LMI2 ''HB\ HB\ @# 8@@@@@@@@@@@@@@@@

NC b') ; colorMapFromArray:#[136 149 174 23 50 93 145 154 169 144 154 168 48 116 186 68 118 170 70 119 171 70 120 171 62 133 196 62 132 195 93 155 206 170 202 228 171 202 228 197 223 244 93 156 206 132 180 218 132 181 218 205 228 246 90 156 204 111 182 226 179 216 240 88 182 232 115 196 236 153 212 241 186 225 246 189 226 245 217 238 249 242 251 255 235 249 255 238 250 255 241 251 255 245 252 255 248 253 255 235 250 255 238 251 255 239 251 255 241 252 255 242 252 255 245 253 255 248 254 255 247 254 255 157 161 160 157 162 160 0 114 54 0 97 46 0 82 39 0 149 62 53 155 88 114 182 73 125 181 81 163 202 129 159 167 110 170 170 151 171 169 151 183 177 142 191 182 136 255 255 255]; mask:((Depth1Image new) width:14; height:13; bits:(ByteArray fromPackedString:'@C @O@A<??3?<O?0??C?<O?0??C?<O?0??@b') ; yourself); yourself]

! !

!TestRunnerMini 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::TestRunnerMini andSelector:#windowSpec

     Tools::TestRunnerMini new openInterface:#windowSpec

     Tools::TestRunnerMini open

    "

    <resource: #canvas>

    ^ 

    #(FullSpec

       name: windowSpec

       window: 

      (WindowSpec

         label: 'Mini Test Runner'

         name: 'Mini Test Runner'

         min: (Point 10 10)

         bounds: (Rectangle 0 0 600 50)

       )

       component: 

      (SpecCollection

         collection: (

          (ViewSpec

             name: 'Box1'

             layout: (LayoutFrame 0 0 0 0 0 1 0 1)

             backgroundChannel: resultBackgroundColorAspect

             component: 

            (SpecCollection

               collection: (

                (HorizontalPanelViewSpec

                   name: 'RunnerInnerBox'

                   layout: (LayoutFrame 0 0 0 0 -2 1 0 1)

                   backgroundChannel: resultBackgroundColorAspect

                   horizontalLayout: rightSpaceFit

                   verticalLayout: topSpace

                   horizontalSpace: 0

                   elementsChangeSize: true

                   component: 

                  (SpecCollection

                     collection: (

                      (ViewSpec

                         name: 'RunnerInfoBox'

                         backgroundChannel: resultBackgroundColorAspect

                         component: 

                        (SpecCollection

                           collection: (

                            (LabelSpec

                               label: 'Run tests first!!'

                               name: 'ResultName'

                               layout: (LayoutFrame 22 0 0 0 0 1 -10 1)

                               backgroundChannel: resultBackgroundColorAspect

                               foregroundColor: (Color 100.0 100.0 100.0)

                               translateLabel: true

                               labelChannel: resultNameAspect

                               adjust: left

                             )

                            (ActionButtonSpec

                               name: 'Button3'

                               layout: (LayoutFrame 5 0 3 0 21 0 17 0)

                               activeHelpKey: pin

                               level: 0

                               visibilityChannel: pinButtonVisibleHolder

                               backgroundChannel: resultBackgroundColorAspect

                               hasCharacterOrientedLabel: false

                               translateLabel: true

                               labelChannel: pinIcon

                               model: pin

                             )

                            )

                         )

                         extent: (Point 219 31)

                       )

                      (ActionButtonSpec

                         label: 'Debug'

                         name: 'DebugButton'

                         activeHelpKey: debugSelected

                         translateLabel: true

                         model: debug

                         enableChannel: runEnabledHolder

                         extent: (Point 60 25)

                       )

                      (ActionButtonSpec

                         label: 'Stop'

                         name: 'Button2'

                         activeHelpKey: stopRun

                         visibilityChannel: runningHolder

                         translateLabel: true

                         model: stop

                         extent: (Point 60 25)

                       )

                      (ActionButtonSpec

                         label: 'Run'

                         name: 'Run'

                         activeHelpKey: runSelected

                         visibilityChannel: notRunningHolder

                         translateLabel: true

                         model: run

                         enableChannel: runEnabledHolder

                         extent: (Point 60 25)

                       )

                      (ActionButtonSpec

                         label: 'Failed'

                         name: 'Button1'

                         activeHelpKey: runFailed

                         visibilityChannel: runFailedButtonVisibleHolder

                         translateLabel: true

                         model: runFailed

                         enableChannel: runFailedEnabledHolder

                         extent: (Point 60 25)

                       )

                      (ActionButtonSpec

                         label: 'Run All'

                         name: 'RunAll'

                         activeHelpKey: runAll

                         visibilityChannel: runAllButtonVisibleHolder

                         translateLabel: true

                         model: runAll

                         enableChannel: runAllEnabledHolder

                         extent: (Point 60 25)

                       )

                      (ActionButtonSpec

                         label: 'Coverage'

                         name: 'Button4'

                         activeHelpKey: runAllWithCoverage

                         visibilityChannel: runAllButtonVisibleHolder

                         translateLabel: true

                         model: runAllWithCoverage

                         enableChannel: runAllEnabledHolder

                         extent: (Point 80 25)

                       )

                      )

                   )

                   postBuildCallback: postBuildRunnerPanel:

                 )

                (LabelSpec

                   name: 'ResultInfo'

                   layout: (LayoutFrame 0 0 -20 1 0 0.5 0 1)

                   style: (FontDescription helvetica medium roman 8 #'iso10646-1')

                   backgroundChannel: resultBackgroundColorAspect

                   translateLabel: true

                   labelChannel: resultInfoAspect

                   adjust: left

                 )

                (ViewSpec

                   name: 'ProgressPanel'

                   layout: (LayoutFrame -32 0.5 -17 1 -3 1.0 -5 1)

                   initiallyInvisible: true

                   visibilityChannel: progressIndicatorShownHolder

                   backgroundChannel: resultBackgroundColorAspect

                   component: 

                  (SpecCollection

                     collection: (

                      (ProgressIndicatorSpec

                         name: 'RunningProgress'

                         layout: (LayoutFrame 5 0 0 0 -5 1 0 1)

                         model: progressHolder

                         postBuildCallback: postBuildProgressIndicator:

                       )

                      )

                   )

                 )

                )

             )

           )

          )

       )

     )

! !

!TestRunnerMini class methodsFor:'queries'!

shouldRememberLastExtent

    "to be redefined by concrete applications:

     if true is answered, the application's extent is remembered on close

     and used as a default when opened the next time"

    ^ false

    "Created: / 22-09-2014 / 14:02:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestRunnerMini methodsFor:'accessing'!

allTestCases

    allTestCases isNil ifTrue:[

        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"

!

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"

!

selectedTestMethodsFromProtocols:protocols 

    |methods generator selectedClass|

    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 ] ]) 

            ifTrue:[ methods add:mthd ] 

        ] 

    ] ifFalse:[

        allTestCases 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: / 22-07-2011 / 15:53:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified (format): / 04-06-2012 / 19:05:32 / cg"

!

selectedTestMethodsFromProtocols:protocols inClass:aTestClass

    |methods generator|

    methods := Set new.

    generator := self methodGeneratorHolder value.

    generator notNil ifTrue:[ 

        generator do: [:cls :cat :sel :mthd | 

            (mthd notNil 

                and:[ (self isTestCaseLike:(aTestClass ? cls)) 

                and:[ (aTestClass ? cls) isTestSelector:sel ] ]) 

            ifTrue:[ methods add:mthd ] 

        ] 

    ] ifFalse:[

        self allTestCases 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: / 22-07-2011 / 15:53:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "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

    self allTestCases isEmptyOrNil ifTrue:[^nil].

    allTestCases size > 1 ifTrue:[^nil].

    ^allTestCases anyOne.

    "Created: / 22-07-2011 / 15:44:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!TestRunnerMini methodsFor:'actions'!

allCoveredClasses

    "return a collection of classes which are covered by the selected

     tests. Requires that the testcase returns a non-empty collection

     from the coveredClasses query"

    |testedClasses suite|

    testedClasses := Set new.

    suite := self suiteForRunAll.

    suite tests do:[:eachTest |

        testedClasses addAll:(eachTest class coveredClasses).

    ].

    ^ testedClasses

!

debug

    | suiteAndResult suite result | 

    suiteAndResult := self resultHolder value.

    suite := suiteAndResult suiteForRun.

    "/ suite tests size ~= 1 ifTrue:[^self breakPoint: #jv].

    "/ test := suiteAndResult suite tests anyOne.

    result := TestResult defaultResultClass new.

    suiteAndResult := SuiteAndResult suite: suite result: result.

    self stop.

    "/ debug run is synchronous

    [

        self runningHolder value:true.

        suite tests do:[:test |

            [

                test debug. 

            ] ifCurtailed:[

                result failureOutcomes add: test.

                self resultHolder value:suiteAndResult; changed.    

            ].

            (test class testSelectorPassed:test selector) ifTrue:[

                "/ result := TestResult defaultResultClass new.

                "/ result passed add: test.

                "/ suiteAndResult := SuiteAndResult suite: suite result: result.