"{ Package: 'stx:goodies/sunit' }"

ApplicationModel subclass:#TestRunner

	instanceVariableNames:'result lastPass defect allDefects defectMenu details mode

		scriptModel script numberOfTestsToRun testsWhichFailed

		testsWhichPassed categoryModel category'

	classVariableNames:''

	poolDictionaries:''

	category:'SUnit-UI'

!

!TestRunner class methodsFor:'documentation'!

documentation

"

    This GUI is based on SUnit2.7 and 

    was ported to ST/X by Samuel S. Schuster (as 2.7)  (thanks, indeed)

    It was slightly enhanced by adding a rerun-defects, browse and

    a category selector (to minor revision 2.7d, in the meantime)

" 

! !

!TestRunner class methodsFor:'defaults'!

colorForFailedTests

    ^ Color red

!

colorForPassedTests

    ^ Color green darkened

!

defaultIcon

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

     ImageEditor openOnClass:self andSelector:#defaultIcon

    "

    <resource: #image>

    ^Icon

	constantNamed:#'TestRunner class defaultIcon'

	ifAbsentPut:[(Depth4Image new) width: 28; height: 28; photometric:(#palette); bitsPerSample:(#(4 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'

@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@O??C???????C?<O?0@@??<O??????<O?0??@@@@@@@@@@@@@@@@@@@@@BH"H"H"

H"H"H#L3L0@@H"H"H"H"H"H#L3L3@@@"H"H"H"H"H#L3L3L@@BH"H"H"H"H#L3L3L0@@H"H"H"H@@@L1L3L3@@@"H"H"HO??<A@3L3L@@BH"H"HO???1@3L3

L0@@H"H"HO???1@@L3L3@@@"H"H <_?1@O@3L3L@@BH"H"C0G1@O<CL3L0@@H"H"HO@A@O?0L3L3@@@"H"H ?0@O??@3L3L@@BH"H#LO<O??@3L3L0@@H"H#

L3C???@3L3L3@@@"H#L3L0@@@3L3L3L@@BH#L3L3L3L3L3L3L0@@H#L3L3L3L3L3L3L3@@@#L3L3L3L3L3L3L3L@@CL3L3L3L3L3L3L3L0@@@@@@@@@@@@@@

@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@b') ; colorMapFromArray:#[0 0 0 255 255 255 255 0 0 0 255 0 0 0 255 0 255 255 255 255 0 255 0 255 127 0 0 0 127 0 0 0 127 0 127 127 127 127 0 127 0 127 127 127 127 170 170 170]; mask:((Depth1Image new) width: 28; height: 28; photometric:(#blackIs0); bitsPerSample:(#(1 )); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'

@@@@@@@@@@A???? _???8G???>A???? _???8G???>A???? _???8G???>A???? _???8G???>A???? _???8G???>A???? _???8G???>A???? _???8G??

?>A???? _???8G???>@@@@@@@@@@@@@a') ; yourself); yourself]

! !

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

     TestRunner new openInterface:#windowSpec

     TestRunner open

    "

    <resource: #canvas>

    ^ 

     #(#FullSpec

        #name: #windowSpec

        #window: 

       #(#WindowSpec

          #label: 'SUnit Camp Smalltalk 2.7d TestRunner'

          #name: 'SUnit Camp Smalltalk 2.7d TestRunner'

          #min: #(#Point 362 122)

          #bounds: #(#Rectangle 177 150 670 325)

          #icon: #defaultIcon

        )

        #component: 

       #(#SpecCollection

          #collection: #(

           #(#ActionButtonSpec

              #label: 'Refresh'

              #name: 'Button3'

              #layout: #(#LayoutFrame 0 0 0 0 75 0 48 0)

              #model: #refreshSuites

            )

           #(#MenuButtonSpec

              #name: 'category'

              #layout: #(#LayoutFrame 76 0 0 0 -216 1 24 0)

              #model: #category

              #menu: #categoryList

            )

           #(#MenuButtonSpec

              #name: #tests

              #layout: #(#LayoutFrame 76 0 24 0 -216 1 48 0)

              #model: #script

              #menu: #scriptModel

              #useIndex: true

            )

           #(#ActionButtonSpec

              #label: 'Run'

              #name: 'Button1'

              #layout: #(#LayoutFrame -215 1 0 0 -160 1 48 0)

              #model: #runTests

              #enableChannel: #enableRunButton

            )

           #(#ActionButtonSpec

              #label: 'ReRun Defects'

              #name: 'Button5'

              #layout: #(#LayoutFrame -159 1 0 0 -57 1 48 0)

              #model: #runDefects

              #enableChannel: #enableRunDefectsButton

            )

           #(#ActionButtonSpec

              #label: 'Run All'

              #name: 'Button2'

              #layout: #(#LayoutFrame -56 1 0 0 0 1 48 0)

              #model: #runAllTests

            )

           #(#ProgressIndicatorSpec

              #name: 'ProgressIndicator1'

              #layout: #(#LayoutFrame 0 0.0 49 0 0 1.0 60 0)

              #visibilityChannel: #percentageIndicatorVisible

              #model: #percentageDone

              #foregroundColor: #(#Color 32.9992 32.9992 0.0)

              #backgroundColor: #(#Color 66.9993 66.9993 0.0)

              #showPercentage: false

            )

           #(#LabelSpec

              #label: 'N/A'

              #name: 'mode'

              #layout: #(#LayoutFrame 0 0 49 0 0 1 0 0.5)

              #style: #(#FontDescription #Arial #bold #roman 14)

              #labelChannel: #mode

            )

           #(#LabelSpec

              #label: '...'

              #name: 'details'

              #layout: #(#LayoutFrame 0 0 0 0.5 0 1 -25 1)

              #labelChannel: #details

            )

           #(#MenuButtonSpec

              #name: #defects

              #layout: #(#LayoutFrame 0 0 -24 1 -152 1 0 1)

              #isOpaque: true

              #flags: 40

              #model: #selectionHolder

              #initiallyDisabled: true

              #enableChannel: #enableDefectsList

              #menu: #defectMenu

            )

           #(#ActionButtonSpec

              #label: 'Browse'

              #name: 'Button4'

              #layout: #(#LayoutFrame -151 1 -24 1 -76 1 0 1)

              #model: #browseSelectedTestCase

              #initiallyDisabled: true

              #enableChannel: #enableRunButton

            )

           #(#ActionButtonSpec

              #label: 'Debug'

              #name: 'Button6'

              #layout: #(#LayoutFrame -75 1 -24 1 0 1 0 1)

              #model: #debugSelectedFailure

              #initiallyDisabled: true

              #enableChannel: #enableDebugButton

            )

           )

        )

      )

