The Inbox: ToolBuilder-SUnit-mt.20.mcz

Christoph Thiede uploaded a new version of ToolBuilder-SUnit to project The Inbox:
http://source.squeak.org/inbox/ToolBuilder-SUnit-mt.20.mcz

==================== Summary ====================

Name: ToolBuilder-SUnit-mt.20
Author: mt
Time: 15 November 2019, 4:32:12.21533 pm
UUID: 42ab408c-6728-6749-8f5f-2eb2588936ff
Ancestors: ToolBuilder-SUnit-fbs.19

Updates widget stubs for tests.

=============== Diff against ToolBuilder-SUnit-fbs.19 ===============

Item was removed:
- SystemOrganization addCategory: #'ToolBuilder-SUnit'!

Item was removed:
- WidgetStub subclass: #ButtonStub
-        instanceVariableNames: ''
-        classVariableNames: ''
-        poolDictionaries: ''
-        category: 'ToolBuilder-SUnit'!

Item was removed:
- ----- Method: ButtonStub>>click (in category 'simulating') -----
- click
-        | action |
-        action := spec action.
-        action isSymbol
-                ifTrue: [self model perform: action]
-                ifFalse: [action value]!

Item was removed:
- ----- Method: ButtonStub>>color (in category 'simulating') -----
- color
-        ^ state at: #color!

Item was removed:
- ----- Method: ButtonStub>>isEnabled (in category 'simulating') -----
- isEnabled
-        ^ state at: #enabled!

Item was removed:
- ----- Method: ButtonStub>>isPressed (in category 'simulating') -----
- isPressed
-        ^ state at: #state!

Item was removed:
- ----- Method: ButtonStub>>label (in category 'simulating') -----
- label
-        ^ state at: #label!

Item was removed:
- ----- Method: ButtonStub>>stateVariables (in category 'events') -----
- stateVariables
-        ^ #(label color state enabled)!

Item was removed:
- WidgetStub subclass: #CompositeStub
-        instanceVariableNames: ''
-        classVariableNames: ''
-        poolDictionaries: ''
-        category: 'ToolBuilder-SUnit'!

Item was removed:
- ----- Method: CompositeStub>>children (in category 'accessing') -----
- children
-        ^ state at: #children ifAbsent: [#()]!

Item was removed:
- ----- Method: CompositeStub>>children: (in category 'accessing') -----
- children: anObject
-        state at: #children put: anObject!

Item was removed:
- ----- Method: CompositeStub>>stateVariables (in category 'accessing') -----
- stateVariables
-        ^ #(children)!

Item was removed:
- ----- 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 removed:
- WidgetStub subclass: #ListStub
-        instanceVariableNames: 'list index'
-        classVariableNames: ''
-        poolDictionaries: ''
-        category: 'ToolBuilder-SUnit'!

Item was removed:
- ----- Method: ListStub>>click: (in category 'simulating') -----
- click: aString
-        self clickItemAt: (self list indexOf: aString)!

Item was removed:
- ----- 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 removed:
- ----- Method: ListStub>>list (in category 'simulating') -----
- list
-        ^ list ifNil: [Array new]!

Item was removed:
- ----- Method: ListStub>>menu (in category 'simulating') -----
- menu
-        ^ MenuStub fromSpec:
-                (self model
-                        perform: spec menu
-                        with: (PluggableMenuSpec withModel: self model))!

Item was removed:
- ----- Method: ListStub>>refresh (in category 'events') -----
- refresh
-        self refreshList.
-        self refreshIndex!

Item was removed:
- ----- 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 removed:
- ----- Method: ListStub>>refreshList (in category 'events') -----
- refreshList
-        list := self model perform: spec list!

Item was removed:
- ----- Method: ListStub>>selectedIndex (in category 'simulating') -----
- selectedIndex
-        ^ index ifNil: [0]!

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- WidgetStub subclass: #MenuStub
-        instanceVariableNames: ''
-        classVariableNames: ''
-        poolDictionaries: ''
-        category: 'ToolBuilder-SUnit'!

Item was removed:
- ----- 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 removed:
- ----- Method: MenuStub>>items (in category 'as yet unclassified') -----
- items
-        ^ spec items!

Item was removed:
- ----- Method: MenuStub>>labels (in category 'as yet unclassified') -----
- labels
-        ^ self items keys!

Item was removed:
- CompositeStub subclass: #PanelStub
-        instanceVariableNames: ''
-        classVariableNames: ''
-        poolDictionaries: ''
-        category: 'ToolBuilder-SUnit'!

Item was removed:
- ToolBuilder subclass: #SUnitToolBuilder
-        instanceVariableNames: 'widgets'
-        classVariableNames: ''
-        poolDictionaries: ''
-        category: 'ToolBuilder-SUnit'!
-
- !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 removed:
- ----- Method: SUnitToolBuilder>>buildPluggableButton: (in category 'building') -----
- buildPluggableButton: aSpec
-        | w |
-        w := ButtonStub fromSpec: aSpec.
-        self register: w id: aSpec name.
-        ^w!

