"{ Encoding: utf8 }"

"

 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 resultNameAspect

		currentTestCaseName'

	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'!

helpSpec

    "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 helpSpec 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 outcomes are remembered'

#runFailed

'Only rerun failed tests.\\No debugger is opened on error or assertion failure,\but the test outcomes are remembered'     

#runSelected

'Run the selected test(s).\\No debugger is opened on error or assertion failure,\but the test outcomes are remembered'     

#stopRun

'Stop the test-run'

#pin

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

#runAllWithCoverage

'Run all tests with coverage measurement.\\This first recompiles all classes which are covered by the test(s) with instrumentation enabled,\so that reached code is recorded (runs a bit slower).\After the run, the browser will colorize reached code in green, unreached code in red, and partially reached code in orange.\\Classes to be coverage tested are defined by the test''s #coveredClasses or #coveredClassNames method'

)

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

    "Modified: / 21-03-2019 / 22:31:07 / Claus Gittinger"

! !

!TestRunnerMini class methodsFor:'image specs'!

pinIcon

    <resource: #programImage>

    ^  self pinIcon2

    "Modified: / 28-07-2018 / 09:49:24 / Claus Gittinger"

!

pinIcon1

    "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 pinIcon1 inspect

     ImageEditor openOnClass:self andSelector:#pinIcon1

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:'Tools::TestRunnerMini pinIcon1'

        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]

!

pinIcon2

    "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 pinIcon2 inspect

     ImageEditor openOnClass:self andSelector:#pinIcon2

     Icon flushCachedIcons

    "

    <resource: #image>

    ^Icon

        constantNamed:'Tools::TestRunnerMini pinIcon2'

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