! !

!TestRunner class methodsFor:'opening'!

open

	^super open

!

openOnTestCase:aTestCaseSubclass

    |runner idx|

    runner := self new.

    runner open.

    runner window waitUntilVisible.

    idx := runner scriptModel value indexOf:aTestCaseSubclass name.

    runner script value:idx.

    "

     self openOnTestCase:CompilerTest

    "

! !

!TestRunner 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)."

    ^ #(

        #script

      ).

! !

!TestRunner methodsFor:'Accessing'!

category

    |holder|

    (holder := builder bindingAt:#category) isNil ifTrue:[

        holder := '* all *' asValue.

        builder aspectAt:#category put:holder.

        holder onChangeSend:#categorySelectionChanged to:self.

    ].

    ^ holder.

!

categoryList

    ^categoryModel isNil 

        ifTrue: [categoryModel := ValueHolder new. self updateCategoryList. categoryModel]

        ifFalse: [categoryModel]

!

defectMenu

    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."

    "*** (which may not be the one you wanted)"

    "*** Please change as required and accept it in the browser."

    ^defectMenu isNil 

	ifTrue: [defectMenu := OrderedCollection new asValue]

	ifFalse: [defectMenu]

    "Modified: / 4.4.2000 / 20:00:31 / Sames"

!

defects

	^self builder componentAt: #defects

    "Created: / 21.6.2000 / 12:19:29 / Sames"

!

details

	"This method was generated by UIDefiner.  Any edits made here

	may be lost whenever methods are automatically defined.  The

	initialization provided below may have been preempted by an

	initialize method."

	^details isNil

		ifTrue:

			[details := '...' asValue]

		ifFalse:

			[details]

!

mode

	"This method was generated by UIDefiner.  Any edits made here

	may be lost whenever methods are automatically defined.  The

	initialization provided below may have been preempted by an

	initialize method."

	^mode isNil

		ifTrue:

			[mode := 'N/A' asValue]

		ifFalse:

			[mode]

!