Item was removed:
- ----- Method: SUnitToolBuilder>>buildPluggableList: (in category 'building') -----
- buildPluggableList: aSpec
-        | w |
-        w := ListStub fromSpec: aSpec.
-        self register: w id: aSpec name.
-        ^w!

Item was removed:
- ----- Method: SUnitToolBuilder>>buildPluggableMenu: (in category 'building') -----
- buildPluggableMenu: aSpec
-        ^ MenuStub fromSpec: aSpec!

Item was removed:
- ----- Method: SUnitToolBuilder>>buildPluggablePanel: (in category 'building') -----
- buildPluggablePanel: aSpec
-        | w |
-        w := PanelStub fromSpec: aSpec.
-        self register: w id: aSpec name.
-        ^w!

Item was removed:
- ----- Method: SUnitToolBuilder>>buildPluggableText: (in category 'building') -----
- buildPluggableText: aSpec
-        | w |
-        w := TextStub fromSpec: aSpec.
-        self register: w id: aSpec name.
-        ^w!

Item was removed:
- ----- Method: SUnitToolBuilder>>buildPluggableTree: (in category 'building') -----
- buildPluggableTree: aSpec
-        | w |
-        w := TreeStub fromSpec: aSpec.
-        self register: w id: aSpec name.
-        ^w!

Item was removed:
- ----- 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 removed:
- ----- Method: SUnitToolBuilder>>close: (in category 'opening') -----
- close: aWidget
-        aWidget close!

Item was removed:
- ----- Method: SUnitToolBuilder>>open: (in category 'opening') -----
- open: anObject
-        ^ self build: anObject!

Item was removed:
- ----- 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 removed:
- ----- Method: SUnitToolBuilder>>widgetAt:ifAbsent: (in category 'private') -----
- widgetAt: id ifAbsent: aBlock
-        widgets ifNil:[^aBlock value].
-        ^widgets at: id ifAbsent: aBlock!

Item was removed:
- ToolBuilderTests subclass: #SUnitToolBuilderTests
-        instanceVariableNames: ''
-        classVariableNames: ''
-        poolDictionaries: ''
-        category: 'ToolBuilder-SUnit'!

Item was removed:
- ----- Method: SUnitToolBuilderTests>>acceptWidgetText (in category 'support') -----
- acceptWidgetText
-        widget accept: 'Some text'!

Item was removed:
- ----- Method: SUnitToolBuilderTests>>buttonWidgetEnabled (in category 'support') -----
- buttonWidgetEnabled
-        ^ widget isEnabled!

Item was removed:
- ----- Method: SUnitToolBuilderTests>>changeListWidget (in category 'support') -----
- changeListWidget
-        widget clickItemAt: widget selectedIndex + 1!

Item was removed:
- ----- Method: SUnitToolBuilderTests>>fireButtonWidget (in category 'support') -----
- fireButtonWidget
-        widget click!

Item was removed:
- ----- Method: SUnitToolBuilderTests>>fireMenuItemWidget (in category 'support') -----
- fireMenuItemWidget
-        widget click: 'Menu Item'!

Item was removed:
- ----- Method: SUnitToolBuilderTests>>setUp (in category 'running') -----
- setUp
-        super setUp.
-        builder := SUnitToolBuilder new.!

Item was removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- 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 removed:
- ----- Method: SUnitToolBuilderTests>>widgetColor (in category 'support') -----
- widgetColor
-        ^ widget color!

Item was removed:
- WidgetStub subclass: #TextStub
-        instanceVariableNames: ''
-        classVariableNames: ''
-        poolDictionaries: ''
-        category: 'ToolBuilder-SUnit'!

Item was removed:
- ----- Method: TextStub>>accept: (in category 'simulating') -----
- accept: aString
-        state at: #getText put: aString.
-        ^ self model perform: spec setText with: aString asText!

Item was removed:
- ----- Method: TextStub>>color (in category 'simulating') -----
- color
-        ^ state at: #color!

Item was removed:
- ----- Method: TextStub>>stateVariables (in category 'events') -----
- stateVariables
-        ^ #(color selection getText)!

Item was removed:
- ----- Method: TextStub>>text (in category 'simulating') -----
- text
-        ^ state at: #getText!

Item was removed:
- WidgetStub subclass: #TreeNodeStub
-        instanceVariableNames: 'item'
-        classVariableNames: ''
-        poolDictionaries: ''
-        category: 'ToolBuilder-SUnit'!

Item was removed:
- ----- Method: TreeNodeStub class>>fromSpec:item: (in category 'instance creation') -----
- fromSpec: aSpec item: anObject
-        ^ self new setSpec: aSpec item: anObject!

