Frank Shearar uploaded a new version of SUnitGUI to project The Trunk: http://source.squeak.org/trunk/SUnitGUI-fbs.57.mcz
==================== Summary ====================
Name: SUnitGUI-fbs.57 Author: fbs Time: 31 May 2013, 4:03:07.92 pm UUID: b836135e-01ed-4f6e-b671-36c56a5fa89a Ancestors: SUnitGUI-eem.56
Move ToolBuilder-SUnit to SUnitGUI-ToolBuilder.
=============== Diff against SUnitGUI-eem.56 ===============
Item was changed: + SystemOrganization addCategory: #'SUnitGUI-ToolBuilder'! SystemOrganization addCategory: #SUnitGUI!
Item was added: + WidgetStub subclass: #ButtonStub + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnitGUI-ToolBuilder'!
Item was added: + ----- Method: ButtonStub>>click (in category 'simulating') ----- + click + | action | + action := spec action. + action isSymbol + ifTrue: [self model perform: action] + ifFalse: [action value]!
Item was added: + ----- Method: ButtonStub>>color (in category 'simulating') ----- + color + ^ state at: #color!
Item was added: + ----- Method: ButtonStub>>isEnabled (in category 'simulating') ----- + isEnabled + ^ state at: #enabled!
Item was added: + ----- Method: ButtonStub>>isPressed (in category 'simulating') ----- + isPressed + ^ state at: #state!
Item was added: + ----- Method: ButtonStub>>label (in category 'simulating') ----- + label + ^ state at: #label!
Item was added: + ----- Method: ButtonStub>>stateVariables (in category 'events') ----- + stateVariables + ^ #(label color state enabled)!
Item was added: + WidgetStub subclass: #CompositeStub + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnitGUI-ToolBuilder'!
Item was added: + ----- Method: CompositeStub>>children (in category 'accessing') ----- + children + ^ state at: #children ifAbsent: [#()]!
Item was added: + ----- Method: CompositeStub>>children: (in category 'accessing') ----- + children: anObject + state at: #children put: anObject!
Item was added: + ----- Method: CompositeStub>>stateVariables (in category 'accessing') ----- + stateVariables + ^ #(children)!
Item was added: + ----- Method: CompositeStub>>widgetNamed: (in category 'accessing') ----- + widgetNamed: aString + self name = aString + ifTrue: [^ self] + ifFalse: [self children do: [:ea | (ea widgetNamed: aString) ifNotNil: [:w | ^ w]]]. + ^ nil!
Item was added: + WidgetStub subclass: #ListStub + instanceVariableNames: 'list index' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnitGUI-ToolBuilder'!
Item was added: + ----- Method: ListStub>>click: (in category 'simulating') ----- + click: aString + self clickItemAt: (self list indexOf: aString)!
Item was added: + ----- Method: ListStub>>clickItemAt: (in category 'simulating') ----- + clickItemAt: anInteger + | selector | + selector := spec setIndex. + selector + ifNil: [self model perform: spec setSelected with: (self list at: anInteger)] + ifNotNil: [self model perform: selector with: anInteger] + !
Item was added: + ----- Method: ListStub>>list (in category 'simulating') ----- + list + ^ list ifNil: [Array new]!
Item was added: + ----- Method: ListStub>>menu (in category 'simulating') ----- + menu + ^ MenuStub fromSpec: + (self model + perform: spec menu + with: (PluggableMenuSpec withModel: self model))!
Item was added: + ----- Method: ListStub>>refresh (in category 'events') ----- + refresh + self refreshList. + self refreshIndex!
Item was added: + ----- Method: ListStub>>refreshIndex (in category 'events') ----- + refreshIndex + | selector | + selector := spec getIndex. + index := selector + ifNil: [self list indexOf: (self model perform: spec getSelected)] + ifNotNil: [spec model perform: selector] + !
Item was added: + ----- Method: ListStub>>refreshList (in category 'events') ----- + refreshList + list := self model perform: spec list!
Item was added: + ----- Method: ListStub>>selectedIndex (in category 'simulating') ----- + selectedIndex + ^ index ifNil: [0]!
Item was added: + ----- Method: ListStub>>selectedItem (in category 'simulating') ----- + selectedItem + | items idx | + (items := self list) isEmpty ifTrue: [^ nil]. + (idx := self selectedIndex) = 0 ifTrue: [^ nil]. + ^ items at: idx + !
Item was added: + ----- Method: ListStub>>update: (in category 'events') ----- + update: aSelector + aSelector = spec list ifTrue: [^ self refreshList]. + aSelector = spec getSelected ifTrue: [^ self refreshIndex]. + aSelector = spec getIndex ifTrue: [^ self refreshIndex]. + ^ super update: aSelector!
Item was added: + WidgetStub subclass: #MenuStub + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnitGUI-ToolBuilder'!
Item was added: + ----- Method: MenuStub>>click: (in category 'as yet unclassified') ----- + click: aString + | item | + item := self items detect: [:ea | ea label = aString] ifNone: [^ self]. + item action isSymbol + ifTrue: [self model perform: item action] + ifFalse: [item action value]!
Item was added: + ----- Method: MenuStub>>items (in category 'as yet unclassified') ----- + items + ^ spec items!
Item was added: + ----- Method: MenuStub>>labels (in category 'as yet unclassified') ----- + labels + ^ self items keys!
Item was added: + CompositeStub subclass: #PanelStub + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnitGUI-ToolBuilder'!
Item was added: + ToolBuilder subclass: #SUnitToolBuilder + instanceVariableNames: 'widgets' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnitGUI-ToolBuilder'! + + !SUnitToolBuilder commentStamp: 'cwp 6/7/2005 00:53' prior: 0! + I create a set of "stub" widgets that are useful for testing. Instead of drawing themselves in some GUI, they simulate graphical widgets for testing purposes. Through my widgets, unit tests can simulate user actions and make assertions about the state of the display. + + See TestRunnerPlusTest for examples.!
Item was added: + ----- Method: SUnitToolBuilder>>buildPluggableButton: (in category 'building') ----- + buildPluggableButton: aSpec + | w | + w := ButtonStub fromSpec: aSpec. + self register: w id: aSpec name. + ^w!
Item was added: + ----- Method: SUnitToolBuilder>>buildPluggableList: (in category 'building') ----- + buildPluggableList: aSpec + | w | + w := ListStub fromSpec: aSpec. + self register: w id: aSpec name. + ^w!
Item was added: + ----- Method: SUnitToolBuilder>>buildPluggableMenu: (in category 'building') ----- + buildPluggableMenu: aSpec + ^ MenuStub fromSpec: aSpec!
Item was added: + ----- Method: SUnitToolBuilder>>buildPluggablePanel: (in category 'building') ----- + buildPluggablePanel: aSpec + | w | + w := PanelStub fromSpec: aSpec. + self register: w id: aSpec name. + ^w!
Item was added: + ----- Method: SUnitToolBuilder>>buildPluggableText: (in category 'building') ----- + buildPluggableText: aSpec + | w | + w := TextStub fromSpec: aSpec. + self register: w id: aSpec name. + ^w!
Item was added: + ----- Method: SUnitToolBuilder>>buildPluggableTree: (in category 'building') ----- + buildPluggableTree: aSpec + | w | + w := TreeStub fromSpec: aSpec. + self register: w id: aSpec name. + ^w!
Item was added: + ----- Method: SUnitToolBuilder>>buildPluggableWindow: (in category 'building') ----- + buildPluggableWindow: aSpec + | window children | + window := WindowStub fromSpec: aSpec. + children := aSpec children. + children isSymbol + ifFalse: [window children: (children collect: [:ea | ea buildWith: self])]. + self register: window id: aSpec name. + ^ window!
Item was added: + ----- Method: SUnitToolBuilder>>close: (in category 'opening') ----- + close: aWidget + aWidget close!
Item was added: + ----- Method: SUnitToolBuilder>>open: (in category 'opening') ----- + open: anObject + ^ self build: anObject!
Item was added: + ----- Method: SUnitToolBuilder>>register:id: (in category 'private') ----- + register: widget id: id + id ifNil:[^self]. + widgets ifNil:[widgets := Dictionary new]. + widgets at: id put: widget.!
Item was added: + ----- Method: SUnitToolBuilder>>widgetAt:ifAbsent: (in category 'private') ----- + widgetAt: id ifAbsent: aBlock + widgets ifNil:[^aBlock value]. + ^widgets at: id ifAbsent: aBlock!
Item was added: + ToolBuilderTests subclass: #SUnitToolBuilderTests + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnitGUI-ToolBuilder'!
Item was added: + ----- Method: SUnitToolBuilderTests>>acceptWidgetText (in category 'support') ----- + acceptWidgetText + widget accept: 'Some text'!
Item was added: + ----- Method: SUnitToolBuilderTests>>buttonWidgetEnabled (in category 'support') ----- + buttonWidgetEnabled + ^ widget isEnabled!
Item was added: + ----- Method: SUnitToolBuilderTests>>changeListWidget (in category 'support') ----- + changeListWidget + widget clickItemAt: widget selectedIndex + 1!
Item was added: + ----- Method: SUnitToolBuilderTests>>fireButtonWidget (in category 'support') ----- + fireButtonWidget + widget click!
Item was added: + ----- Method: SUnitToolBuilderTests>>fireMenuItemWidget (in category 'support') ----- + fireMenuItemWidget + widget click: 'Menu Item'!
Item was added: + ----- Method: SUnitToolBuilderTests>>setUp (in category 'running') ----- + setUp + super setUp. + builder := SUnitToolBuilder new.!
Item was added: + ----- Method: SUnitToolBuilderTests>>testHandlingNotification (in category 'tests') ----- + testHandlingNotification + | receivedSignal resumed | + receivedSignal := resumed := false. + [ | count | + "client-code puts up progress, and signals some notications" + count := 0. + 'doing something' + displayProgressFrom: 0 + to: 10 + during: + [ : bar | 10 timesRepeat: + [ bar value: (count := count + 1). + (Delay forMilliseconds: 200) wait. + Notification signal: 'message'. + resumed := true ] ] ] + on: Notification + do: + [ : noti | receivedSignal := true. + noti resume ]. + self + assert: receivedSignal ; + assert: resumed!
Item was added: + ----- Method: SUnitToolBuilderTests>>testListCached (in category 'tests') ----- + testListCached + + self makeItemList. + queries := Bag new. + self changed: #getList. + widget list. + widget list. + self assert: queries size = 1!
Item was added: + ----- Method: SUnitToolBuilderTests>>testListSelectionCached (in category 'tests') ----- + testListSelectionCached + + self makeItemList. + queries := Bag new. + self changed: #getListSelection. + widget selectedIndex. + widget selectedIndex. + self assert: queries size = 1!
Item was added: + ----- Method: SUnitToolBuilderTests>>testTextCached (in category 'tests') ----- + testTextCached + + self makeText. + queries := Bag new. + self changed: #getText. + widget text. + widget text. + self assert: queries size = 1!
Item was added: + ----- Method: SUnitToolBuilderTests>>widgetColor (in category 'support') ----- + widgetColor + ^ widget color!
Item was added: + WidgetStub subclass: #TextStub + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnitGUI-ToolBuilder'!
Item was added: + ----- Method: TextStub>>accept: (in category 'simulating') ----- + accept: aString + state at: #getText put: aString. + ^ self model perform: spec setText with: aString asText!
Item was added: + ----- Method: TextStub>>color (in category 'simulating') ----- + color + ^ state at: #color!
Item was added: + ----- Method: TextStub>>stateVariables (in category 'events') ----- + stateVariables + ^ #(color selection getText)!
Item was added: + ----- Method: TextStub>>text (in category 'simulating') ----- + text + ^ state at: #getText!
Item was added: + WidgetStub subclass: #TreeNodeStub + instanceVariableNames: 'item' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnitGUI-ToolBuilder'!
Item was added: + ----- Method: TreeNodeStub class>>fromSpec:item: (in category 'instance creation') ----- + fromSpec: aSpec item: anObject + ^ self new setSpec: aSpec item: anObject!
Item was added: + ----- Method: TreeNodeStub>>children (in category 'simulating') ----- + children + ^ (self model perform: spec getChildren with: item) + collect: [:ea | TreeNodeStub fromSpec: spec item: ea]!
Item was added: + ----- Method: TreeNodeStub>>item (in category 'simulating') ----- + item + ^ item!
Item was added: + ----- Method: TreeNodeStub>>label (in category 'simulating') ----- + label + ^ self model perform: spec label with: item!
Item was added: + ----- Method: TreeNodeStub>>matches: (in category 'private') ----- + matches: aString + ^ self label = aString!
Item was added: + ----- Method: TreeNodeStub>>openPath: (in category 'events') ----- + openPath: anArray + | child | + anArray isEmpty + ifTrue: [self select] + ifFalse: [child := self children + detect: [:ea | ea matches: anArray first] + ifNone: [^ self select]. + child openPath: anArray allButFirst] + !
Item was added: + ----- Method: TreeNodeStub>>printOn: (in category 'printing') ----- + printOn: aStream + aStream + print: self class; + nextPut: $<; + print: item; + nextPut: $>!
Item was added: + ----- Method: TreeNodeStub>>select (in category 'simulating') ----- + select + self model perform: spec setSelected with: item!
Item was added: + ----- Method: TreeNodeStub>>selectPath: (in category 'private') ----- + selectPath: anArray + | child | + anArray isEmpty ifTrue: [^ self select]. + child := self children detect: [:ea | ea matches: anArray first] ifNone: [^ self select]. + child selectPath: anArray allButFirst.!
Item was added: + ----- Method: TreeNodeStub>>setSpec:item: (in category 'initialize-release') ----- + setSpec: aSpec item: anObject + super setSpec: aSpec. + item := anObject!
Item was added: + WidgetStub subclass: #TreeStub + instanceVariableNames: 'roots' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnitGUI-ToolBuilder'!
Item was added: + ----- Method: TreeStub>>openPath: (in category 'private') ----- + openPath: anArray + | first | + first := roots detect: [:ea | ea matches: anArray first] ifNone: [^ self]. + first openPath: anArray allButFirst!
Item was added: + ----- Method: TreeStub>>roots: (in category 'private') ----- + roots: anArray + roots := anArray collect: [:ea | TreeNodeStub fromSpec: spec item: ea]. + !
Item was added: + ----- Method: TreeStub>>select: (in category 'simulating') ----- + select: anArray + self openPath: anArray!
Item was added: + ----- Method: TreeStub>>setSpec: (in category 'initialize-release') ----- + setSpec: aSpec + super setSpec: aSpec. + self update: spec roots!
Item was added: + ----- Method: TreeStub>>update: (in category 'events') ----- + update: anObject + anObject == spec roots ifTrue: [^ self updateRoots]. + anObject == spec getSelectedPath ifTrue: [^ self updateSelectedPath]. + (anObject isKindOf: Array) ifTrue: [^ self openPath: anObject allButFirst]. + super update: anObject + !
Item was added: + ----- Method: TreeStub>>updateRoots (in category 'events') ----- + updateRoots + ^ self roots: (self model perform: spec roots) + !
Item was added: + ----- Method: TreeStub>>updateSelectedPath (in category 'events') ----- + updateSelectedPath + | path first | + path := self model perform: spec getSelectedPath. + first := roots detect: [:ea | ea item = path first] ifNone: [^ self]. + first selectPath: path allButFirst.!
Item was added: + Object subclass: #WidgetStub + instanceVariableNames: 'spec state' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnitGUI-ToolBuilder'!
Item was added: + ----- Method: WidgetStub class>>fromSpec: (in category 'instance creation') ----- + fromSpec: aSpec + ^ self new setSpec: aSpec!
Item was added: + ----- Method: WidgetStub>>model (in category 'simulating') ----- + model + ^ spec model!
Item was added: + ----- Method: WidgetStub>>name (in category 'accessing') ----- + name + ^ spec name ifNil: [' ']!
Item was added: + ----- Method: WidgetStub>>printOn: (in category 'printing') ----- + printOn: aStream + aStream + print: self class; + nextPut: $<; + nextPutAll: self name; + nextPut: $>!
Item was added: + ----- Method: WidgetStub>>refresh (in category 'events') ----- + refresh + self stateVariables do: [:var | self refresh: var]!
Item was added: + ----- Method: WidgetStub>>refresh: (in category 'events') ----- + refresh: var + | value | + value := spec perform: var. + self refresh: var with: value!
Item was added: + ----- Method: WidgetStub>>refresh:with: (in category 'events') ----- + refresh: var with: value + state + at: var + put: (value isSymbol + ifTrue: [spec model perform: value] + ifFalse: [value])!
Item was added: + ----- Method: WidgetStub>>setSpec: (in category 'initialize-release') ----- + setSpec: aSpec + state := IdentityDictionary new. + spec := aSpec. + spec model addDependent: self. + self refresh.!
Item was added: + ----- Method: WidgetStub>>spec (in category 'accessing') ----- + spec + ^ spec!
Item was added: + ----- Method: WidgetStub>>stateVariables (in category 'events') ----- + stateVariables + ^ #()!
Item was added: + ----- Method: WidgetStub>>update: (in category 'events') ----- + update: aSymbol + + self stateVariables do: + [:var | + (spec perform: var) == aSymbol ifTrue: + [self refresh: var with: aSymbol. + ^ self]]!
Item was added: + ----- Method: WidgetStub>>widgetNamed: (in category 'accessing') ----- + widgetNamed: aString + ^ self name = aString + ifTrue: [self] + ifFalse: [nil]!
Item was added: + CompositeStub subclass: #WindowStub + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnitGUI-ToolBuilder'!
Item was added: + ----- Method: WindowStub>>close (in category 'simulating') ----- + close + spec model perform: spec closeAction!
Item was added: + ----- Method: WindowStub>>stateVariables (in category 'events') ----- + stateVariables + ^ super stateVariables, #(label)!