percentageDone

    |holder|

    (holder := builder bindingAt:#percentageDone) isNil ifTrue:[

	holder := 0 asValue.

	builder aspectAt:#percentageDone put:holder.

    ].

    ^ holder.

!

percentageIndicatorVisible

    |holder|

    (holder := builder bindingAt:#percentageIndicatorVisible) isNil ifTrue:[

	holder := false asValue.

	builder aspectAt:#percentageIndicatorVisible put:holder.

    ].

    ^ holder.

!

script

    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."

    "*** (which may not be the one you wanted)"

    "*** Please change as required and accept it in the browser."

    |holder|

    (holder := builder bindingAt:#script) isNil ifTrue:[

	holder := ValueHolder new.

	builder aspectAt:#script put:holder.

	holder onChangeSend:#scriptSelectionChanged to:self.

"/        holder addDependent:self.

    ].

    ^ holder.

    "Created: / 21.6.2000 / 12:04:36 / Sames"

!

script:something

    "automatically generated by UIPainter ..."

    "This method is used when I am embedded as subApplication,"

    "and the mainApp wants to connect its aspects to mine."

"/     |holder|

"/     (holder := builder bindingAt:#script) notNil ifTrue:[

"/         holder removeDependent:self.

"/     ].

    builder aspectAt:#script put:something.

"/     something notNil ifTrue:[

"/         something addDependent:self.

"/     ].

    ^ self.

    "Created: / 21.6.2000 / 12:04:36 / Sames"

!

scriptModel

    "This method was generated by UIDefiner.  Any edits made here

        may be lost whenever methods are automatically defined.  The

        initialization provided below may have been preempted by an

        initialize method."

    ^scriptModel isNil 

        ifTrue: [scriptModel := ValueHolder new. self updateSuitesList. scriptModel]

        ifFalse: [scriptModel]

    "Modified: / 2.4.2000 / 14:37:51 / Sames"

!

selection

	^defect

    "Created: / 4.4.2000 / 18:50:55 / Sames"

!

selectionHolder

    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."

    "*** (which may not be the one you wanted)"

    "*** Please change as required and accept it in the browser."

    |holder|

    (holder := builder bindingAt:#selectionHolder) isNil ifTrue:[

	holder := AspectAdaptor new subject:self; forAspect:#selection.

	builder aspectAt:#selectionHolder put:holder.

"/        holder addDependent:self.

    ].

    ^ holder.

    "Created: / 4.4.2000 / 18:46:08 / Sames"

    "Modified: / 4.4.2000 / 18:47:31 / Sames"

!

tests

	^self builder componentAt: #tests

    "Created: / 4.4.2000 / 19:57:37 / Sames"

! !

!TestRunner methodsFor:'Actions'!

browseSelectedTestCase

    |testCaseName testCase|

    testCaseName := self selectedScript.

    testCaseName notNil ifTrue:[

        testCase := Smalltalk at:testCaseName asSymbol.

        testCase notNil ifTrue:[

            (UserPreferences current systemBrowserClass openInClass:testCase)

                selectProtocolsMatching:'*'        

        ]

    ]

!

categorySelectionChanged

    self updateSuitesList

!

debugSelectedFailure

	self debugTest: self selection

    "Created: / 21.6.2000 / 10:58:58 / Sames"

    "Modified: / 21.6.2000 / 12:21:05 / Sames"

!

debugTest: aTestCaseName 

    | testCase |

    defect := aTestCaseName.

    testCase := allDefects at: aTestCaseName ifAbsent: [nil].

    testCase isNil ifTrue: [^self enableDebugButton value: false].

    self enableDebugButton value: true.

    self displayMode: 'Debugging'.

    defect := nil.

    self withWaitCursorDo:[

        (result isFailure: testCase) 

            ifTrue: [testCase debugAsFailure]

            ifFalse: [testCase debug].

    ].

    "Modified: / 21.6.2000 / 12:12:09 / Sames"

!

enableDebugButton

    "automatically generated by UIPainter ..."

    "*** the code below creates a default model when invoked."

    "*** (which may not be the one you wanted)"

    "*** Please change as required and accept it in the browser."

    | holder |

    (holder := builder bindingAt: #enableDebugButton) isNil 

	ifTrue: 

	    [holder := true asValue.

	    builder aspectAt: #enableDebugButton put: holder

	    "        holder addDependent:self."].

    ^holder

    "Created: / 21.6.2000 / 10:47:34 / Sames"