Item was removed:
- ----- Method: TreeNodeStub>>children (in category 'simulating') -----
- children
-        ^ (self model perform: spec getChildren with: item)
-                collect: [:ea | TreeNodeStub fromSpec: spec item: ea]!

Item was removed:
- ----- Method: TreeNodeStub>>item (in category 'simulating') -----
- item
-        ^ item!

Item was removed:
- ----- Method: TreeNodeStub>>label (in category 'simulating') -----
- label
-        ^ self model perform: spec label with: item!

Item was removed:
- ----- Method: TreeNodeStub>>matches: (in category 'private') -----
- matches: aString
-        ^ self label = aString!

Item was removed:
- ----- 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 removed:
- ----- Method: TreeNodeStub>>printOn: (in category 'printing') -----
- printOn: aStream
-        aStream
-                print: self class;
-                nextPut: $<;
-                print: item;
-                nextPut: $>!

Item was removed:
- ----- Method: TreeNodeStub>>select (in category 'simulating') -----
- select
-        self model perform: spec setSelected with: item!

Item was removed:
- ----- 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 removed:
- ----- Method: TreeNodeStub>>setSpec:item: (in category 'initialize-release') -----
- setSpec: aSpec item: anObject
-        super setSpec: aSpec.
-        item := anObject!

Item was removed:
- WidgetStub subclass: #TreeStub
-        instanceVariableNames: 'roots'
-        classVariableNames: ''
-        poolDictionaries: ''
-        category: 'ToolBuilder-SUnit'!

Item was removed:
- ----- 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 removed:
- ----- Method: TreeStub>>roots: (in category 'private') -----
- roots: anArray
-        roots := anArray collect: [:ea | TreeNodeStub fromSpec: spec item: ea].
- !

Item was removed:
- ----- Method: TreeStub>>select: (in category 'simulating') -----
- select: anArray
-        self openPath: anArray!

Item was removed:
- ----- Method: TreeStub>>setSpec: (in category 'initialize-release') -----
- setSpec: aSpec
-        super setSpec: aSpec.
-        self update: spec roots!

Item was removed:
- ----- 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 removed:
- ----- Method: TreeStub>>updateRoots (in category 'events') -----
- updateRoots
-        ^ self roots: (self model perform: spec roots)
- !

Item was removed:
- ----- 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 removed:
- Object subclass: #WidgetStub
-        instanceVariableNames: 'spec state'
-        classVariableNames: ''
-        poolDictionaries: ''
-        category: 'ToolBuilder-SUnit'!

Item was removed:
- ----- Method: WidgetStub class>>fromSpec: (in category 'instance creation') -----
- fromSpec: aSpec
-        ^ self new setSpec: aSpec!

Item was removed:
- ----- Method: WidgetStub>>model (in category 'simulating') -----
- model
-        ^ spec model!

Item was removed:
- ----- Method: WidgetStub>>name (in category 'accessing') -----
- name
-        ^ spec name ifNil: [' ']!

Item was removed:
- ----- Method: WidgetStub>>printOn: (in category 'printing') -----
- printOn: aStream
-        aStream
-                print: self class;
-                nextPut: $<;
-                nextPutAll: self name;
-                nextPut: $>!

Item was removed:
- ----- Method: WidgetStub>>refresh (in category 'events') -----
- refresh
-        self stateVariables do: [:var | self refresh: var]!

Item was removed:
- ----- Method: WidgetStub>>refresh: (in category 'events') -----
- refresh: var
-        | value |
-        value := spec perform: var.
-        self refresh: var with: value!

Item was removed:
- ----- 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 removed:
- ----- Method: WidgetStub>>setSpec: (in category 'initialize-release') -----
- setSpec: aSpec
-        state := IdentityDictionary new.
-        spec := aSpec.
-        spec model addDependent: self.
-        self refresh.!

Item was removed:
- ----- Method: WidgetStub>>spec (in category 'accessing') -----
- spec
-        ^ spec!

Item was removed:
- ----- Method: WidgetStub>>stateVariables (in category 'events') -----
- stateVariables
-        ^ #()!

Item was removed:
- ----- 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 removed:
- ----- Method: WidgetStub>>widgetNamed: (in category 'accessing') -----
- widgetNamed: aString
-        ^ self name = aString
-                ifTrue: [self]
-                ifFalse: [nil]!

Item was removed:
- CompositeStub subclass: #WindowStub
-        instanceVariableNames: ''
-        classVariableNames: ''
-        poolDictionaries: ''
-        category: 'ToolBuilder-SUnit'!

Item was removed:
- ----- Method: WindowStub>>close (in category 'simulating') -----
- close
-        spec model perform: spec closeAction!

Item was removed:
- ----- Method: WindowStub>>stateVariables (in category 'events') -----
- stateVariables
-        ^ super stateVariables, #(label)!