[squeak-dev] The Trunk: ToolBuilder-Tests-cmm.1.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Dec 15 22:25:50 UTC 2013


Chris Muller uploaded a new version of ToolBuilder-Tests to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Tests-cmm.1.mcz

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

Name: ToolBuilder-Tests-cmm.1
Author: cmm
Time: 15 December 2013, 4:25:47.507 pm
UUID: e77685b9-ca09-40c0-b84e-6caee75f4075
Ancestors: 

ToolBuilder-Tests contains the specification that a compliant ToolBuilder must fulfill, together with the unit tests for ToolBuilder-Kernel.

==================== Snapshot ====================

SystemOrganization addCategory: #'ToolBuilder-Tests'!

TestCase subclass: #PluggableMenuItemSpecTests
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ToolBuilder-Tests'!

----- Method: PluggableMenuItemSpecTests>>testBeCheckableMakesItemCheckable (in category 'as yet unclassified') -----
testBeCheckableMakesItemCheckable
	| itemSpec |
	itemSpec := PluggableMenuItemSpec new.
	itemSpec beCheckable.
	self assert: itemSpec isCheckable description: 'Item not checkable'.!

----- Method: PluggableMenuItemSpecTests>>testByDefaultNotCheckable (in category 'as yet unclassified') -----
testByDefaultNotCheckable
	| itemSpec |
	itemSpec := PluggableMenuItemSpec new.
	self deny: itemSpec isCheckable.!

----- Method: PluggableMenuItemSpecTests>>testNoMarkerMakesItemChecked (in category 'as yet unclassified') -----
testNoMarkerMakesItemChecked
	| itemSpec |
	itemSpec := PluggableMenuItemSpec new.
	itemSpec label: '<no>no'.
	itemSpec analyzeLabel.
	self assert: itemSpec isCheckable description: 'item not checkable'.
	self deny: itemSpec checked description: 'item checked'.!

----- Method: PluggableMenuItemSpecTests>>testOffMarkerMakesItemChecked (in category 'as yet unclassified') -----
testOffMarkerMakesItemChecked
	| itemSpec |
	itemSpec := PluggableMenuItemSpec new.
	itemSpec label: '<off>off'.
	itemSpec analyzeLabel.
	self assert: itemSpec isCheckable description: 'item not checkable'.
	self deny: itemSpec checked description: 'item checked'.!

----- Method: PluggableMenuItemSpecTests>>testOnMarkerMakesItemChecked (in category 'as yet unclassified') -----
testOnMarkerMakesItemChecked
	| itemSpec |
	itemSpec := PluggableMenuItemSpec new.
	itemSpec label: '<on>on'.
	itemSpec analyzeLabel.
	self assert: itemSpec isCheckable description: 'item not checkable'.
	self assert: itemSpec isCheckable description: 'item not checked'.!

----- Method: PluggableMenuItemSpecTests>>testYesMarkerMakesItemChecked (in category 'as yet unclassified') -----
testYesMarkerMakesItemChecked
	| itemSpec |
	itemSpec := PluggableMenuItemSpec new.
	itemSpec label: '<yes>on'.
	itemSpec analyzeLabel.
	self assert: itemSpec isCheckable description: 'item not checkable'.
	self assert: itemSpec isCheckable description: 'item not checked'.!

TestCase subclass: #ToolBuilderTests
	instanceVariableNames: 'builder widget queries'
	classVariableNames: ''
	poolDictionaries: ''
	category: 'ToolBuilder-Tests'!

!ToolBuilderTests commentStamp: 'ar 2/11/2005 15:01' prior: 0!
Some tests to make sure ToolBuilder does what it says.!

----- Method: ToolBuilderTests class>>isAbstract (in category 'testing') -----
isAbstract
	^self == ToolBuilderTests!

----- Method: ToolBuilderTests>>acceptWidgetText (in category 'support') -----
acceptWidgetText
	"accept text in widget"
	^ self subclassResponsibility!

