SystemOrganization addCategory: #'OB-Tests-Core'! TestCase subclass: #OBAnnouncerTest instanceVariableNames: 'announcer' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBAnnouncerTest methodsFor: 'tests' stamp: 'cwp 11/10/2011 16:10'! testBlock | announcement | announcer := OBAnnouncer new. announcer on: OBNodeSelected do: [ :arg | announcement := arg ]. announcer announce: OBNodeSelected. self assert: (announcement isKindOf: OBNodeSelection)! ! !OBAnnouncerTest methodsFor: 'tests' stamp: 'cwp 11/10/2011 16:10'! testInstance | announcement | announcer := OBAnnouncer new. announcer on: OBNodeSelected do: [ :arg | announcement := arg ]. announcer announce: OBNodeSelected new. self assert: (announcement isKindOf: OBNodeSelection)! ! !OBAnnouncerTest methodsFor: 'tests' stamp: 'cwp 11/10/2011 16:10'! testMessage | announcement | announcer := OBAnnouncer new. announcer on: OBNodeSelected send: #value: to: [ :ann | announcement := ann ]. announcer announce: OBNodeSelected. self assert: (announcement isKindOf: OBNodeSelection)! ! !OBAnnouncerTest methodsFor: 'tests' stamp: 'cwp 12/3/2011 23:20'! testOrder "When an object receives an announcement and sends out a new announcement in response, we want to ensure that other subscribers will receive the initial announcement before the response." | received | received := OrderedCollection new. announcer := OBAnnouncer new. announcer on: OBNodeDeselected do: [:ann | announcer announce: OBNodeSelected]. announcer on: OBNodeDeselected do: [:ann | received add: ann]. announcer on: OBNodeSelected do: [:ann | received add: ann]. announcer announce: OBNodeDeselected. self assert: received size = 2. self assert: received first class = OBNodeDeselected. self assert: received second class = OBNodeSelected.! ! TestCase subclass: #OBBrowserCommandsTest instanceVariableNames: 'browser' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBBrowserCommandsTest methodsFor: 'tests' stamp: 'cwp 3/13/2007 00:46'! test01ScanFindsCommandCreationMethods | called scan | called := false. browser := OBFakeCommandBrowser withAction: [called := true]. scan := browser announce: OBNodeCommandScan. (scan commandsOn: nil for: nil) first execute. self assert: called! ! !OBBrowserCommandsTest methodsFor: 'tests' stamp: 'lr 10/29/2010 11:09'! test02CommandSelectorsFindsCommands browser := OBFakeCommandBrowser new. self assert: (browser commandFactories anySatisfy: [ :each | each class = OBPluggableCommand ])! ! !OBBrowserCommandsTest methodsFor: 'tests' stamp: 'lr 10/29/2010 11:09'! test03CommandSelectorsFindsCommands browser := OBFakeCommandBrowser new. self deny: (browser commandFactories anySatisfy: [ :each | each = OBPluggableCommand ])! ! TestCase subclass: #OBButtonBarTest instanceVariableNames: 'expected bar' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBButtonBarTest methodsFor: 'as yet unclassified' stamp: 'cwp 11/6/2011 09:21'! createBar ^ OBButtonBar new.! ! !OBButtonBarTest methodsFor: 'as yet unclassified' stamp: 'cwp 11/5/2011 22:41'! expect: aSymbol during: aBlock expected := aSymbol. bar addDependent: self. aBlock value. self assert: expected isNil! ! !OBButtonBarTest methodsFor: 'as yet unclassified' stamp: 'cwp 11/6/2011 09:21'! testCreatedEmpty bar := self createBar. self assert: bar buttons isEmpty! ! !OBButtonBarTest methodsFor: 'as yet unclassified' stamp: 'cwp 11/6/2011 09:21'! testSetButtons bar := self createBar. self expect: #widgets during: [bar buttons: #()]. ! ! !OBButtonBarTest methodsFor: 'as yet unclassified' stamp: 'cwp 11/5/2011 22:39'! update: aSymbol self assert: aSymbol == expected. expected := nil! ! TestCase subclass: #OBButtonTest instanceVariableNames: 'expected' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBButtonTest methodsFor: 'support' stamp: 'cwp 11/5/2011 13:01'! expect: aSymbol during: aBlock expected := aSymbol. aBlock value. self assert: expected isNil! ! !OBButtonTest methodsFor: 'tests' stamp: 'cwp 11/5/2011 13:05'! expect: aSymbol on: aSelector | button | button := OBButton label: 'test'. button addDependent: self. self expect: aSymbol during: [button perform: aSelector with: nil]. ! ! !OBButtonTest methodsFor: 'tests' stamp: 'cwp 11/5/2011 12:45'! testActionBlock | button executed | executed := false. button := OBButton label: 'test'. button action: [executed := true]. button execute. self assert: executed. ! ! !OBButtonTest methodsFor: 'tests' stamp: 'cwp 11/5/2011 13:06'! testActionUpdate self expect: #action on: #action:! ! !OBButtonTest methodsFor: 'tests' stamp: 'cwp 11/5/2011 12:55'! testColorBlock | button | button := OBButton label: 'test'. button color: [Color blue]. self assert: button color = Color blue.! ! !OBButtonTest methodsFor: 'tests' stamp: 'cwp 11/5/2011 13:05'! testColorUpdate self expect: #color on: #color:! ! !OBButtonTest methodsFor: 'tests' stamp: 'cwp 11/5/2011 12:38'! testCreateWithDefaults | button | button := OBButton label: 'test'. self assert: button label = 'test'. ! ! !OBButtonTest methodsFor: 'tests' stamp: 'cwp 11/5/2011 12:50'! testEnabledBlock | button | button := OBButton label: 'test'. button enabled: [1 = 1]. self assert: button isEnabled! ! !OBButtonTest methodsFor: 'tests' stamp: 'cwp 11/5/2011 13:06'! testEnabledUpdate self expect: #isEnabled on: #enabled:! ! !OBButtonTest methodsFor: 'tests' stamp: 'cwp 11/5/2011 12:40'! testLabelBlock | button | button := OBButton label: ['abc', 'def']. self assert: button label = 'abcdef'. ! ! !OBButtonTest methodsFor: 'tests' stamp: 'cwp 11/5/2011 12:52'! testPressedBlock | button | button := OBButton label: 'test'. button pressed: [1 = 1]. self assert: button isPressed! ! !OBButtonTest methodsFor: 'tests' stamp: 'cwp 11/5/2011 13:07'! testPressedUpdate self expect: #isPressed on: #pressed:! ! !OBButtonTest methodsFor: 'support' stamp: 'cwp 11/5/2011 13:01'! update: aSymbol self assert: expected = aSymbol. expected := nil! ! TestCase subclass: #OBCollectionNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBCollectionNodeTest methodsFor: 'tests' stamp: 'cwp 11/3/2011 12:14'! testAncestryOfDescendent | node child parent | parent := OBFakeNode parent: nil item: 'a'. child := OBFakeNode parent: parent item: 'b'. node := OBCollectionNode on: {parent}. self assert: (node isAncestorOf: child)! ! !OBCollectionNodeTest methodsFor: 'tests' stamp: 'cwp 11/3/2011 12:15'! testAncestryOfNodeInCollection | node child | child := OBFakeNode parent: nil item: 'a'. node := OBCollectionNode on: {child}. self assert: (node isAncestorOf: child)! ! TestCase subclass: #OBColumnPanelTest instanceVariableNames: 'announcer' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBColumnPanelTest methodsFor: 'evaluating' stamp: 'cwp 11/11/2011 19:04'! announce: anAnnouncement ^ announcer announce: anAnnouncement! ! !OBColumnPanelTest methodsFor: 'accessing' stamp: 'cwp 8/20/2009 08:11'! announcer ^ announcer ifNil: [announcer := OBAnnouncer new]! ! !OBColumnPanelTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testJumpClearsSubsequentPanels | root panel second first | root := OBFake2Node tree: #(a (b (c (d e (f (g h i)))) j)). first := OBFake2Node tree: #h. second := OBFake2Node tree: #b. panel := OBColumnPanel minPanes: 4 maxPanes: 4. panel browser: self. panel setMetaNode: OBFake2Node metagraph node: root. panel jumpTo: first. panel jumpTo: second. self assert: panel columns third isEmpty. self assert: panel columns fourth isEmpty.! ! !OBColumnPanelTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testJumpToFakeC | root node panel | root := OBFakeNode parent: nil item: #a. node := OBFakeNode parent: (OBFakeNode parent: root item: #b) item: #c. panel := OBColumnPanel inBrowser: self. panel setMetaNode: OBFakeNode metagraph node: root. panel jumpTo: node. self assert: panel selectedNode = node.! ! !OBColumnPanelTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testJumpToRootAsChild | root node panel | root := OBFake2Node tree: #(b (a b c)). node := OBFake2Node tree: #b. panel := OBColumnPanel new. panel browser: self. panel setMetaNode: OBFake2Node metagraph node: root. panel jumpTo: node. self assert: panel selectedNode = node. self assert: (panel columns indexOf: panel currentColumn) = 1! ! TestCase subclass: #OBColumnTest instanceVariableNames: 'announcer column' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBColumnTest methodsFor: 'as yet unclassified' stamp: 'cwp 12/13/2011 01:29'! announcer ^ announcer! ! !OBColumnTest methodsFor: 'as yet unclassified' stamp: 'cwp 12/13/2011 01:29'! setUp announcer := OBAnnouncer new.! ! !OBColumnTest methodsFor: 'as yet unclassified' stamp: 'cwp 12/13/2011 01:31'! testSelectedNode | child nullMetaNode nullNode root | root := OBMetaNode named: 'root'. child := OBMetaNode named: 'child'. nullMetaNode := OBMetaNode named: 'null'. root childAt: #children put: child. root nullChildAt: #nullChildZeta put: nullMetaNode. column := OBColumn inPanel: self metaNode: root node: (OBFakeNode parent: nil item: 'a'). nullNode := column selectedNode. self deny: (column children includes: nullNode). self assert: nullNode metaNode == nullMetaNode.! ! TestCase subclass: #OBCommandTest instanceVariableNames: 'isSelected' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBCommandTest class methodsFor: 'testing' stamp: 'cwp 11/2/2006 00:13'! isAbstract ^ self name == #OBCommandTest! ! !OBCommandTest class methodsFor: 'testing' stamp: 'cwp 10/7/2006 11:15'! shouldInheritSelectors ^ true! ! !OBCommandTest methodsFor: 'support' stamp: 'cwp 11/1/2006 22:38'! command ^self factory on: nil for: nil! ! !OBCommandTest methodsFor: 'support' stamp: 'cwp 11/1/2006 22:38'! executeOn: target for: requestor | command | command := self factory on: target for: requestor. ^command execute! ! !OBCommandTest methodsFor: 'support' stamp: 'lr 2/7/2010 10:14'! factory ^ self subclassResponsibility! ! !OBCommandTest methodsFor: 'support' stamp: 'cwp 11/1/2006 22:38'! isActiveOn: target for: requestor | command | command := self factory on: target for: requestor. ^command isActive! ! !OBCommandTest methodsFor: 'support' stamp: 'cwp 11/1/2006 22:38'! isEnabledOn: target for: requestor | command | command := self factory on: target for: requestor. ^command isEnabled! ! !OBCommandTest methodsFor: 'support' stamp: 'cwp 12/13/2007 23:32'! isSelected: aNode ^ isSelected ifNil: [false]! ! !OBCommandTest methodsFor: 'tests' stamp: 'cwp 10/15/2006 16:42'! test01LabelIsString self assert: self command label isString! ! !OBCommandTest methodsFor: 'tests' stamp: 'cwp 10/15/2006 16:42'! test02HasCorrectKeystroke self assert: self command keystroke isNil! ! !OBCommandTest methodsFor: 'tests' stamp: 'lr 3/14/2010 09:14'! test05IconIsNilOrSymbol self assert: (self command icon isNil or: [ self command icon isSymbol ])! ! !OBCommandTest methodsFor: 'tests' stamp: 'lr 3/14/2010 09:26'! test06GroupIsSymbol self assert: self command group isSymbol! ! !OBCommandTest methodsFor: 'tests' stamp: 'lr 3/14/2010 09:17'! test07LongDescriptionIsNilOrString self assert: (self command longDescription isNil or: [ self command longDescription isString ])! ! !OBCommandTest methodsFor: 'tests' stamp: 'lr 3/14/2010 09:17'! test08ButtonLabelIsNilOrString self assert: (self command buttonLabel isNil or: [ self command buttonLabel isString ])! ! !OBCommandTest methodsFor: 'tests' stamp: 'lr 8/8/2010 10:30'! test10ClusterIsNilOrSymbol self assert: (self command cluster isNil or: [ self command cluster isSymbol ])! ! TestCase subclass: #OBDefinitionPanelTest instanceVariableNames: 'announcer panel' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBDefinitionPanelTest methodsFor: 'emulating' stamp: 'cwp 10/13/2006 09:30'! announce: aClass ^ announcer announce: aClass! ! !OBDefinitionPanelTest methodsFor: 'emulating' stamp: 'cwp 10/13/2006 00:09'! announcer ^ announcer! ! !OBDefinitionPanelTest methodsFor: 'support' stamp: 'cwp 10/13/2006 00:18'! assertMenu: aMenu hasItemSending: aSelector aMenu items anySatisfy: [:ea | ea selector = aSelector]! ! !OBDefinitionPanelTest methodsFor: 'support' stamp: 'cwp 11/3/2011 12:27'! menu | menu | menu := OBFakeMenu new. panel menu: menu shifted: false selection: (1 to: 0). ^ menu! ! !OBDefinitionPanelTest methodsFor: 'support' stamp: 'cwp 8/20/2009 08:11'! setUp announcer := OBAnnouncer new. panel := OBDefinitionPanel inBrowser: self. ! ! !OBDefinitionPanelTest methodsFor: 'tests' stamp: 'lr 3/6/2011 15:17'! test01MenuHasEditingItems | menu | menu := self menu. self assertMenu: menu hasItemSending: #find. self assertMenu: menu hasItemSending: #findAgain. self assertMenu: menu hasItemSending: #setSearchString. self assertMenu: menu hasItemSending: #again. self assertMenu: menu hasItemSending: #undo. self assertMenu: menu hasItemSending: #copySelection. self assertMenu: menu hasItemSending: #cut. self assertMenu: menu hasItemSending: #paste. self assertMenu: menu hasItemSending: #pasteRecent. self assertMenu: menu hasItemSending: #accept. self assertMenu: menu hasItemSending: #cancel. self assertMenu: menu hasItemSending: #doIt. self assertMenu: menu hasItemSending: #printIt. self assertMenu: menu hasItemSending: #inspectIt. self assertMenu: menu hasItemSending: #exploreIt! ! !OBDefinitionPanelTest methodsFor: 'tests' stamp: 'lr 12/3/2010 10:34'! test02MenuIncludesCommands | menu | announcer on: OBTextCommandScan do: [ :ann | ann addFactory: (OBPluggableCommand new label: 'test') ]. menu := self menu. self deny: (menu itemWithWording: 'test') isNil! ! !OBDefinitionPanelTest methodsFor: 'tests' stamp: 'cwp 11/3/2011 12:28'! test03CommandsGetExecuted | menu executed | executed := false. announcer on: OBTextCommandScan do: [ :ann | ann addFactory: ((OBPluggableCommand action: [executed := true]) label: 'test')]. menu := self menu. (menu itemWithWording: 'test') click. self assert: executed! ! !OBDefinitionPanelTest methodsFor: 'tests' stamp: 'lr 12/3/2010 10:34'! test04InactiveCommandsAreHidden | menu | announcer on: OBTextCommandScan do: [ :ann | ann addFactory: ((OBPluggableCommand action: [] active: [false]) label: 'test')]. menu := self menu. self assert: (menu itemWithWording: 'test') isNil! ! !OBDefinitionPanelTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test05SilentChangeAllowedIfNotDirty | ann | ann := announcer announce: OBAboutToChangeSilently. self deny: ann isVetoed.! ! !OBDefinitionPanelTest methodsFor: 'tests' stamp: 'cwp 12/9/2011 16:03'! test06SilentChangeVetoedIfDirty | ann widget | widget := OBFakeText model: panel. widget text: 'unaccepted text'. ann := announcer announce: OBAboutToChangeSilently. self assert: ann isVetoed.! ! TestCase subclass: #OBFanTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBFanTest methodsFor: 'tests' stamp: 'cwp 8/23/2009 21:23'! failingTestAncestorWithFilter | root leaf ancestor filter parent child show fan | show := false. root := OBFake2Node tree: #(r ((a ()) (b (d e f)) c)). leaf := OBFake2Node tree: #e. filter := OBPluggableFilter new nodes: [:nodes :ignored | self filterNodes: nodes showingB: show]; note: [:p :c | parent := p. child := c. show := true]; yourself. root metaNode: (OBFake2Node metagraph addFilter: filter). fan := root asFan. ancestor := fan ancestorOf: leaf in: [:i | self assert: i = 2]. self assert: ancestor name = #b. self assert: parent == root. self assert: child == ancestor. self assert: (fan children at: 2) == ancestor! ! !OBFanTest methodsFor: 'support' stamp: 'cwp 8/20/2007 15:31'! filterNodes: aCollection showingB: aBoolean ^ aBoolean ifTrue: [aCollection] ifFalse: [aCollection reject: [:ea | ea name first = $b]]! ! !OBFanTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testAncestorOfIn | root twig leaf ancestor | root := OBFakeNode parent: nil item: #a. root metaNode: OBFakeNode metagraph. twig := OBFakeNode parent: root item: #b. leaf := OBFakeNode parent: twig item: #c. ancestor := root asFan ancestorOf: leaf in: [:i | self assert: i = 2]. self assert: ancestor = twig! ! !OBFanTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testAncestorOfSelf | root leaf ancestor | root := OBFake2Node tree: #(b (a b c)). leaf := OBFake2Node tree: #b. root metaNode: OBFake2Node metagraph. ancestor := root asFan ancestorOf: leaf in: [:i | self assert: i = 2]. self assert: ancestor = leaf! ! !OBFanTest methodsFor: 'tests' stamp: 'cwp 8/23/2009 21:39'! testAncestorWithFilter | root leaf ancestor filter parent child show fan | show := false. root := OBFake2Node tree: #(r ((a ()) (b (d e f)) c)). leaf := OBFake2Node tree: #e. filter := OBPluggableFilter new nodes: [:nodes :ignored | self filterNodes: nodes showingB: show]; note: [:p :c | parent := p. child := c. show := true]; yourself. root metaNode: (OBFake2Node metagraph addFilter: filter). fan := root asFan. ancestor := fan ancestorOf: leaf in: [:i | self assert: i = 0]. self assert: ancestor isNil. "May be it should be this?" " ancestor := fan ancestorOf: leaf in: [:i | self assert: i = 2]. self assert: ancestor name = #b. self assert: parent == root. self assert: child == ancestor. self assert: (fan children at: 2) == ancestor "! ! TestCase subclass: #OBKeystrokeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBKeystrokeTest methodsFor: 'testing' stamp: 'lr 4/25/2011 11:25'! testChar self assert: $a asKeystroke key = $a! ! !OBKeystrokeTest methodsFor: 'testing' stamp: 'lr 4/25/2011 11:26'! testEquality self assert: $a asKeystroke = $a asKeystroke. self assert: $a asKeystroke hash = $a asKeystroke hash. self deny: $a asKeystroke = $b asKeystroke! ! !OBKeystrokeTest methodsFor: 'testing' stamp: 'lr 4/25/2011 11:24'! testNil self assert: nil asKeystroke = nil! ! TestCase subclass: #OBListTest instanceVariableNames: 'announcer list' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBListTest methodsFor: 'support' stamp: 'cwp 11/11/2011 19:28'! addFactory: aBlock | factory | factory := OBPluggableCommand action: aBlock. announcer on: OBNodeCommandScan do: [:ann | ann addFactory: factory]. ^factory! ! !OBListTest methodsFor: 'updating' stamp: 'cwp 11/11/2011 19:28'! announce: aClass ^ announcer announce: aClass! ! !OBListTest methodsFor: 'emulating' stamp: 'cwp 11/11/2011 19:28'! announcer ^ announcer! ! !OBListTest methodsFor: 'emulating' stamp: 'cwp 11/11/2011 19:28'! browser ^ self! ! !OBListTest methodsFor: 'emulating' stamp: 'cwp 11/11/2011 19:28'! clearAfter: aOBColumn ! ! !OBListTest methodsFor: 'emulating' stamp: 'cwp 11/11/2011 19:28'! columns ^ Array with: list! ! !OBListTest methodsFor: 'private' stamp: 'cwp 11/16/2011 23:07'! createNode ^ ((OBFakeNode parent: nil item: 'b') metaNode: (OBFakeNode metagraph)).! ! !OBListTest methodsFor: 'support' stamp: 'cwp 11/11/2011 19:28'! parentNode | node | node := OBFakeNode parent: nil item: #a. node metaNode: OBFakeNode metagraph. ^ node! ! !OBListTest methodsFor: 'support' stamp: 'cwp 11/11/2011 19:28'! parentNodeWithIcon | node filter | node := self parentNode. filter := OBPluggableFilter new. filter icon: [:i :n | n item = #b ifTrue: [#test] ifFalse: [#blank]]. node metaNode children first addFilter: filter. ^ node! ! !OBListTest methodsFor: 'emulating' stamp: 'cwp 11/16/2011 23:09'! selectedNode ^ self createNode! ! !OBListTest methodsFor: 'emulating' stamp: 'cwp 11/11/2011 19:28'! selectionChangedIn: anOBColumn ! ! !OBListTest methodsFor: 'support' stamp: 'cwp 11/11/2011 19:30'! setUp announcer := OBAnnouncer new. list := OBList column: self! ! !OBListTest methodsFor: 'support' stamp: 'cwp 12/12/2011 15:00'! should: aBlock announce: aClass | handler received | handler := [:ann | received := ann]. announcer on: aClass do: handler. aBlock value. self assert: (received isKindOf: aClass). announcer unsubscribe: handler.! ! !OBListTest methodsFor: 'tests' stamp: 'cwp 11/16/2011 23:08'! test01MenuIncludesCommands | menu invoked | invoked := false. (self addFactory: [invoked := true]) label: 'test service'. list parent: self createNode. menu := OBFakeMenu new. list menu: menu. (menu itemWithWording: 'test service') click. self assert: invoked! ! !OBListTest methodsFor: 'tests' stamp: 'cwp 11/16/2011 23:07'! test02KeystrokeInvokesCommand | invoked | invoked := false. (self addFactory: [invoked := true]) keystroke: $s. list parent: self createNode. list keystroke: $s. self assert: invoked! ! !OBListTest methodsFor: 'tests' stamp: 'cwp 11/11/2011 19:28'! test03SetParent list parent: self parentNode. self assert: list listSize = 3. self assert: list selection = 0! ! !OBListTest methodsFor: 'tests' stamp: 'cwp 12/12/2011 14:20'! test04Icon | blank interface test | interface := OBFakeInterface new. blank := interface iconNamed: #blank. test := interface iconNamed: #test. list parent: self parentNodeWithIcon. [self assert: (list iconAt: 1) == blank. self assert: (list iconAt: 2) == test. self assert: (list iconAt: 3) == blank] on: OBInterfaceRequest do: [:req | req resume: interface].! ! !OBListTest methodsFor: 'tests' stamp: 'cwp 12/12/2011 15:01'! test05AnnouncesDeselection list parent: self parentNode. list selection: 1. self should: [list selection: 0] announce: OBNodeDeselected! ! TestCase subclass: #OBMetaNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBMetaNodeTest methodsFor: 'callbacks' stamp: 'cwp 5/4/2007 23:26'! children ^ #(a b c) collect: [:ea | OBFakeNode parent: nil item: ea]! ! !OBMetaNodeTest methodsFor: 'callbacks' stamp: 'cwp 5/6/2007 01:12'! left ^ #(a b c) collect: [:ea | OBFakeNode parent: nil item: ea]! ! !OBMetaNodeTest methodsFor: 'support' stamp: 'cwp 8/20/2009 08:11'! metaNodeFilter: aSelector do: aBlock | metanode filter | metanode := OBMetaNode named: 'root'. filter := OBPluggableFilter new perform: aSelector with: aBlock. metanode addFilter: filter. ^ metanode! ! !OBMetaNodeTest methodsFor: 'emulating' stamp: 'cwp 12/13/2011 01:20'! nullNode ^ OBFakeNode parent: nil item: #null! ! !OBMetaNodeTest methodsFor: 'callbacks' stamp: 'cwp 5/6/2007 01:13'! right ^ #(d e f) collect: [:ea | OBFakeNode parent: nil item: ea]! ! !OBMetaNodeTest methodsFor: 'emulating' stamp: 'cwp 5/18/2007 00:32'! setMetaNode: aMetanode ! ! !OBMetaNodeTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testChildrenForNode | root child nodes | root := OBMetaNode named: 'root'. child := OBMetaNode named: 'child'. root - #children -> child. nodes := root childrenForNode: self. self assert: nodes size = 3. self assert: (nodes allSatisfy: [:ea | ea class == OBFakeNode]). self assert: (nodes collect: [:ea | ea item]) = #(a b c)! ! !OBMetaNodeTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testConstruction | root child | root := OBMetaNode named: 'root'. child := OBMetaNode named: 'child'. root - #children -> child. self assert: root children anyOne == child. self assert: root edges anyOne selector = #children.! ! !OBMetaNodeTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testConstructionWithLabel | root child edge | root := OBMetaNode named: 'root'. child := OBMetaNode named: 'child'. root - #children / 'kids' -> child. edge := root edges anyOne. self assert: root children anyOne == child. self assert: edge selector = #children. self assert: edge label = 'kids'! ! !OBMetaNodeTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testFiltersCanAddIcon | root result | root := self metaNodeFilter: #icon: do: [:icon :node | #testIcon]. result := root iconForNode: self. self assert: result = #testIcon! ! !OBMetaNodeTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testFiltersCanAlterDisplayStrings | root name result | name := 'this name was changed'. root := self metaNodeFilter: #nodeDisplay: do: [:string :node | name]. result := root displayStringForNode: self. self assert: result = name! ! !OBMetaNodeTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testFiltersCanChooseEdges | root nodes left right | root := self metaNodeFilter: #edges: do: [:edges :node | edges allButLast]. left := OBMetaNode named: 'left'. right := OBMetaNode named: 'right'. root - #left -> left. root - #right -> right. nodes := root childrenForNode: self. self assert: (nodes collect: [:ea | ea item]) = #(a b c)! ! !OBMetaNodeTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testFiltersCanChooseNodes | root nodes left right | root := self metaNodeFilter: #nodes: do: [:edges :node | edges allButLast]. left := OBMetaNode named: 'left'. right := OBMetaNode named: 'right'. root - #left -> left. root - #right -> right. nodes := root childrenForNode: self. self assert: (nodes collect: [:ea | ea item]) = #(a b d e)! ! !OBMetaNodeTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testNodesForParent | root child nodes | root := OBMetaNode named: 'root'. child := OBMetaNode named: 'child'. root - #children -> child. nodes := root nodesForParent: self. self assert: nodes size = 3. self assert: (nodes allSatisfy: [:ea | ea class == OBFakeNode]). self assert: (nodes collect: [:ea | ea item]) = #(a b c)! ! !OBMetaNodeTest methodsFor: 'tests' stamp: 'cwp 12/13/2011 01:20'! testNullChildForParent | root node child | root := OBMetaNode named: 'root'. child := OBMetaNode named: 'child'. root nullChildAt: #nullNode put: child. node := root nullChildForParent: self. self assert: node class = OBFakeNode. self assert: node item = #null. self assert: node metaNode == child. ! ! TestCase subclass: #OBOpenTest instanceVariableNames: 'browser' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! OBOpenTest subclass: #OBLibraryOpenTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBLibraryOpenTest methodsFor: 'accessing' stamp: 'cwp 8/20/2009 08:11'! metagraph | fake | fake := OBMetaNode new. fake childAt: #children put: fake. ^ fake! ! !OBLibraryOpenTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testGraphRootSelection | parent child | parent := OBFakeNode parent: nil item: 'parent'. child := OBFakeNode parent: parent item: 'a'. self create: [OBBrowser metaNode: self metagraph root: parent selection: child]. self shouldnt: [browser navigationPanel] raise: Error! ! !OBLibraryOpenTest methodsFor: 'tests' stamp: 'dkh 6/1/2007 10:08'! testGraphRootSelectionPanels | parent child panels | parent := OBFakeNode parent: nil item: 'parent'. child := OBFakeNode parent: parent item: 'a'. panels := (Array with: OBColumnPanel new with: OBDefinitionPanel new). self create: [OBBrowser metaNode: self metagraph root: parent selection: child panels: panels]. self assert: browser navigationPanel minPanes = 1. self assert: browser navigationPanel maxPanes = 1. self assert: browser root = parent. self assert: browser currentNode = child. self assert: browser panels size = panels size. self assert: (browser panels includesAllOf: panels)! ! !OBOpenTest class methodsFor: 'testing' stamp: 'cwp 12/5/2004 15:55'! isAbstract ^ self name = #OBOpenTest! ! !OBOpenTest methodsFor: 'actions' stamp: 'cwp 8/20/2009 08:11'! create: aBlock self shouldnt: [browser := aBlock value] raise: OBBrowseRequest! ! !OBOpenTest methodsFor: 'actions' stamp: 'cwp 8/20/2009 08:11'! open: aBlock [aBlock value] on: OBBrowseRequest do: [:n | browser := n browser]. self assert: browser notNil! ! TestCase subclass: #OBPluggableCommandTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBPluggableCommandTest methodsFor: 'emulating' stamp: 'cwp 7/9/2006 12:52'! height ^ 16! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test01ExecuteEvaluatesAction | called factory command | called := false. factory := OBPluggableCommand action: [called := true]. command := factory on: nil for: nil. command execute. self assert: called.! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test02ActionCanBeAMessageSend | called factory send command | called := false. send := MessageSend receiver: [called := true] selector: #value. factory := OBPluggableCommand action: send. command := factory on: nil for: nil. command execute. self assert: called.! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test03ActionReceivesRequestor | factory requestor command | requestor := nil. factory := OBPluggableCommand action: [:arg1 :arg2 | requestor := arg2]. command := factory on: nil for: self. command execute. self assert: requestor == self.! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test03ActionRecievesNode | factory node command | node := nil. factory := OBPluggableCommand action: [:arg1 :arg2 | node := arg1]. command := factory on: self for: nil. command execute. self assert: node == self.! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test04ConditionExecutesByDefault | factory command | factory := OBPluggableCommand action: []. command := factory on: nil for: nil. self assert: command isActive ! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 11/3/2011 12:31'! test06MenuItemExecutesAction | menu factory called command | called := false. menu := OBFakeMenu new. factory := OBPluggableCommand action: [called := true]. command := factory on: nil for: nil. command addItemToMenu: menu. menu items first click. self assert: called! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 11/3/2011 12:31'! test07MenuItemEnabledByDefault | menu factory command | menu := OBFakeMenu new. factory := OBPluggableCommand new. command := factory on: nil for: nil. command addItemToMenu: menu. self assert: menu items first isEnabled! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test08MenuItemReflectsCondition | factory command | factory := OBPluggableCommand new enabled: [false]. command := factory on: nil for: self. self deny: (command isEnabled). ! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 11/3/2011 12:32'! test09MenuReflectsLabel | menu factory command | menu := OBFakeMenu new. factory := OBPluggableCommand new label: 'a fine factory'. command := factory on: nil for: self. command addItemToMenu: menu. self assert: menu items first label = 'a fine factory'! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 11/3/2011 12:33'! test10MenuDisplaysKeystroke | menu factory command | menu := OBFakeMenu new. factory := OBPluggableCommand new label: 'a fine factory'; keystroke: $f. command := factory on: nil for: self. command addItemToMenu: menu. self assert: menu items first label = 'a fine factory'. self assert: (menu items first keyText endsWith: 'f')! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test15CondReceivesRequestor | factory requestor command | requestor := nil. factory := OBPluggableCommand action: [] active: [:n :r | requestor := r]. command := factory on: factory for: self. command isActive. self assert: requestor == self! ! !OBPluggableCommandTest methodsFor: 'emulating' stamp: 'cwp 7/9/2006 12:52'! width ^ 16! ! TestCase subclass: #OBRescueFilterTest instanceVariableNames: 'filter' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBRescueFilterTest methodsFor: 'support' stamp: 'cwp 8/20/2009 08:11'! nodes: aCollection | nodes | nodes := aCollection collect: [:ea | OBFakeNode parent: nil item: ea]. ^ filter nodesFrom: nodes forNode: self! ! !OBRescueFilterTest methodsFor: 'tests' stamp: 'cwp 7/17/2007 02:19'! testDisplayStrings | label | filter := OBRescueFilter new. self nodes: #(a b c). self nodes: #(a c). label := filter displayString: 'b' forParent: self child: (OBFakeNode parent: nil item: #b). self assert: label isText. self assert: ((label attributesAt: 1) anySatisfy: [:ea | ea = TextEmphasis struckOut])! ! !OBRescueFilterTest methodsFor: 'tests' stamp: 'cwp 7/17/2007 01:08'! testRescue | first second | filter := OBRescueFilter new. first := self nodes: #(a b c). second := self nodes: #(a c). self assert: first asSet = second asSet! ! !OBRescueFilterTest methodsFor: 'tests' stamp: 'cwp 7/17/2007 01:40'! testSecondRescue | second third | filter := OBRescueFilter new. self nodes: #(a b c). second := self nodes: #(a c). third := self nodes: #(a c). self assert: second asSet = third asSet.! ! !OBRescueFilterTest methodsFor: 'tests' stamp: 'cwp 7/17/2007 02:19'! testUnrescue | third first | filter := OBRescueFilter new. first := self nodes: #(a b c). self nodes: #(a c). third := self nodes: #(a b c). self assert: first = third.! ! TestCase subclass: #OBSubtreeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBSubtreeTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test2Generations | root leaf state | root := OBFakeNode parent: nil item: ''. root metaNode: OBFakeNode metagraph. leaf := OBFakeNode parent: root item: #b. state := (OBSubtree from: root to: leaf) state. self assert: state first parent = root. self assert: state second = 2. self assert: state third parent = leaf. self assert: state fourth = 0! ! !OBSubtreeTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test3Generations | root twig leaf state | root := OBFakeNode parent: nil item: ''. root metaNode: OBFakeNode metagraph. twig := OBFakeNode parent: root item: #a. leaf := OBFakeNode parent: twig item: #b. state := (OBSubtree from: root to: leaf) state. self assert: state first parent = root. self assert: state second = 1. self assert: state third parent = twig. self assert: state fourth = 2. self assert: state fifth parent = leaf. self assert: state sixth = 0! ! !OBSubtreeTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test4Generations | root twig leaf state branch | root := OBFakeNode parent: nil item: ''. root metaNode: OBFakeNode metagraph. branch := OBFakeNode parent: root item: #a. twig := OBFakeNode parent: branch item: #b. leaf := OBFakeNode parent: twig item: #c. state := (OBSubtree from: root to: leaf) state. self assert: state first parent = root. self assert: state second = 1. self assert: state third parent = branch. self assert: state fourth = 2. self assert: state fifth parent = twig. self assert: state sixth = 3. self assert: state seventh parent = leaf. self assert: state eighth = 0! ! !OBSubtreeTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testChildOfMatchingRoot | root leaf subtree state | root := OBFake2Node tree: #(b (a b c)). leaf := OBFake2Node tree: #b. root metaNode: OBFake2Node metagraph. subtree := OBSubtree from: root to: leaf. state := subtree instVarNamed: 'state'. self assert: state size = 4. self assert: state first parent = root. self assert: state second = 2. self assert: state third parent = leaf. self assert: state fourth = 0.! ! !OBSubtreeTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testChildOfRoot | root leaf subtree state | root := OBFake2Node tree: #(b (a b c)). leaf := OBFake2Node tree: #b. root metaNode: OBFake2Node metagraph. subtree := OBSubtree from: root to: leaf. state := subtree instVarNamed: 'state'. self assert: state size = 4. self assert: state first parent = root. self assert: state second = 2. self assert: state third parent = leaf. self assert: state fourth = 0.! ! !OBSubtreeTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testNoAncestor | root leaf subtree | root := OBFakeNode parent: nil item: ''. root metaNode: OBFakeNode metagraph. leaf := OBFakeNode parent: root item: #x. subtree := OBSubtree from: root to: leaf. self assert: subtree isNil. ! ! TestCase subclass: #OBSwitchTest instanceVariableNames: 'selection' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBSwitchTest methodsFor: 'emulating' stamp: 'cwp 8/20/2009 08:11'! activate selection := 1! ! !OBSwitchTest methodsFor: 'emulating' stamp: 'cwp 7/14/2007 10:46'! list ^ #(a b c d e)! ! !OBSwitchTest methodsFor: 'emulating' stamp: 'cwp 7/14/2007 10:45'! listForNode: aNode ^ self list! ! !OBSwitchTest methodsFor: 'emulating' stamp: 'cwp 11/11/2011 19:37'! refresh! ! !OBSwitchTest methodsFor: 'emulating' stamp: 'cwp 7/14/2007 10:45'! selectedNode ^ OBFakeNode new! ! !OBSwitchTest methodsFor: 'emulating' stamp: 'cwp 5/17/2007 21:59'! selection ^ selection! ! !OBSwitchTest methodsFor: 'emulating' stamp: 'cwp 8/20/2009 08:11'! selection: anInteger selection := anInteger! ! !OBSwitchTest methodsFor: 'support' stamp: 'cwp 7/14/2007 10:44'! switch ^ OBSwitch inColumn: self! ! !OBSwitchTest methodsFor: 'tests' stamp: 'cwp 11/7/2011 00:38'! testGetSelection | switch | switch := OBSwitch inColumn: self. switch filter: self. selection := 2. self assert: switch selection = 2! ! !OBSwitchTest methodsFor: 'tests' stamp: 'cwp 7/14/2007 10:44'! testList | switch | switch := self switch. switch filter: self. self assert: switch list = self list! ! !OBSwitchTest methodsFor: 'tests' stamp: 'cwp 11/7/2011 00:38'! testSendsActivateToFilter | switch | switch := OBSwitch inColumn: self. selection := 3. switch filter: self. self assert: selection = 1.! ! !OBSwitchTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testSetSelection | switch | switch := OBSwitch inColumn: self. switch filter: self. switch selection: 5. self assert: selection = 5! ! !OBSwitchTest methodsFor: 'tests' stamp: 'cwp 11/7/2011 00:39'! testSwitchIsActiveWhenItHasAFilter | switch | switch := OBSwitch inColumn: self. switch filter: self. self assert: switch isActive! ! !OBSwitchTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testSwitchStartsInactive | switch | switch := OBSwitch new. self deny: switch isActive! ! TestCase subclass: #OBTextSelectionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBTextSelectionTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test01Text | selection | selection := OBTextSelection on: (3 to: 5) inText: 'abcdefghijk'. self assert: selection text = 'cde'. ! ! !OBTextSelectionTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test02FullText | selection | selection := OBTextSelection on: (3 to: 5) inText: 'abcdefghijk'. self assert: selection fullText = 'abcdefghijk'.! ! !OBTextSelectionTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test03Selector | selection text | text := 'self foo: #a bar: #b. '. selection := OBTextSelection on: (1 to: text size) inText: text. self assert: selection selector = #foo:bar: ! ! !LazyListMorph methodsFor: '*ob-tests-core' stamp: 'lr 11/7/2009 18:42'! rectForRow: index "return a rectangle containing the row at index" | top | top := self top + ((index - 1) * font height). ^ self left @ top extent: self width @ font height! ! !PluggableButtonMorph methodsFor: '*ob-tests-core' stamp: 'TestRunner 1/10/2010 23:32'! isOn ^ self getModelState! ! OBCommand subclass: #OBPluggableCommand instanceVariableNames: 'action active enabled label keystroke icon buttonLabel' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBPluggableCommand class methodsFor: 'instance creation' stamp: 'cwp 6/18/2006 18:53'! action: aValuable ^ self new action: aValuable! ! !OBPluggableCommand class methodsFor: 'instance creation' stamp: 'cwp 10/15/2006 13:50'! action: aValuable active: aValuable2 ^ self new action: aValuable; active: aValuable2; yourself! ! !OBPluggableCommand class methodsFor: 'instance creation' stamp: 'cwp 6/24/2006 15:43'! new ^ self basicNew initialize! ! !OBPluggableCommand class methodsFor: 'testing' stamp: 'cwp 10/15/2006 00:57'! takesNodes ^ true! ! !OBPluggableCommand class methodsFor: 'testing' stamp: 'cwp 10/15/2006 00:58'! takesText ^ false! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'dc 4/28/2007 11:36'! action: aValuable action := aValuable! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'dc 4/28/2007 11:36'! active: aValuable active := aValuable! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'cwp 10/15/2006 13:41'! buttonLabel ^ buttonLabel! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! buttonLabel: aString buttonLabel := aString! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! enabled: aBlock enabled := aBlock! ! !OBPluggableCommand methodsFor: 'execute' stamp: 'cwp 12/28/2011 15:11'! execute ^ action cull: target cull: requestor! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'cwp 10/6/2006 21:46'! group ^ #general! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'cwp 10/15/2006 13:37'! icon ^ icon! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! icon: anIcon icon := anIcon! ! !OBPluggableCommand methodsFor: 'initialize-release' stamp: 'lr 7/3/2009 22:27'! initialize action := [ ]. active := [ true ]. enabled := [ true ]. label := 'a command'! ! !OBPluggableCommand methodsFor: 'testing' stamp: 'cwp 12/28/2011 15:12'! isActive ^ active cull: target cull: requestor! ! !OBPluggableCommand methodsFor: 'testing' stamp: 'cwp 12/28/2011 15:12'! isEnabled ^ enabled cull: target cull: requestor! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'cwp 6/24/2006 19:04'! keystroke ^ keystroke! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! keystroke: aCharacter keystroke := aCharacter! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'cwp 6/24/2006 19:04'! label ^ label! ! !OBPluggableCommand methodsFor: 'accessing' stamp: 'lr 7/3/2009 22:27'! label: aString label := aString! ! !OBPluggableCommand methodsFor: 'morphic' stamp: 'lr 3/4/2009 08:32'! labelWithKeystroke ^ keystroke isNil ifTrue: [ label ] ifFalse: [ label , ' (' , keystroke asString , ')' ]! ! !OBPluggableCommand methodsFor: 'converting' stamp: 'lr 7/3/2009 22:27'! on: aNode for: aRequestor | inst | inst := self copy. inst setTarget: aNode requestor: aRequestor. ^ inst! ! !OBPluggableCommand methodsFor: 'testing' stamp: 'cwp 6/25/2006 00:43'! useLineAfter ^ false! !