NC 8NC 8NC 8HR8/L"D8NC 8NC 8NC !!J3@1L# 8NC 8NC 8HR80J3@/APXDB@8OB3L+L3L0KB8RD1TVE1$ZJ2<0L2,!!HPTGA@$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 114 0 18 97 25 0 82 21 0 149 30 0 155 66 53 182 73 138 181 81 147 202 129 179 163 110 167 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:'@G0@_@C<??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

       uuid: '0d236cb2-50b6-11e9-a55c-b8f6b1108e05'

       window: 

      (WindowSpec

         label: 'Mini Test Runner'

         name: 'Mini Test Runner'

         uuid: 'e9826d32-50a4-11e9-a55c-b8f6b1108e05'

         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)

             uuid: 'e9827192-50a4-11e9-a55c-b8f6b1108e05'

             backgroundChannel: resultBackgroundColorAspect

             component: 

            (SpecCollection

               collection: (

                (HorizontalPanelViewSpec

                   name: 'RunnerInnerBox'

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

                   uuid: 'e9827372-50a4-11e9-a55c-b8f6b1108e05'

                   backgroundChannel: resultBackgroundColorAspect

                   horizontalLayout: rightSpaceFit

                   verticalLayout: topSpace

                   horizontalSpace: 0

                   elementsChangeSize: true

                   component: 

                  (SpecCollection

                     collection: (

                      (ViewSpec

                         name: 'RunnerInfoBox'

                         uuid: 'e98275ca-50a4-11e9-a55c-b8f6b1108e05'

                         backgroundChannel: resultBackgroundColorAspect

                         component: 

                        (SpecCollection

                           collection: (

                            (ActionButtonSpec

                               name: 'Button3'

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

                               activeHelpKey: pin

                               uuid: 'e98276b0-50a4-11e9-a55c-b8f6b1108e05'

                               level: 0

                               visibilityChannel: pinButtonVisibleHolder

                               backgroundChannel: resultBackgroundColorAspect

                               hasCharacterOrientedLabel: false

                               translateLabel: true

                               labelChannel: pinIcon

                               model: pin

                             )

                            (LabelSpec

                               label: 'Run tests first!!'

                               name: 'ResultName'

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

                               uuid: 'e9827a5c-50a4-11e9-a55c-b8f6b1108e05'

                               backgroundChannel: resultBackgroundColorAspect

                               foregroundChannel: resultTextForegroundColorAspect

                               foregroundColor: (Color 100.0 100.0 100.0)

                               translateLabel: true

                               labelChannel: resultNameAspect

                               adjust: left

                             )

                            (ViewSpec

                               name: 'ProgressPanel'

                               layout: (LayoutFrame 0 0 -12 1 0 1.0 -6 1)

                               uuid: 'e9827c6e-50a4-11e9-a55c-b8f6b1108e05'

                               initiallyInvisible: true

                               visibilityChannel: progressIndicatorShownHolder

                               backgroundChannel: resultBackgroundColorAspect

                               component: 

                              (SpecCollection

                                 collection: (

                                  (ProgressIndicatorSpec

                                     name: 'ProgressIndicator1'

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

                                     uuid: 'e9827d90-50a4-11e9-a55c-b8f6b1108e05'

                                     level: 0

                                     model: progressHolder

                                     postBuildCallback: postBuildProgressIndicator:

                                   )

                                  )

                               )

                             )

                            )

                         )

                         extent: (Point 206 31)

                       )

                      (ActionButtonSpec

                         label: 'Debug'

                         name: 'DebugButton'

                         activeHelpKey: debugSelected

                         uuid: 'e982804c-50a4-11e9-a55c-b8f6b1108e05'

                         translateLabel: true

                         model: debug

                         enableChannel: runEnabledHolder

                         extent: (Point 60 25)

                       )

                      (ActionButtonSpec

                         label: 'Stop'

                         name: 'Button2'

                         activeHelpKey: stopRun

                         uuid: 'e98281fa-50a4-11e9-a55c-b8f6b1108e05'

                         visibilityChannel: runningHolder

                         translateLabel: true

                         model: stop

                         extent: (Point 60 25)

                       )

                      (ActionButtonSpec

                         label: 'Run'

                         name: 'Run'

                         activeHelpKey: runSelected

                         uuid: 'e98283a8-50a4-11e9-a55c-b8f6b1108e05'

                         visibilityChannel: notRunningHolder

                         translateLabel: true

                         model: run

                         enableChannel: runEnabledHolder

                         extent: (Point 60 25)

                       )

                      (ActionButtonSpec

                         label: 'Failed'

                         name: 'Button1'

                         activeHelpKey: runFailed

                         uuid: 'e982852e-50a4-11e9-a55c-b8f6b1108e05'

                         visibilityChannel: runFailedButtonVisibleHolder

                         translateLabel: true

                         model: runFailed

                         enableChannel: runFailedEnabledHolder

                         extent: (Point 60 25)

                       )

                      (ActionButtonSpec

                         label: 'Run All'

                         name: 'RunAll'

                         activeHelpKey: runAll

                         uuid: 'e9828696-50a4-11e9-a55c-b8f6b1108e05'

                         visibilityChannel: runAllButtonVisibleHolder

                         translateLabel: true

                         model: runAll

                         enableChannel: runAllEnabledHolder

                         extent: (Point 60 25)

                       )

                      (ActionButtonSpec

                         label: 'Coverage'

                         name: 'Button4'

                         activeHelpKey: runAllWithCoverage

                         uuid: 'e98287fe-50a4-11e9-a55c-b8f6b1108e05'

                         visibilityChannel: runAllButtonVisibleHolder

                         translateLabel: true

                         model: runAllWithCoverage

                         enableChannel: runAllEnabledHolder

                         extent: (Point 80 25)

                       )

                      )

                   )

                   postBuildCallback: postBuildRunnerPanel:

                 )

                (LabelSpec

                   name: 'ResultInfo'

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

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

                   uuid: 'e9828984-50a4-11e9-a55c-b8f6b1108e05'

                   backgroundChannel: resultBackgroundColorAspect

                   foregroundChannel: resultTextForegroundColorAspect

                   translateLabel: true

                   labelChannel: resultInfoAspect

                   adjust: left

                 )

                )

             )

           )

          )

       )

     )

! !

!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 := methods asOrderedCollection.

    methods sortBySelector:#selector.

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