----- Method: ToolBuilderTests>>assertItemFiresWith: (in category 'tests-menus') -----
assertItemFiresWith: aBlock
	| spec |
	spec := builder pluggableMenuSpec new.
	spec model: self.
	aBlock value: spec.
	widget := builder build: spec.
	queries := IdentitySet new.
	self fireMenuItemWidget.
	self assert: (queries includes: #fireMenuAction)!

----- Method: ToolBuilderTests>>buttonWidgetEnabled (in category 'support') -----
buttonWidgetEnabled
	"Answer whether the current widget (a button) is currently enabled"
	
	^ widget getModelState!

----- Method: ToolBuilderTests>>changeListWidget (in category 'support') -----
changeListWidget
	"Change the list widget's selection index"
	self subclassResponsibility!

----- Method: ToolBuilderTests>>expectedButtonSideEffects (in category 'support') -----
expectedButtonSideEffects
	"side effect queries we expect to see on buttons"
	^#()!

----- Method: ToolBuilderTests>>fireButton (in category 'tests-button') -----
fireButton
	queries add: #fireButton.!

----- Method: ToolBuilderTests>>fireButtonWidget (in category 'support') -----
fireButtonWidget
	"Fire the widget, e.g., perform what is needed for the guy to trigger its action"
	self subclassResponsibility!

----- Method: ToolBuilderTests>>fireMenuAction (in category 'tests-menus') -----
fireMenuAction
	queries add: #fireMenuAction!

----- Method: ToolBuilderTests>>fireMenuItemWidget (in category 'tests-menus') -----
fireMenuItemWidget
	self subclassResponsibility!

----- Method: ToolBuilderTests>>getChildren (in category 'tests-panel') -----
getChildren
	queries add: #getChildren.
	^#()!

----- Method: ToolBuilderTests>>getChildrenOf: (in category 'tests-trees') -----
getChildrenOf: item
	queries add: #getChildrenOf.
	^(1 to: 9) asArray!

----- Method: ToolBuilderTests>>getColor (in category 'tests-text') -----
getColor
	queries add: #getColor.
	^Color tan!

----- Method: ToolBuilderTests>>getEnabled (in category 'tests-button') -----
getEnabled
	queries add: #getEnabled.
	^true!

----- Method: ToolBuilderTests>>getHelpOf: (in category 'tests-trees') -----
getHelpOf: item
	^'help'!

----- Method: ToolBuilderTests>>getIconOf: (in category 'tests-trees') -----
getIconOf: item
	queries add: #getIconOf.
	^nil!

----- Method: ToolBuilderTests>>getLabel (in category 'tests-button') -----
getLabel
	queries add: #getLabel.
	^'TestLabel'!

----- Method: ToolBuilderTests>>getLabelOf: (in category 'tests-trees') -----
getLabelOf: item
	queries add: #getLabelOf.
	^item asString!

----- Method: ToolBuilderTests>>getList (in category 'tests-lists') -----
getList
	queries add: #getList.
	^(1 to: 100) collect:[:i| i printString].!

----- Method: ToolBuilderTests>>getListIndex (in category 'tests-lists') -----
getListIndex
	queries add: #getListIndex.
	^13!

----- Method: ToolBuilderTests>>getListSelection (in category 'tests-lists') -----
getListSelection
	queries add: #getListSelection.
	^'55'!

----- Method: ToolBuilderTests>>getMenu: (in category 'tests-lists') -----
getMenu: aMenu
	queries add: #getMenu.
	^aMenu!

----- Method: ToolBuilderTests>>getRoots (in category 'tests-trees') -----
getRoots
	queries add: #getRoots.
	^(1 to: 9) asArray!

----- Method: ToolBuilderTests>>getState (in category 'tests-button') -----
getState
	queries add: #getState.
	^true!

----- Method: ToolBuilderTests>>getText (in category 'tests-text') -----
getText
	queries add: #getText.
	^Text new!

----- Method: ToolBuilderTests>>getTextSelection (in category 'tests-text') -----
getTextSelection
	queries add: #getTextSelection.
	^(1 to: 0)!

----- Method: ToolBuilderTests>>getTreeSelectionPath (in category 'tests-trees') -----
getTreeSelectionPath
	queries add: #getTreeSelectionPath.
	^{2. 4. 3}!

----- Method: ToolBuilderTests>>hasChildren: (in category 'tests-trees') -----
hasChildren: item
	queries add: #hasChildren.
	^true!

----- Method: ToolBuilderTests>>keyPress: (in category 'tests-lists') -----
keyPress: key
	queries add: #keyPress.!

----- Method: ToolBuilderTests>>makeButton (in category 'tests-button') -----
makeButton
	| spec |
	spec := self makeButtonSpec.
	widget := builder build: spec.
	^widget!

----- Method: ToolBuilderTests>>makeButtonSpec (in category 'tests-button') -----
makeButtonSpec
	| spec |
	spec := builder pluggableButtonSpec new.
	spec name: #button.
	spec model: self.
	spec label: #getLabel.
	spec color: #getColor.
	spec state: #getState.
	spec enabled: #getEnabled.
	^spec!

----- Method: ToolBuilderTests>>makeInputField (in category 'tests-input') -----
makeInputField
	| spec |
	spec := self makeInputFieldSpec.
	widget := builder build: spec.!

----- Method: ToolBuilderTests>>makeInputFieldSpec (in category 'tests-input') -----
makeInputFieldSpec
	| spec |
	spec := builder pluggableInputFieldSpec new.
	spec name: #input.
	spec model: self.
	spec getText: #getText.
	spec selection: #getTextSelection.
	spec color: #getColor.
	"<-- the following cannot be tested very well -->"
	spec setText: #setText:.
	spec menu: #getMenu:.
	^spec!

----- Method: ToolBuilderTests>>makeItemList (in category 'tests-lists') -----
makeItemList
	| spec |
	spec := self makeItemListSpec.
	widget := builder build: spec.!

----- Method: ToolBuilderTests>>makeItemListSpec (in category 'tests-lists') -----
makeItemListSpec
	| spec |
	spec := builder pluggableListSpec new.
	spec name: #list.
	spec model: self.
	spec list: #getList.
	spec getSelected: #getListSelection.
	"<-- the following cannot be tested very well -->"
	spec setSelected: #setListSelection:.
	spec menu: #getMenu:.
	spec keyPress: #keyPress:.
	^spec!

----- Method: ToolBuilderTests>>makeList (in category 'tests-lists') -----
makeList
	| spec |
	spec := self makeListSpec.
	widget := builder build: spec.!

----- Method: ToolBuilderTests>>makeListSpec (in category 'tests-lists') -----
makeListSpec
	| spec |
	spec := builder pluggableListSpec new.
	spec name: #list.
	spec model: self.
	spec list: #getList.
	spec getIndex: #getListIndex.
	"<-- the following cannot be tested very well -->"
	spec setIndex: #setListIndex:.
	spec menu: #getMenu:.
	spec keyPress: #keyPress:.
	^spec!

----- Method: ToolBuilderTests>>makePanel (in category 'tests-panel') -----
makePanel
	| spec |
	spec := self makePanelSpec.
	widget := builder build: spec.!

----- Method: ToolBuilderTests>>makePanelSpec (in category 'tests-panel') -----
makePanelSpec
	| spec |
	spec := builder pluggablePanelSpec new.
	spec name: #panel.
	spec model: self.
	spec children: #getChildren.
	^spec!

----- Method: ToolBuilderTests>>makeText (in category 'tests-text') -----
makeText
	| spec |
	spec := self makeTextSpec.
	widget := builder build: spec.!

----- Method: ToolBuilderTests>>makeTextSpec (in category 'tests-text') -----
makeTextSpec
	| spec |
	spec := builder pluggableTextSpec new.
	spec name: #text.
	spec model: self.
	spec getText: #getText.
	spec selection: #getTextSelection.
	spec color: #getColor.
	"<-- the following cannot be tested very well -->"
	spec setText: #setText:.
	spec menu: #getMenu:.
	^spec!

----- Method: ToolBuilderTests>>makeTree (in category 'tests-trees') -----
makeTree
	| spec |
	spec := self makeTreeSpec.
	widget := builder build: spec.!

----- Method: ToolBuilderTests>>makeTreeSpec (in category 'tests-trees') -----
makeTreeSpec
	| spec |
	spec := builder pluggableTreeSpec new.
	spec name: #tree.
	spec model: self.
	spec roots: #getRoots.
	"<-- the following cannot be tested very well -->"
	spec getSelectedPath: #getTreeSelectionPath.
	spec getChildren: #getChildrenOf:.
	spec hasChildren: #hasChildren:.
	spec label: #getLabelOf:.
	spec icon: #getIconOf:.
	spec help: #getHelpOf:.
	spec setSelected: #setTreeSelection:.
	spec menu: #getMenu:.
	spec keyPress: #keyPress:.
	^spec!

----- Method: ToolBuilderTests>>makeWindow (in category 'tests-window') -----
makeWindow
	| spec |
	spec := self makeWindowSpec.
	widget := builder build: spec.!

----- Method: ToolBuilderTests>>makeWindowSpec (in category 'tests-window') -----
makeWindowSpec
	| spec |
	spec := builder pluggableWindowSpec new.
	spec name: #window.
	spec model: self.
	spec children: #getChildren.
	spec label: #getLabel.
	spec closeAction: #noteWindowClosed.
	^spec!

----- Method: ToolBuilderTests>>noteWindowClosed (in category 'tests-window') -----
noteWindowClosed
	queries add: #noteWindowClosed.!

----- Method: ToolBuilderTests>>openWindow (in category 'tests-window') -----
openWindow
	| spec |
	spec := self makeWindowSpec.
	widget := builder open: spec.!

----- Method: ToolBuilderTests>>returnFalse (in category 'support') -----
returnFalse
	^false!

----- Method: ToolBuilderTests>>returnTrue (in category 'support') -----
returnTrue
	^true!

----- Method: ToolBuilderTests>>setListIndex: (in category 'tests-lists') -----
setListIndex: index
	queries add: #setListIndex.!

----- Method: ToolBuilderTests>>setListSelection: (in category 'tests-lists') -----
setListSelection: newIndex
	queries add: #setListSelection.!

----- Method: ToolBuilderTests>>setText: (in category 'tests-text') -----
setText: newText
	queries add: #setText.
	^false!

----- Method: ToolBuilderTests>>setTreeSelection: (in category 'tests-trees') -----
setTreeSelection: node
	queries add: #setTreeSelection.!

----- Method: ToolBuilderTests>>setUp (in category 'support') -----
setUp
	queries := IdentitySet new.!

----- Method: ToolBuilderTests>>shutDown (in category 'support') -----
shutDown
	self myDependents: nil!

----- Method: ToolBuilderTests>>testAddTargetSelectorArgumentList (in category 'tests-menus') -----
testAddTargetSelectorArgumentList
	self assertItemFiresWith: 
		[:spec | spec
				add: 'Menu Item' 
				target: self
				selector: #fireMenuAction
				argumentList: #()]!

----- Method: ToolBuilderTests>>testButtonFiresBlock (in category 'tests-button') -----
testButtonFiresBlock
	| spec |
	spec := builder pluggableButtonSpec new.
	spec model: self.
	spec action: [self fireButton].
	widget := builder build: spec.
	queries := IdentitySet new.
	self fireButtonWidget.
	self assert: (queries includes: #fireButton).!

----- Method: ToolBuilderTests>>testButtonFiresMessage (in category 'tests-button') -----
testButtonFiresMessage
	| spec |
	spec := builder pluggableButtonSpec new.
	spec model: self.
	spec action: (MessageSend receiver: self selector: #fireButton arguments: #()).
	widget := builder build: spec.
	queries := IdentitySet new.
	self fireButtonWidget.
	self assert: (queries includes: #fireButton).!

----- Method: ToolBuilderTests>>testButtonFiresSymbol (in category 'tests-button') -----
testButtonFiresSymbol
	| spec |
	spec := builder pluggableButtonSpec new.
	spec model: self.
	spec action: #fireButton.
	widget := builder build: spec.
	queries := IdentitySet new.
	self fireButtonWidget.
	self assert: (queries includes: #fireButton).!

----- Method: ToolBuilderTests>>testButtonInitiallyDisabled (in category 'tests-button') -----
testButtonInitiallyDisabled
	| spec |
	spec := builder pluggableButtonSpec new.
	spec model: self.
	spec label: #getLabel.
	spec color: #getColor.
	spec state: #getState.
	spec enabled: #returnFalse.
	widget := builder build: spec.
	self deny: (self buttonWidgetEnabled)!

----- Method: ToolBuilderTests>>testButtonInitiallyDisabledSelector (in category 'tests-button') -----
testButtonInitiallyDisabledSelector
	| spec |
	spec := builder pluggableButtonSpec new.
	spec model: self.
	spec label: #getLabel.
	spec color: #getColor.
	spec state: #getState.
	spec enabled: #returnFalse.
	widget := builder build: spec.
	self deny: (self buttonWidgetEnabled)!

----- Method: ToolBuilderTests>>testButtonInitiallyEnabled (in category 'tests-button') -----
testButtonInitiallyEnabled
	| spec |
	spec := builder pluggableButtonSpec new.
	spec model: self.
	spec label: #getLabel.
	spec color: #getColor.
	spec state: #getState.
	spec enabled: #returnTrue.
	widget := builder build: spec.
	self assert: (self buttonWidgetEnabled)!

----- Method: ToolBuilderTests>>testButtonInitiallyEnabledSelector (in category 'tests-button') -----
testButtonInitiallyEnabledSelector
	| spec |
	spec := builder pluggableButtonSpec new.
	spec model: self.
	spec label: #getLabel.
	spec color: #getColor.
	spec state: #getState.
	spec enabled: #returnTrue.
	widget := builder build: spec.
	self assert: (self buttonWidgetEnabled)!

----- Method: ToolBuilderTests>>testButtonWidgetID (in category 'tests-button') -----
testButtonWidgetID
	self makeButton.
	self assert: (builder widgetAt: #button) == widget.!

----- Method: ToolBuilderTests>>testGetButtonColor (in category 'tests-button') -----
testGetButtonColor
	self makeButton.
	queries := IdentitySet new.
	self changed: #getColor.
	self assert: (queries includes: #getColor).
	self assert: self widgetColor = self getColor.!

----- Method: ToolBuilderTests>>testGetButtonEnabled (in category 'tests-button') -----
testGetButtonEnabled
	self makeButton.
	queries := IdentitySet new.
	self changed: #getEnabled.
	self assert: (queries includes: #getEnabled).!

----- Method: ToolBuilderTests>>testGetButtonLabel (in category 'tests-button') -----
testGetButtonLabel
	self makeButton.
	queries := IdentitySet new.
	self changed: #getLabel.
	self assert: (queries includes: #getLabel).!

----- Method: ToolBuilderTests>>testGetButtonSideEffects (in category 'tests-button') -----
testGetButtonSideEffects
	self makeButton.
	queries := IdentitySet new.
	self changed: #testSignalWithNoDiscernableEffect.
	self expectedButtonSideEffects do:[:sym|
		self assert: (queries includes: sym). 
		queries remove: sym.
	].
	self assert: queries isEmpty.!

----- Method: ToolBuilderTests>>testGetButtonState (in category 'tests-button') -----
testGetButtonState
	self makeButton.
	queries := IdentitySet new.
	self changed: #getState.
	self assert: (queries includes: #getState).!

----- Method: ToolBuilderTests>>testGetInputFieldColor (in category 'tests-input') -----
testGetInputFieldColor
	self makeInputField.
	queries := IdentitySet new.
	self changed: #getColor.
	self assert: (queries includes: #getColor).
	self assert: self widgetColor = self getColor.!

----- Method: ToolBuilderTests>>testGetInputFieldSelection (in category 'tests-input') -----
testGetInputFieldSelection
	self makeInputField.
	queries := IdentitySet new.
	self changed: #getTextSelection.
	self assert: (queries includes: #getTextSelection).!

----- Method: ToolBuilderTests>>testGetInputFieldSideEffectFree (in category 'tests-input') -----
testGetInputFieldSideEffectFree
	self makeInputField.
	queries := IdentitySet new.
	self changed: #testSignalWithNoDiscernableEffect.
	self assert: queries isEmpty.!

----- Method: ToolBuilderTests>>testGetInputFieldText (in category 'tests-input') -----
testGetInputFieldText
	self makeInputField.
	queries := IdentitySet new.
	self changed: #getText.
	self assert: (queries includes: #getText).!

----- Method: ToolBuilderTests>>testGetItemListSideEffectFree (in category 'tests-lists') -----
testGetItemListSideEffectFree
	self makeItemList.
	queries := IdentitySet new.
	self changed: #testSignalWithNoDiscernableEffect.
	self assert: queries isEmpty.!

----- Method: ToolBuilderTests>>testGetList (in category 'tests-lists') -----
testGetList
	self makeList.
	queries := IdentitySet new.
	self changed: #getList.
	self assert: (queries includes: #getList).!

----- Method: ToolBuilderTests>>testGetListIndex (in category 'tests-lists') -----
testGetListIndex
	self makeList.
	queries := IdentitySet new.
	self changed: #getListIndex.
	self assert: (queries includes: #getListIndex).!

----- Method: ToolBuilderTests>>testGetListSelection (in category 'tests-lists') -----
testGetListSelection
	self makeItemList.
	queries := IdentitySet new.
	self changed: #getListSelection.
	self assert: (queries includes: #getListSelection).!

----- Method: ToolBuilderTests>>testGetListSideEffectFree (in category 'tests-lists') -----
testGetListSideEffectFree
	self makeList.
	queries := IdentitySet new.
	self changed: #testSignalWithNoDiscernableEffect.
	self assert: queries isEmpty.!

----- Method: ToolBuilderTests>>testGetPanelChildren (in category 'tests-panel') -----
testGetPanelChildren
	self makePanel.
	queries := IdentitySet new.
	self changed: #getChildren.
	self assert: (queries includes: #getChildren).!

----- Method: ToolBuilderTests>>testGetPanelSideEffectFree (in category 'tests-panel') -----
testGetPanelSideEffectFree
	self makePanel.
	queries := IdentitySet new.
	self changed: #testSignalWithNoDiscernableEffect.
	self assert: queries isEmpty.!

----- Method: ToolBuilderTests>>testGetText (in category 'tests-text') -----
testGetText
	self makeText.
	queries := IdentitySet new.
	self changed: #getText.
	self assert: (queries includes: #getText).!

----- Method: ToolBuilderTests>>testGetTextColor (in category 'tests-text') -----
testGetTextColor
	self makeText.
	queries := IdentitySet new.
	self changed: #getColor.
	self assert: (queries includes: #getColor).
	self assert: self widgetColor = self getColor.!

----- Method: ToolBuilderTests>>testGetTextSelection (in category 'tests-text') -----
testGetTextSelection
	self makeText.
	queries := IdentitySet new.
	self changed: #getTextSelection.
	self assert: (queries includes: #getTextSelection).!

----- Method: ToolBuilderTests>>testGetTextSideEffectFree (in category 'tests-text') -----
testGetTextSideEffectFree
	self makeText.
	queries := IdentitySet new.
	self changed: #testSignalWithNoDiscernableEffect.
	self assert: queries isEmpty.!

----- Method: ToolBuilderTests>>testGetWindowChildren (in category 'tests-window') -----
testGetWindowChildren
	self makeWindow.
	queries := IdentitySet new.
	self changed: #getChildren.
	self assert: (queries includes: #getChildren).!

----- Method: ToolBuilderTests>>testGetWindowLabel (in category 'tests-window') -----
testGetWindowLabel
	self makeWindow.
	queries := IdentitySet new.
	self changed: #getLabel.
	self assert: (queries includes: #getLabel).!

----- Method: ToolBuilderTests>>testGetWindowSideEffectFree (in category 'tests-window') -----
testGetWindowSideEffectFree
	self makeWindow.
	queries := IdentitySet new.
	self changed: #testSignalWithNoDiscernableEffect.
	self assert: queries isEmpty.!

----- Method: ToolBuilderTests>>testInputWidgetID (in category 'tests-input') -----
testInputWidgetID
	self makeInputField.
	self assert: (builder widgetAt: #input) == widget.!

----- Method: ToolBuilderTests>>testItemListWidgetID (in category 'tests-lists') -----
testItemListWidgetID
	self makeItemList.
	self assert: (builder widgetAt: #list) == widget.!

----- Method: ToolBuilderTests>>testListWidgetID (in category 'tests-lists') -----
testListWidgetID
	self makeList.
	self assert: (builder widgetAt: #list) == widget.!

----- Method: ToolBuilderTests>>testPanelWidgetID (in category 'tests-panel') -----
testPanelWidgetID
	self makePanel.
	self assert: (builder widgetAt: #panel) == widget.!

----- Method: ToolBuilderTests>>testSetInputField (in category 'tests-input') -----
testSetInputField
	self makeInputField.
	queries := IdentitySet new.
	self acceptWidgetText.
	self assert: (queries includes: #setText).!

----- Method: ToolBuilderTests>>testSetListIndex (in category 'tests-lists') -----
testSetListIndex
	self makeList.
	queries := IdentitySet new.
	self changeListWidget.
	self assert: (queries includes: #setListIndex).!

----- Method: ToolBuilderTests>>testSetListSelection (in category 'tests-lists') -----
testSetListSelection
	self makeItemList.
	queries := IdentitySet new.
	self changeListWidget.
	self assert: (queries includes: #setListSelection).!

----- Method: ToolBuilderTests>>testSetText (in category 'tests-text') -----
testSetText
	self makeText.
	queries := IdentitySet new.
	self acceptWidgetText.
	self assert: (queries includes: #setText).!

----- Method: ToolBuilderTests>>testTextWidgetID (in category 'tests-text') -----
testTextWidgetID
	self makeText.
	self assert: (builder widgetAt: #text) == widget!

----- Method: ToolBuilderTests>>testTreeExpandPath (in category 'tests-trees') -----
testTreeExpandPath
	"@@@@: REMOVE THIS - it's a hack (changed: #openPath)"
	self makeTree.
	queries := IdentitySet new.
	self changed: {#openPath. '4'. '2'. '3'}.
	self waitTick.
	self assert: (queries includes: #getChildrenOf).
	self assert: (queries includes: #setTreeSelection).
	self assert: (queries includes: #getLabelOf).
!

----- Method: ToolBuilderTests>>testTreeExpandPathFirst (in category 'tests-trees') -----
testTreeExpandPathFirst
	"@@@@: REMOVE THIS - it's a hack (changed: #openPath)"
	self makeTree.
	queries := IdentitySet new.
	self changed: {#openPath. '1'. '2'. '2'}.
	self waitTick.
	self assert: (queries includes: #getChildrenOf).
	self assert: (queries includes: #setTreeSelection).
	self assert: (queries includes: #getLabelOf).
!

----- Method: ToolBuilderTests>>testTreeGetSelectionPath (in category 'tests-trees') -----
testTreeGetSelectionPath
	self makeTree.
	queries := IdentitySet new.
	self changed: #getTreeSelectionPath.
	self waitTick.
	self assert: (queries includes: #getTreeSelectionPath).
	self assert: (queries includes: #getChildrenOf).
	self assert: (queries includes: #setTreeSelection).
!

----- Method: ToolBuilderTests>>testTreeRoots (in category 'tests-trees') -----
testTreeRoots
	self makeTree.
	queries := IdentitySet new.
	self changed: #getRoots.
	self assert: (queries includes: #getRoots).!

----- Method: ToolBuilderTests>>testTreeWidgetID (in category 'tests-trees') -----
testTreeWidgetID
	self makeTree.
	self assert: (builder widgetAt: #tree) == widget.!

----- Method: ToolBuilderTests>>testWindowCloseAction (in category 'tests-window') -----
testWindowCloseAction
	self openWindow.
	builder close: widget.
	self assert: (queries includes: #noteWindowClosed).!

----- Method: ToolBuilderTests>>testWindowID (in category 'tests-window') -----
testWindowID
	self makeWindow.
	self assert: (builder widgetAt: #window) == widget.!

----- Method: ToolBuilderTests>>waitTick (in category 'support') -----
waitTick
	^nil!

----- Method: ToolBuilderTests>>widgetColor (in category 'support') -----
widgetColor
	"Answer color from widget"
	self subclassResponsibility

	"NOTE: You can bail out if you don't know how to get the color from the widget:
		^self getColor
	will work."!



More information about the Squeak-dev mailing list