SystemOrganization addCategory: #'OB-Tests-Core'! !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! ! !PluggableListMorph methodsFor: '*ob-tests-core' stamp: 'lr 11/7/2009 18:42'! getListDelicately | lazy | lazy := self listMorph. ^ (1 to: lazy getListSize) collect: [ :i | lazy item: i ]! ! !PluggableListMorph methodsFor: '*ob-tests-core' stamp: 'lr 11/7/2009 18:42'! getListObtrusively | lazy | lazy := self listMorph. ^ (1 to: lazy getListSize) collect: [ :i | lazy getListItem: i ]! ! OBNode subclass: #OBFake2Node instanceVariableNames: 'name children' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBFake2Node class methodsFor: 'running' stamp: 'cwp 8/20/2009 08:11'! metagraph | root | root := OBMetaNode named: 'Fake2'. root childAt: #children put: root. ^ root! ! !OBFake2Node class methodsFor: 'as yet unclassified' stamp: 'cwp 8/20/2009 08:11'! tree: anObject | children token | anObject isSymbol ifTrue: [token := anObject. children := #()] ifFalse: [token := anObject first. children := anObject second]. ^ self basicNew setName: token children: children! ! !OBFake2Node methodsFor: 'comparing' stamp: 'cwp 5/8/2007 23:50'! = aNode ^ self name = aNode name! ! !OBFake2Node methodsFor: 'accessing' stamp: 'cwp 5/8/2007 23:46'! children ^ children! ! !OBFake2Node methodsFor: 'comparing' stamp: 'cwp 5/8/2007 23:50'! hash ^ name hash! ! !OBFake2Node methodsFor: 'ancestry' stamp: 'cwp 5/14/2007 13:21'! isAncestorOf: aNode using: aSelector ^ self = aNode or: [children anySatisfy: [:ea | ea isAncestorOf: aNode]]! ! !OBFake2Node methodsFor: 'public' stamp: 'cwp 5/8/2007 23:46'! name ^ name! ! !OBFake2Node methodsFor: 'printing' stamp: 'cwp 5/8/2007 23:45'! printOn: aStream aStream nextPutAll: 'Fake2<'; nextPutAll: name; nextPut: $>! ! !OBFake2Node methodsFor: 'initialize-release' stamp: 'cwp 8/20/2009 08:11'! setName: aSymbol children: anArray name := aSymbol. children := anArray collect: [:ea | self class tree: ea]! ! OBNode subclass: #OBFakeDNUNode instanceVariableNames: 'name children' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBFakeDNUNode class methodsFor: 'instance creation' stamp: 'jk 1/2/2008 15:44'! tree: anObject " Structure: #(nodeName ((edgeName children) (edgeName children) ...)). #(nodeName ((edgeName noChildren) ...)) means no children at edgeName (returns empty array)." ^ anObject isSymbol ifTrue: [self new setName: anObject] ifFalse: [self new setName: anObject first children: anObject second]. ! ! !OBFakeDNUNode methodsFor: 'comparing' stamp: 'jk 1/1/2008 22:56'! = aNode ^ self name = aNode name! ! !OBFakeDNUNode methodsFor: 'accessing' stamp: 'jk 1/1/2008 21:31'! allChildren ^ self children gather: [:e | e]! ! !OBFakeDNUNode methodsFor: 'accessing' stamp: 'jk 1/1/2008 20:12'! children ^ children ifNil: [children := Dictionary new]! ! !OBFakeDNUNode methodsFor: 'accessing' stamp: 'jk 1/1/2008 20:15'! childrenAt: aSymbol ^ self children at: aSymbol ifAbsent: [nil]! ! !OBFakeDNUNode methodsFor: 'error handling' stamp: 'jk 1/1/2008 21:26'! doesNotUnderstand: aMessage ^ self children at: aMessage selector ifAbsent: [super doesNotUnderstand: aMessage]! ! !OBFakeDNUNode methodsFor: 'comparing' stamp: 'jk 1/1/2008 22:56'! hash ^ name hash! ! !OBFakeDNUNode methodsFor: 'ancestry' stamp: 'jk 1/1/2008 21:30'! isAncestorOf: aNode using: aSelector ^ self = aNode or: [self allChildren anySatisfy: [:ea | ea isAncestorOf: aNode]]! ! !OBFakeDNUNode methodsFor: 'accessing' stamp: 'jk 1/1/2008 22:56'! name ^ name! ! !OBFakeDNUNode methodsFor: 'accessing' stamp: 'jk 1/1/2008 20:27'! noChildren ^ #()! ! !OBFakeDNUNode methodsFor: 'printing' stamp: 'jk 1/1/2008 21:18'! printOn: aStream aStream nextPutAll: 'FakeDNU<'; nextPutAll: name; nextPut: $>! ! !OBFakeDNUNode methodsFor: 'initialize-release' stamp: 'jk 1/2/2008 15:43'! putChildren: anArray anArray do: [ :e | self children at: e first put: ((e allButFirst collect: [:ea | self class tree: ea]) reject: [ :node | node name = #noChildren]) ]! ! !OBFakeDNUNode methodsFor: 'initialize-release' stamp: 'jk 1/1/2008 21:00'! setName: aByteSymbol name := aByteSymbol! ! !OBFakeDNUNode methodsFor: 'initialize-release' stamp: 'jk 1/1/2008 20:51'! setName: aSymbol children: anArray name := aSymbol. self putChildren: anArray! ! OBNode subclass: #OBFakeNode instanceVariableNames: 'item parent children' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBFakeNode class methodsFor: 'browsing' stamp: 'cwp 8/20/2009 08:11'! metagraph | fake | fake := OBMetaNode new. fake childAt: #children put: fake. ^ fake! ! !OBFakeNode class methodsFor: 'instance creation' stamp: 'cwp 12/15/2003 22:06'! parent: aFakeNode item: aString ^ self new parent: aFakeNode; item: aString! ! !OBFakeNode methodsFor: 'comparing' stamp: 'cwp 5/8/2007 23:27'! = other ^ self name = other name! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 8/20/2009 08:11'! adopt: aNode aNode parent removeChild: aNode. aNode parent: self. children := self children copyWith: aNode. ^ aNode! ! !OBFakeNode methodsFor: 'actions' stamp: 'cwp 8/20/2009 08:11'! beZ item := 'z'. ! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 7/17/2007 23:07'! childX ^ Array with: (OBFakeNode parent: self item: #x)! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 8/20/2009 08:11'! children ^ children ifNil: [children := (self item endsWith: 'c') ifTrue: [Array new] ifFalse: [#($a $b $c) collect: [:i | OBFakeNode parent: self item: i asString]]]! ! !OBFakeNode methodsFor: 'actions' stamp: 'cwp 3/13/2007 00:33'! createZ ^ self adopt: (OBFakeNode parent: self item: 'z')! ! !OBFakeNode methodsFor: 'actions' stamp: 'cwp 3/13/2007 00:20'! delete parent ifNotNil: [parent removeChild: self]. ! ! !OBFakeNode methodsFor: 'drag and drop' stamp: 'cwp 3/13/2007 00:43'! dropOnFakeNode: aNode aNode adopt: self. aNode signalSelection! ! !OBFakeNode methodsFor: 'drag and drop' stamp: 'cwp 3/2/2004 21:40'! dropSelector ^ #dropOnFakeNode:! ! !OBFakeNode methodsFor: 'comparing' stamp: 'cwp 5/8/2007 23:27'! hash ^ self name hash! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 8/20/2009 08:11'! isAncestorOf: aNode using: aSelector | current | current := aNode. [current isNil] whileFalse: [current = self ifTrue: [^ true]. current := current parent]. ^ false! ! !OBFakeNode methodsFor: 'private' stamp: 'cwp 8/20/2009 08:11'! item ^ item ifNil: [item := '']! ! !OBFakeNode methodsFor: 'private' stamp: 'cwp 8/20/2009 08:11'! item: aSymbol item := aSymbol! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 12/15/2003 22:05'! name ^ self parentName, self item ! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 7/17/2007 23:37'! noChildren ^ #()! ! !OBFakeNode methodsFor: 'private' stamp: 'cwp 2/25/2004 21:49'! parent ^ parent! ! !OBFakeNode methodsFor: 'private' stamp: 'cwp 8/20/2009 08:11'! parent: aFakeNode parent := aFakeNode! ! !OBFakeNode methodsFor: 'private' stamp: 'cwp 12/15/2003 22:04'! parentName ^ (parent ifNil: [''] ifNotNil: [parent name])! ! !OBFakeNode methodsFor: 'printing' stamp: 'cwp 5/8/2007 23:25'! printOn: aStream aStream nextPutAll: 'FakeNode<'; nextPutAll: self name; nextPut: $>! ! !OBFakeNode methodsFor: 'private' stamp: 'cwp 8/20/2009 08:11'! removeChild: aFakeNode children := self children copyWithout: aFakeNode! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 8/20/2009 08:11'! root | node | node := self parent. [node parent notNil] whileTrue: [node := node parent]. ^ node! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 12/15/2003 22:03'! text ^ self name! ! !OBFakeNode methodsFor: 'public' stamp: 'cwp 9/18/2005 14:58'! text: aText self item:( aText asString allButFirst: (self parentName size)). self demandSelection. ^ true! ! OBBrowser subclass: #OBFakeBrowser instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBFakeBrowser methodsFor: 'as yet unclassified' stamp: 'cwp 3/13/2007 00:18'! cmdBeZ ^ OBPluggableCommand new label: 'become z'; active: [:node :col | col isSelected: node]; action: [:node :col | node beZ. node announceChangedWith: col]; yourself! ! !OBFakeBrowser methodsFor: 'as yet unclassified' stamp: 'cwp 3/13/2007 00:34'! cmdCreateZ ^ OBPluggableCommand new label: 'create z'; action: [:node :col | node createZ announceSelectionWith: col]; active: [:node :col | (col isSelected: node) not]; yourself! ! !OBFakeBrowser methodsFor: 'as yet unclassified' stamp: 'cwp 3/13/2007 00:20'! cmdDelete ^ OBPluggableCommand new label: 'delete'; action: [:node :col | node delete. node announceDeletionWith: col]; active: [:node :col | col isSelected: node]; yourself! ! !OBFakeBrowser methodsFor: 'as yet unclassified' stamp: 'cwp 3/13/2007 00:24'! cmdDeleteRoot ^ OBPluggableCommand new label: 'delete root'; action: [:node :col | node root announceDeletionWith: col]; active: [:node :col | col isSelected: node]; yourself! ! OBBrowser subclass: #OBFakeCommandBrowser instanceVariableNames: 'action' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBFakeCommandBrowser class methodsFor: 'defaults' stamp: 'cwp 10/4/2006 10:04'! defaultMetaNode ^ OBFakeNode metagraph! ! !OBFakeCommandBrowser class methodsFor: 'defaults' stamp: 'cwp 10/4/2006 10:04'! defaultRootNode ^ OBFakeNode new! ! !OBFakeCommandBrowser class methodsFor: 'as yet unclassified' stamp: 'cwp 8/20/2009 08:11'! withAction: aBlock | browser | browser := self basicNew initialize. browser action: aBlock. self panels do: [:ea | browser addPanel: ea]. browser setMetaNode: self defaultMetaNode node: self defaultRootNode. ^ browser! ! !OBFakeCommandBrowser methodsFor: 'accessing' stamp: 'cwp 10/4/2006 09:59'! action ^ action! ! !OBFakeCommandBrowser methodsFor: 'accessing' stamp: 'cwp 8/20/2009 08:11'! action: aBlock action := aBlock! ! !OBFakeCommandBrowser methodsFor: 'as yet unclassified' stamp: 'cwp 9/18/2007 22:25'! cmdObsolete ^ OBPluggableCommand action: action! ! !OBFakeCommandBrowser methodsFor: 'as yet unclassified' stamp: 'cwp 3/11/2007 19:04'! cmdPluggable ^ OBPluggableCommand action: action! ! !OBFakeCommandBrowser methodsFor: 'as yet unclassified' stamp: 'cwp 9/18/2007 22:27'! obsoleteCmd ^ #cmdObsolete! ! !PluggableButtonMorph methodsFor: '*ob-tests-core' stamp: 'TestRunner 1/10/2010 23:32'! isOn ^ self getModelState! ! TestCase subclass: #OBAnnouncerTest instanceVariableNames: 'announcer' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBAnnouncerTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testBlock | announcement | announcer := OBAnnouncer new. announcer observe: OBSelectionChanged do: [:arg | announcement := arg]. announcer announce: OBSelectionChanged. self assert: (announcement isKindOf: OBSelectionChanged)! ! !OBAnnouncerTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testInstance | announcement | announcer := OBAnnouncer new. announcer observe: OBSelectionChanged do: [:arg | announcement := arg]. announcer announce: OBSelectionChanged new. self assert: (announcement isKindOf: OBSelectionChanged)! ! !OBAnnouncerTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! testMessage | announcement | announcer := OBAnnouncer new. announcer observe: OBSelectionChanged send: #value: to: [:ann | announcement := ann]. announcer announce: OBSelectionChanged. self assert: (announcement isKindOf: OBSelectionChanged)! ! 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: 'cwp 9/18/2007 22:19'! test02CommandSelectorsFindsCommands browser := OBFakeCommandBrowser new. self assert: (browser commandSelectors includes: #cmdPluggable) ! ! !OBBrowserCommandsTest methodsFor: 'tests' stamp: 'cwp 9/18/2007 22:25'! test03CommandSelectorsFindsCommands browser := OBFakeCommandBrowser new. self deny: (browser commandSelectors includes: #cmdObsolete) ! ! TestCase subclass: #OBBrowserTest instanceVariableNames: 'model widget' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBBrowserTest class methodsFor: 'testing' stamp: 'cwp 11/2/2006 00:13'! isAbstract ^ self name = #OBBrowserTest! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 8/20/2009 08:11'! assertAListIncludes: anArrayOfStrings self listMorphs detect: [:m | | list | list := m getListDelicately collect: [:ea | ea asString withBlanksTrimmed]. list includesAllOf: anArrayOfStrings] ifNone: [self assert: false].! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 8/20/2009 08:11'! assertAListMatches: strings | list | self listMorphs detect: [:m | list := m getListDelicately. (list size = strings size) and: [list includesAllOf: strings]] ifNone: [self assert: false].! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 8/20/2009 08:11'! assertButtonSelected: aString | button | button := (self morphsOfClass: OBFakeButton) detect: [:m | m label contents = aString] ifNone: [self signalFailure: 'No button labeled ', aString]. self assert: button isOn! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 8/20/2009 08:11'! assertCurrentItemIs: expected | actual | actual := self currentItem withBlanksTrimmed. self assert: actual = expected! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 8/20/2009 08:11'! assertListAt: index contains: items | list | list := self listItemsAt: index. self assert: (list size = items size). self assert: (list includesAllOf: items).! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 8/20/2009 08:11'! assertListAt: index includes: items | list | list := (self listItemsAt: index) collect: [:ea | ea asString withBlanksTrimmed]. self assert: (list includesAllOf: items).! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 8/20/2009 08:11'! assertMenuContains: aString | item | item := self menuItemNamed: aString. self assert: item notNil! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 7/9/2007 23:15'! assertNoButtonsVisible self assert: ((widget findDeeplyA: OBFakeScroller) findDeeplyA: OBFakeButton) isNil! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 6/11/2009 16:01'! assertSelectedTextIs: aString | text selection textWidget | textWidget := self textMorph. text := textWidget text. selection := textWidget selectionInterval. self assert: (text atAll: selection) asString = aString! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 8/20/2009 08:11'! assertTextIs: aString | actual | actual := self textMorph text. self assert: actual = aString.! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 7/9/2007 00:56'! assertTextIsSelected self assert: self textMorph getSelection size = self textMorph text size! ! !OBBrowserTest methodsFor: 'configuration' stamp: 'cwp 8/22/2007 23:14'! browserClass self subclassResponsibility! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! clickButtonLabeled: aString | button | button := (self morphsOfClass: OBFakeButton) detect: [:m | m label contents = aString] ifNone: [self signalFailure: 'No button labeled ', aString]. button click! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 9/14/2005 22:22'! currentItem ^ self currentList selection asString! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 5/13/2004 10:59'! currentList ^ self listMorphs reversed detect: [:list | list selection notNil] ifNone: [self signalFailure: 'No item is currently selected']! ! !OBBrowserTest methodsFor: 'asserting' stamp: 'cwp 3/14/2004 13:11'! denyAListIncludes: anArrayOfStrings self listMorphs detect: [:m | m getListDelicately includesAllOf: anArrayOfStrings] ifNone: [^ self]. self assert: false.! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! deselect: aString | listMorph | listMorph := self findListContaining: aString. listMorph changeModelSelection: 0.! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! drag: nodeName | item list | item := StringMorph contents: nodeName asString. list := self findListContaining: nodeName. ^ list model dragPassengerFor: item inMorph: list! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! drag: passangerName to: targetName | passanger | passanger := self drag: passangerName. self drop: passanger on: targetName! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! drop: aPassenger on: targetName | list | list := self findListContaining: targetName. self assert: list notNil. self assert: (list canDrop: aPassenger on: targetName). list drop: aPassenger on: targetName.! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 7/8/2007 02:24'! editText: aString self textMorph text: aString! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 8/20/2009 08:11'! findListContaining: aString ^ self listMorphs detect: [:m | | list | list := m getListDelicately collect: [:ea | ea asString withBlanksTrimmed]. list includes: aString] ifNone: [nil]! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 7/8/2007 01:44'! forceLayout widget update! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 3/14/2004 13:11'! listItemsAt: index ^ (self listMorphs at: index ifAbsent: [self signalFailure: 'List ', index asString, ' does not exist']) getListDelicately ! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 7/8/2007 01:39'! listMorphs ^ self morphsOfClass: OBFakeList! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 8/20/2009 08:11'! menuItemNamed: aString | lists current | lists := self listMorphs. current := lists reversed detect: [:list | list selection notNil]. ^ (current getMenu: true) itemWithWording: aString. ! ! !OBBrowserTest methodsFor: 'running' stamp: 'avi 9/17/2005 01:39'! metagraph ^ self browserClass defaultMetaNode! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 7/7/2007 22:12'! morphNamed: aString ^widget findDeepSubmorphThat: [:m | m knownName = aString] ifAbsent: [self signalFailure: aString , 'not found']! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 7/8/2007 01:37'! morphsOfClass: aClass | found | found := OrderedCollection new. widget withAllChildrenDo: [:m | (m isMemberOf: aClass) ifTrue: [found add: m]]. ^found! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! mouseMoveEventIn: name | rect plm | plm := self findListContaining: name. rect := plm listMorph rectForRow: (plm getListDelicately indexOf: name). ^ MouseMoveEvent new setType: #mouseEnter startPoint: rect center + (rect width @ 0) endPoint: rect center trail: #() buttons: 4 hand: ActiveHand stamp: Time millisecondClockValue! ! !OBBrowserTest methodsFor: 'configuration' stamp: 'cwp 8/22/2007 23:18'! node self subclassResponsibility! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! select: aString "We don't use #getListDelicately because the user would have to scroll through the list to find the item we're selecting, thus triggering updates to the list." | listMorph list | listMorph := self findListContaining: aString. self assert: listMorph notNil. listMorph model okToChange ifFalse: [^ self]. list := listMorph getListObtrusively collect: [:ea | ea asString withBlanksTrimmed]. listMorph changeModelSelection: (list indexOf: aString)! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! selectMenuItem: aString | item | item := self menuItemNamed: aString. item ifNil: [self signalFailure: 'Menu item ''', aString, ''' does not exist.']. item click! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! selectSequence: aCollection | plm | aCollection withIndexDo: [:item :index | plm := self listMorphs at: index. plm changeModelSelection: (plm getListObtrusively indexOf: item)]! ! !OBBrowserTest methodsFor: 'simulating' stamp: 'cwp 8/20/2009 08:11'! setText: aString | textMorph | textMorph := self textMorph. textMorph text: aString asText; accept. ! ! !OBBrowserTest methodsFor: 'running' stamp: 'cwp 7/8/2007 01:43'! setUp model := self browserClass metaNode: self metagraph node: self node. widget := OBFakeBuilder build: model. self forceLayout! ! !OBBrowserTest methodsFor: 'examining' stamp: 'cwp 7/8/2007 01:46'! textMorph ^ (self morphsOfClass: OBFakeText) last! ! OBBrowserTest subclass: #OBFakeBrowserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBFakeBrowserTest methodsFor: 'constants' stamp: 'cwp 3/12/2007 23:51'! browserClass ^ OBFakeBrowser! ! !OBFakeBrowserTest methodsFor: 'running' stamp: 'cwp 11/7/2004 21:27'! metagraph ^ OBFakeNode metagraph! ! !OBFakeBrowserTest methodsFor: 'running' stamp: 'cwp 12/17/2003 15:12'! node ^ OBFakeNode new! ! !OBFakeBrowserTest methodsFor: 'constants' stamp: 'cwp 12/5/2004 18:17'! paneCount ^ 4! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 3/14/2004 14:25'! testAcceptText self select: #a. self assertListAt: 1 contains: #(a b c). self assertListAt: 2 contains: #(aa ab ac). self assertTextIs: 'a'. self setText: 'x'. "This is a gratuitous refresh to make the test pass. It isn't necessary when the browser is actually open. It's a deficiency of the test environment..." self listMorphs do: [:ea | ea update: #list]. self assertListAt: 1 contains: #(x b c). self assertListAt: 2 contains: #(xa xb xc). self assertTextIs: 'x' ! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 1/7/2004 08:27'! testAction self select: #a. self selectMenuItem: 'become z'. self assertListAt: 1 contains: #(z b c)! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 2/28/2004 13:49'! testConfirmAbandon self select: #a. self assertListAt: 1 contains: #(a b c). self assertListAt: 2 contains: #(aa ab ac). self assertTextIs: 'a'. self editText: 'x'. [self select: #b] on: OBConfirmationRequest do: [:notification | notification cancel]. self assertCurrentItemIs: #a. self assertTextIs: 'x'. ! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 7/8/2007 21:06'! testConfirmClose | notification | self select: #a. self assertListAt: 1 contains: #(#a #b #c). self assertListAt: 2 contains: #(#aa #ab #ac). self assertTextIs: 'a'. self editText: 'x'. [widget close] on: OBConfirmationRequest do: [:ex | notification := ex]. self deny: notification isNil! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 7/8/2007 23:01'! testCreateWindow self assert: (widget isKindOf: OBFakeWindow). self assert: widget label = 'OmniBrowser'! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 6/4/2006 12:18'! testDeleteB self select: #b. self selectMenuItem: 'delete'. self assertListAt: 1 contains: #(a c). self assert: self listMorphs size = self paneCount. self assertTextIs: ''.! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 3/14/2004 17:20'! testDeleteRootNode self select: #a. self selectMenuItem: 'delete root'. self denyAListIncludes: #(a b c). self assertTextIs: ''! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 8/26/2004 02:17'! testDeselectA self select: #a. self deselect: #a. self assertListAt: 1 contains: #(a b c). self assert: self listMorphs size = self paneCount. self assertTextIs: ''.! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 8/20/2009 08:11'! testDragAndDrop | node | self select: #a. node := self drag: #ab. self assert: (node isKindOf: OBFakeNode). self assert: node name = #ab. self drop: node on: #c. self assertListAt: 1 contains: #(a b c). self assertCurrentItemIs: #c. self assertTextIs: 'c'. self assertListAt: 2 contains: #(cb). ! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 8/26/2004 02:17'! testInitialDisplay self assert: self listMorphs size = self paneCount. self assertListAt: 1 contains: #(a b c). self assertTextIs: ''. ! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 7/8/2007 22:05'! testPanes | scroller | self assert: (self morphsOfClass: OBFakeList) size = self paneCount. self assert: (self morphsOfClass: OBFakeText) size = 1. scroller := (self morphsOfClass: OBFakeScroller) anyOne. self assert: scroller children size = model navigationPanel minPanes! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 7/8/2007 22:13'! testRefreshDirty self select: #a. self editText: 'x'. [self selectMenuItem: 'create z'] on: OBConfirmationRequest do: [:request | Transcript cr; show: 'cancelling'. request cancel]. model announcer announce: (OBRefreshRequired new). self assertListAt: 1 contains: #(a b c z). self assertCurrentItemIs: #a. self assertTextIs: 'x'. ! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/7/2003 19:30'! testSelectA self select: #a. self assertListAt: 1 contains: #(a b c). self assertListAt: 2 contains: #(aa ab ac). self assertTextIs: 'a'! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/7/2003 19:30'! testSelectC self select: #c. self assertListAt: 1 contains: #(a b c). self assertListAt: 2 contains: #(). self assertTextIs: 'c'! ! !OBFakeBrowserTest methodsFor: 'testing' stamp: 'dvf 9/5/2005 18:10'! testSelectionPath self select: #a. self select: #ab. self assert: ((model selectionPath collect: [:e | e item]) = (OrderedCollection with: 'a' with: 'b'))! ! TestCase subclass: #OBBuilderTest instanceVariableNames: 'model' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBBuilderTest methodsFor: 'emulating' stamp: 'cwp 7/8/2007 01:29'! activate ! ! !OBBuilderTest methodsFor: 'accessing' stamp: 'cwp 3/15/2007 22:35'! announcer ^ OBAnnouncer new! ! !OBBuilderTest methodsFor: 'building' stamp: 'cwp 3/13/2007 22:23'! browser ^ OBBrowser metaNode: OBFakeNode metagraph node: OBFakeNode new.! ! !OBBuilderTest methodsFor: 'building' stamp: 'cwp 7/8/2007 01:20'! build: aModel ^ self builderClass build: aModel! ! !OBBuilderTest methodsFor: 'building' stamp: 'cwp 8/20/2009 08:11'! buildNavigationPanel model := self browser. ^ self build: model navigationPanel. ! ! !OBBuilderTest methodsFor: 'building' stamp: 'cwp 8/20/2009 08:11'! buildWindow model := self browser. ^ self build: model.! ! !OBBuilderTest methodsFor: 'tests' stamp: 'cwp 7/8/2007 01:16'! button ^OBButtonModel withLabel: 'test' inBar: self! ! !OBBuilderTest methodsFor: 'emulating' stamp: 'cwp 5/18/2007 23:20'! childNodes ^ #(a b c) collect: [:ea | (OBFake2Node tree: ea) metaNode: self metaNode]! ! !OBBuilderTest methodsFor: 'accessing' stamp: 'cwp 5/10/2007 23:17'! columnWithFilter ^ OBColumn inPanel: self metaNode: self metaNode node: self! ! !OBBuilderTest methodsFor: 'emulating' stamp: 'cwp 6/11/2009 15:14'! defaultChildNodes ^ #()! ! !OBBuilderTest methodsFor: 'emulating' stamp: 'cwp 7/8/2007 01:29'! displayString ^ 'test'! ! !OBBuilderTest methodsFor: 'emulating' stamp: 'cwp 7/8/2007 01:29'! isEnabled: aButton ^ true! ! !OBBuilderTest methodsFor: 'emulating' stamp: 'cwp 7/8/2007 01:29'! isSelected: aButton ^ false! ! !OBBuilderTest methodsFor: 'emulating' stamp: 'dkh 6/1/2007 10:06'! left ^ Array with: self! ! !OBBuilderTest methodsFor: 'emulating' stamp: 'cwp 7/14/2007 10:43'! listForNode: aNode ^ #(a b c)! ! !OBBuilderTest methodsFor: 'emulating' stamp: 'cwp 6/11/2009 15:14'! longDescriptionsForNode: aNode ^#()! ! !OBBuilderTest methodsFor: 'emulating' stamp: 'cwp 5/18/2007 23:15'! metaNode ^ (OBMetaNode named: 'testing') childAt: #left put: (OBMetaNode named: 'Left'); childAt: #right put: (OBMetaNode named: 'Right'); addFilter: OBModalFilter new; yourself! ! !OBBuilderTest methodsFor: 'emulating' stamp: 'cwp 3/15/2007 22:36'! metaNode: aMetanode! ! !OBBuilderTest methodsFor: 'emulating' stamp: 'dkh 6/1/2007 10:06'! right ^ Array with: self! ! !OBBuilderTest methodsFor: 'emulating' stamp: 'cwp 7/14/2007 10:41'! selectedNode ^ OBFakeNode new! ! !OBBuilderTest methodsFor: 'emulating' stamp: 'cwp 7/8/2007 01:28'! selection ^ 1! ! !OBBuilderTest methodsFor: 'accessing' stamp: 'cwp 7/14/2007 10:40'! switch model := OBSwitch inColumn: self. model filter: self. ^ model! ! TestCase subclass: #OBCollectionNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBCollectionNodeTest methodsFor: 'tests' stamp: 'dkh 6/1/2007 10:07'! testAncestryOfDescendent | node | node := OBCollectionNode on: (Array with: (OBClassNode on: self class)). self assert: (node isAncestorOf: (OBMethodNode on: #testAncestryOfDescendent inClass: self class))! ! !OBCollectionNodeTest methodsFor: 'tests' stamp: 'dkh 6/1/2007 10:07'! testAncestryOfNodeInCollection | node | node := OBCollectionNode on: (Array with: (OBClassNode on: self class)). self assert: (node isAncestorOf: (OBClassNode on: self class))! ! TestCase subclass: #OBColumnPanelTest instanceVariableNames: 'announcer' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !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: 'support' stamp: 'cwp 11/2/2006 00:35'! addFactory: aBlock | factory | factory := OBPluggableCommand action: aBlock. announcer observe: OBNodeCommandScan do: [:ann | ann addFactory: factory]. ^factory! ! !OBColumnTest methodsFor: 'updating' stamp: 'cwp 10/14/2006 18:04'! announce: aClass ^ announcer announce: aClass! ! !OBColumnTest methodsFor: 'emulating' stamp: 'cwp 6/25/2006 00:04'! announcer ^ announcer! ! !OBColumnTest methodsFor: 'emulating' stamp: 'cwp 6/25/2006 00:40'! browser ^ self! ! !OBColumnTest methodsFor: 'emulating' stamp: 'cwp 7/17/2007 22:46'! clearAfter: aOBColumn ! ! !OBColumnTest methodsFor: 'support' stamp: 'cwp 8/20/2009 08:11'! parentNode | node | node := OBFakeNode parent: nil item: #a. node metaNode: OBFakeNode metagraph. ^ node! ! !OBColumnTest methodsFor: 'support' stamp: 'cwp 8/22/2009 11:44'! parentNodeBrokenAutoselect | node x | node := self parentNode. x := OBFakeNode metagraph. node metaNode childAt: #noChildren put: x. node metaNode autoSelect: (OBAutoSelection on: x). ^ node! ! !OBColumnTest methodsFor: 'emulating' stamp: 'cwp 6/25/2006 00:39'! parentNodeForColumn: aColumn ^ OBFakeNode parent: nil item: 'b'! ! !OBColumnTest methodsFor: 'support' stamp: 'cwp 8/22/2009 11:45'! parentNodeWithAutoselect | node x | node := self parentNode. x := OBFakeNode metagraph. node metaNode childAt: #childX put: x. node metaNode autoSelect: (OBAutoSelection on: x). ^ node! ! !OBColumnTest methodsFor: 'support' stamp: 'cwp 8/20/2009 08:11'! 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! ! !OBColumnTest methodsFor: 'emulating' stamp: 'cwp 7/17/2007 23:48'! selectionChangedIn: anOBColumn ! ! !OBColumnTest methodsFor: 'support' stamp: 'cwp 8/20/2009 08:11'! setUp announcer := OBAnnouncer new. column := OBColumn inPanel: self metaNode: OBFakeNode metagraph node: (OBFakeNode parent: nil item: 'a'). ! ! !OBColumnTest methodsFor: 'tests' stamp: 'cwp 11/2/2006 00:35'! test01MenuIncludesCommands | menu invoked | invoked := false. (self addFactory: [invoked := true]) label: 'test service'. menu := MenuMorph new. column menu: menu. (menu itemWithWording: 'test service') doButtonAction. self assert: invoked! ! !OBColumnTest methodsFor: 'tests' stamp: 'cwp 11/2/2006 00:35'! test02KeystrokeInvokesCommand | invoked | invoked := false. (self addFactory: [invoked := true]) keystroke: $s. column keystroke: $s from: nil. self assert: invoked! ! !OBColumnTest methodsFor: 'tests' stamp: 'cwp 7/17/2007 22:58'! test03SetParent column parent: self parentNode. self assert: column listSize = 3. self assert: column selection = 0! ! !OBColumnTest methodsFor: 'tests' stamp: 'cwp 7/17/2007 23:37'! test04AutoSelectNotFound column parent: self parentNodeBrokenAutoselect. self assert: column listSize = 3. self assert: column selection = 0! ! !OBColumnTest methodsFor: 'tests' stamp: 'cwp 7/17/2007 23:36'! test05AutoSelect column parent: self parentNodeWithAutoselect. self assert: column listSize = 4. self assert: column selection = 4! ! !OBColumnTest methodsFor: 'tests' stamp: 'cwp 7/23/2007 01:42'! test06Icon column parent: self parentNodeWithIcon. self assert: (column iconAt: 1) = #blank. self assert: (column iconAt: 2) = #test. self assert: (column iconAt: 3) = #blank.! ! TestCase subclass: #OBCommandTest instanceVariableNames: 'service isSelected' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBCommandTest class methodsFor: 'as yet unclassified' stamp: 'cwp 11/2/2006 00:13'! isAbstract ^ self name == #OBCommandTest! ! !OBCommandTest class methodsFor: 'as yet unclassified' 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: '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: 'cwp 10/15/2006 16:42'! test03DoesntWantButton self deny: self command wantsButton! ! 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 3/23/2007 23:59'! menu ^ (OBMorphBuilder build: panel) getMenu: false! ! !OBDefinitionPanelTest methodsFor: 'emulating' stamp: 'cwp 11/2/2006 00:35'! scanCommands: ann ann addFactory: ((OBPluggableService action: [:node | self assert: (node isKindOf: OBTextSelection). executed := true]) label: 'test')! ! !OBDefinitionPanelTest methodsFor: 'support' stamp: 'cwp 8/20/2009 08:11'! setUp announcer := OBAnnouncer new. panel := OBDefinitionPanel inBrowser: self. ! ! !OBDefinitionPanelTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! 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.! ! !OBDefinitionPanelTest methodsFor: 'tests' stamp: 'cwp 3/23/2007 23:59'! test02MenuIncludesCommands | menu | announcer observe: OBTextCommandScan do: [:ann | ann addFactory: (OBPluggableCommand new label: 'test')]. menu := self menu. self deny: (menu itemWithWording: 'test') isNil! ! !OBDefinitionPanelTest methodsFor: 'tests' stamp: 'cwp 3/23/2007 23:59'! test03CommandsGetExecuted | menu executed | executed := false. announcer observe: OBTextCommandScan do: [:ann | ann addFactory: ((OBPluggableCommand action: [executed := true]) label: 'test')]. menu := self menu. (menu itemWithWording: 'test') doButtonAction. self assert: executed! ! !OBDefinitionPanelTest methodsFor: 'tests' stamp: 'cwp 3/23/2007 23:59'! test04InactiveCommandsAreHidden | menu | announcer observe: 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 8/20/2009 08:11'! test06SilentChangeVetoedIfDirty | ann morph | morph := OBMorphBuilder build: panel. morph hasUnacceptedEdits: true. 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: #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: '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)! ! 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 8/20/2009 08:11'! test06MenuItemExecutesAction | menu factory called command | called := false. menu := MenuMorph new. factory := OBPluggableCommand action: [called := true]. command := factory on: nil for: nil. command addItemToMenu: menu. menu items first doButtonAction. self assert: called! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test07MenuItemEnabledByDefault | menu factory command | menu := MenuMorph 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 8/20/2009 08:11'! test09MenuReflectsLabel | menu factory command | menu := MenuMorph new. factory := OBPluggableCommand new label: 'a fine factory'. command := factory on: nil for: self. command addItemToMenu: menu. self assert: menu items first contents = 'a fine factory'! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test10MenuDisplaysKeystroke | menu factory command | menu := MenuMorph new. factory := OBPluggableCommand new label: 'a fine factory'; keystroke: $f. command := factory on: nil for: self. command addItemToMenu: menu. self assert: menu items first contents = 'a fine factory (f)'! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 8/20/2009 08:11'! test11MenuDisplaysIcon | menu factory pref command | pref := OBPlatform current menuWithIcons. [OBPlatform current enableGently: #menuWithIcons. menu := MenuMorph new. factory := OBPluggableCommand new label: 'a fine factory'; icon: #deleteIcon. command := factory on: nil for: self. command addItemToMenu: menu. self assert: menu lastItem icon notNil] ensure: [OBPlatform current setPreference: #menuWithIcons toValue: pref]! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 11/2/2006 00:42'! test13CommandIsMenuOnlyByDefault | factory | factory := OBPluggableCommand new. self deny: factory wantsButton! ! !OBPluggableCommandTest methodsFor: 'tests' stamp: 'cwp 11/2/2006 00:42'! test14CommandWithButtonLabelWantsButton | factory | factory := OBPluggableCommand new. factory buttonLabel: 'serv'. self assert: factory wantsButton! ! !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: 'children filter' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Core'! !OBRescueFilterTest methodsFor: 'as yet unclassified' 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: 'as yet unclassified' 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: 'as yet unclassified' 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: 'as yet unclassified' 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: 'as yet unclassified' 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: 'as yet unclassified' 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: 'as yet unclassified' 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: 'as yet unclassified' 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: 'as yet unclassified' 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: 'as yet unclassified' 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: 'as yet unclassified' 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 5/18/2007 00:25'! listChanged ! ! !OBSwitchTest methodsFor: 'emulating' stamp: 'cwp 7/14/2007 10:45'! listForNode: aNode ^ self list! ! !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 8/20/2009 08:11'! testGetSelection | switch | switch := OBSwitch new. 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 8/20/2009 08:11'! testSendsActivateToFilter | switch | switch := OBSwitch new. 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 8/20/2009 08:11'! testSwitchIsActiveWhenItHasAFilter | switch | switch := OBSwitch new. 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: ! !