SystemOrganization addCategory: #'OB-Tests-Standard'! OBBrowserTest subclass: #OBAccessBrowserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBAccessBrowserTest methodsFor: 'configuration' stamp: 'avi 9/17/2005 01:39'! browserClass ^ OBVariablesBrowser! ! !OBAccessBrowserTest methodsFor: 'configuration' stamp: 'dvf 8/31/2005 13:17'! node ^BogusB asNode! ! !OBAccessBrowserTest methodsFor: 'testing' stamp: ''! testInitalDisplay self assertListAt: 1 contains: BogusInfo bInstVarNames! ! !OBAccessBrowserTest methodsFor: 'testing' stamp: 'lr 8/15/2010 17:50'! testSelectCVar self clickButtonLabeled: 'Class'. self select: 'FirstClassVariableB'. self assertListAt: 2 contains: #('BogusB>>accessesCVar' 'BogusB class>>accessesCVarAlso' 'BogusB>>foreign2')! ! !OBAccessBrowserTest methodsFor: 'testing' stamp: 'lr 8/15/2010 15:28'! testSelectIVarAccessor self select: 'firstInstanceVariableB'. self select: 'BogusB>>accessesIvar'. self browserClass chasingBrowsersEnabled ifTrue: [ self assertListAt: 3 includes: #('BogusB>>sendsAccessesIvar') ]! ! !OBAccessBrowserTest methodsFor: 'testing' stamp: 'cwp 9/13/2005 21:38'! testSelectIvar self select: 'firstInstanceVariableB'. self assertListAt: 2 contains: #('BogusB>>accessesIvar' 'BogusB>>foreign')! ! !OBAccessBrowserTest methodsFor: 'testing' stamp: 'lr 8/15/2010 15:28'! testSelectSender self select: 'firstInstanceVariableB'. self select: 'BogusB>>accessesIvar'. self browserClass chasingBrowsersEnabled ifFalse: [ ^ self ]. self select: 'BogusB>>sendsAccessesIvar'. self assertListAt: 4 contains: #('BogusB>>sendsSendsAccessesIvar')! ! OBBrowserTest subclass: #OBChasingBrowserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBChasingBrowserTest class methodsFor: 'testing' stamp: 'cwp 12/8/2004 22:59'! isAbstract ^ self name = #OBChasingBrowserTest! ! !OBChasingBrowserTest methodsFor: 'configuration' stamp: 'lr 2/7/2010 10:20'! initialList self subclassResponsibility! ! !OBChasingBrowserTest methodsFor: 'tests' stamp: 'cwp 12/8/2004 22:58'! testInitialDisplay self assertListAt: 1 contains: self initialList! ! OBChasingBrowserTest subclass: #OBImplementorsBrowserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBImplementorsBrowserTest methodsFor: 'configuration' stamp: 'avi 9/17/2005 01:40'! browserClass ^ OBImplementorsBrowser! ! !OBImplementorsBrowserTest methodsFor: 'configuration' stamp: 'cwp 6/11/2009 20:13'! initialList ^ #('BogusB>>sendsSendsAccessesIvar {senders}')! ! !OBImplementorsBrowserTest methodsFor: 'configuration' stamp: 'cwp 12/8/2004 23:37'! node "We don't want this method to show up in senders of #sendsSendsAccesses, since other tests aren't expecting it." | selector | selector := ('sendsSendsAccesses', 'Ivar') asSymbol. ^ OBMethodNode on: selector inClass: BogusB! ! !OBImplementorsBrowserTest methodsFor: 'tests' stamp: 'lr 8/15/2010 15:28'! testMessagesOf self select: 'BogusB>>sendsSendsAccessesIvar {senders}'. self browserClass chasingBrowsersEnabled ifTrue: [ self assertListAt: 2 contains: #('sendsAccessesIvar') ]! ! OBChasingBrowserTest subclass: #OBSendersBrowserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBSendersBrowserTest methodsFor: 'configuration' stamp: 'avi 9/17/2005 01:40'! browserClass ^ OBSendersBrowser! ! !OBSendersBrowserTest methodsFor: 'configuration' stamp: 'cwp 6/11/2009 20:08'! initialList ^ #('BogusB>>sendsAccessesIvar {senders}')! ! !OBSendersBrowserTest methodsFor: 'configuration' stamp: 'cwp 12/8/2004 22:44'! node "We don't want this method to show up in senders of #accessesIvar, since that's what we're testing" | selector | selector := ('accesses', 'Ivar') asSymbol. ^ OBMethodNode on: selector inClass: BogusB! ! !OBSendersBrowserTest methodsFor: 'tests' stamp: 'lr 8/15/2010 15:28'! testSendersOf self select: 'BogusB>>sendsAccessesIvar {senders}'. self browserClass chasingBrowsersEnabled ifTrue: [ self assertListAt: 2 contains: #('BogusB>>sendsSendsAccessesIvar {senders}') ]! ! OBBrowserTest subclass: #OBCodeBrowserTest instanceVariableNames: 'damage' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCodeBrowserTest class methodsFor: 'testing' stamp: ''! isAbstract ^ self name = #OBCodeBrowserTest! ! !OBCodeBrowserTest class methodsFor: 'accessing' stamp: ''! resources ^ Array with: BogusSnapshotResource! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! altMethodA ^ 'a ^ $B'! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! altMethodOne ^ 'one ^ 11'! ! !OBCodeBrowserTest methodsFor: 'asserting' stamp: 'lr 8/13/2010 20:03'! assertIsClassSide self assertButtonSelected: 'Class'! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! bogusAClassTemplate ^ 'BogusA class instanceVariableNames: '''''! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: 'cwp 12/12/2004 23:51'! bogusAName ^'BogusA'! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: 'cwp 8/22/2007 23:08'! bogusATemplate ^ 'Object subclass: #BogusA instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: ''', self bogusCategoryName, ''''! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! bogusBComment ^ 'A comment for BogusB'! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: 'cwp 8/22/2007 23:08'! bogusCDefinition ^ 'Object subclass: #BogusC instanceVariableNames: ''foo'' classVariableNames: '''' poolDictionaries: '''' category: ''', self bogusCategoryName, ''''! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: 'cwp 12/12/2004 23:40'! bogusCategoryName ^ BogusInfo baseCategory! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: 'cwp 12/10/2004 21:15'! bogusClassNames ^BogusInfo baseClassNames! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: 'cwp 8/22/2007 23:09'! bogusDDefinition ^ 'Object subclass: #BogusD instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: ''', self bogusCategoryName, ''''! ! !OBCodeBrowserTest methodsFor: 'running' stamp: ''! browserResource ^ self class resources first current! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: 'cwp 8/22/2007 23:16'! classTemplate ^ 'Object subclass: #NameOfSubclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: ''', self bogusCategoryName, ''''! ! !OBCodeBrowserTest methodsFor: 'simulating' stamp: ''! deselectBogusCategory self deselect: self bogusCategoryName! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! fakeAClassTemplate ^ self deprecated: 'Use #bogusAClassTemplate'! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! fakeAComment self deprecated: 'Use BogusInfo>>aComment instead'! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! fakeATemplate self deprecated: 'Use #bogusATemplate instead'! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! fakeClassBComment self deprecated: 'Use #bogusBComment'! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! fakeClassCDefinition self deprecated: 'Use #bogusCDefinition'! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! fakeClassDDefinition self deprecated: 'Use #bogusDDefinition'! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! fakePackageName self deprecated: 'Use BogusInfo>>packageName'! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! methodA ^ 'a ^ $A'! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! methodFour ^ 'four ^ 4'! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! methodOne ^ 'one ^ 1'! ! !OBCodeBrowserTest methodsFor: 'constants' stamp: ''! methodTemplate ^ 'message selector and argument names "comment stating purpose of message" | temporary variable names | statements'! ! !OBCodeBrowserTest methodsFor: 'running' stamp: 'cwp 3/1/2006 19:52'! runCase SystemChangeNotifier uniqueInstance doSilently: [super runCase]! ! !OBCodeBrowserTest methodsFor: 'running' stamp: 'cwp 3/1/2006 19:52'! runCaseAsFailure: aSemaphore SystemChangeNotifier uniqueInstance doSilently: [super runCaseAsFailure: aSemaphore]! ! !OBCodeBrowserTest methodsFor: 'simulating' stamp: 'cwp 12/13/2004 00:01'! selectBogusA self select: self bogusAName! ! !OBCodeBrowserTest methodsFor: 'simulating' stamp: ''! selectBogusCategory self select: self bogusCategoryName! ! !OBCodeBrowserTest methodsFor: 'simulating' stamp: ''! selectBogusPackage ! ! !OBCodeBrowserTest methodsFor: 'running' stamp: 'lr 11/7/2009 18:32'! setUp damage := BogusDamage new. model := self browserClass metaNode: self metagraph node: self node. widget := OBFakeBuilder build: model. self forceLayout! ! !OBCodeBrowserTest methodsFor: 'simulating' stamp: 'lr 8/13/2010 20:02'! switchToClassSide self clickButtonLabeled: 'Class'! ! !OBCodeBrowserTest methodsFor: 'simulating' stamp: ''! switchToComment self clickButtonLabeled: '?'! ! !OBCodeBrowserTest methodsFor: 'running' stamp: ''! tearDown damage repair! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/13/2004 00:01'! testButtonRemoval self selectBogusCategory. self selectBogusA. self deselectBogusCategory. self assertNoButtonsVisible! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/13/2004 00:26'! testColumnClearing self selectBogusCategory. self selectBogusA. self select: 'numbers'. self select: 'one'. self switchToClassSide. self assertAListIncludes: self bogusClassNames. self assertAListIncludes: #('testing' 'capitals'). self denyAListIncludes: #('letters' 'numbers'). self denyAListIncludes: #('one' 'two' 'three'). self assertTextIs: self bogusAClassTemplate! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 7/18/2007 21:32'! testCreateClassFromClass self selectBogusCategory. self select: 'BogusC'. self setText: self bogusDDefinition. damage add: #Definition ofClass: #BogusD. self assertAListIncludes: #(BogusD). self assertCurrentItemIs: '-- all --'.! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 7/18/2007 21:33'! testCreateClassFromTemplate self selectBogusCategory. damage add: #Definition ofClass: #BogusD. self setText: self bogusDDefinition. self assertAListIncludes: #(BogusD). self assertCurrentItemIs: '-- all --'! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/20/2004 00:37'! testCreateMethodFromMethod self selectBogusCategory. self selectBogusA. self select: 'numbers'. self select: 'one'. damage add: #four ofClass: #BogusA. self setText: self methodFour. self assertAListMatches: #('one' 'two' 'three' 'four' 'five'). self assertCurrentItemIs: 'four' ! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/13/2004 00:04'! testCreateMethodFromTemplate self selectBogusCategory. self selectBogusA. self select: 'letters'. self setText: self methodFour. damage add: #four ofClass: #BogusA. self assertAListMatches: #('a' 'b' 'four'). self assertCurrentItemIs: 'four' ! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 7/18/2007 21:44'! testEditClass self selectBogusCategory. self select: 'BogusC'. self setText: self bogusCDefinition. damage add: #Definition ofClass: #BogusC. self assertAListIncludes: self bogusClassNames. self assertCurrentItemIs: '-- all --'. self assert: BogusC instVarNames = #(foo)! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/13/2004 00:04'! testEditClassMethod self selectBogusCategory. self selectBogusA. self switchToClassSide. self select: 'capitals'. self select: 'a'. self setText: self altMethodA. damage add: #a ofClass: #BogusA isMeta: true. self assertAListMatches: #('a' 'b'). self assertCurrentItemIs: 'a'. self assert: $B = BogusA a! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/15/2004 21:06'! testEditComment self selectBogusCategory. self selectBogusA. self switchToComment. self setText: self bogusBComment. damage add: #Comment ofClass: #BogusA. self assertAListIncludes: self bogusClassNames. self assertCurrentItemIs: #BogusA. self assert: BogusA comment = self bogusBComment! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/13/2004 00:04'! testEditMethod self selectBogusCategory. self selectBogusA. self select: 'numbers'. self select: 'one'. damage add: #one ofClass: #BogusA. self setText: self altMethodOne. self assertAListMatches: #('one' 'two' 'three' 'five'). self assertCurrentItemIs: 'one'. self assert: 11 = BogusA new one! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 7/18/2007 21:44'! testJumpToBogusA self selectBogusPackage. model jumpTo: (BogusA asNode). self assertCurrentItemIs: '-- all --'! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'dkh 04/29/2008 11:43'! testJumpToCapitals self selectBogusPackage. model jumpTo: (OBMethodCategoryNode on: 'capitals' inClass: BogusA class). self assertCurrentItemIs: 'capitals'. self assertIsClassSide. ! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/12/2004 23:55'! testJumpToFakes self selectBogusPackage. model jumpTo: (OBClassCategoryNode on: self bogusCategoryName inEnvironment: Smalltalk). self assertCurrentItemIs: self bogusCategoryName! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: ''! testJumpToMethodOne self selectBogusPackage. model jumpTo: (OBMethodNode on: #one inClass: BogusA). self assertCurrentItemIs: 'one'! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: ''! testJumpToNumbers self selectBogusPackage. model jumpTo: (OBMethodCategoryNode on: 'numbers' inClass: BogusA). self assertCurrentItemIs: 'numbers'.! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 6/9/2006 23:08'! testMethodChangedElsewhere self selectBogusCategory. self selectBogusA. self select: 'numbers'. self select: 'one'. self editText: 'foo'. damage add: #one ofClass: #BogusA. BogusA compile: self altMethodOne. model announcer announce: OBRefreshRequired new. self assertAListMatches: #('one' 'two' 'three' 'five'). self assertCurrentItemIs: 'one'. self assert: self textMorph hasEditingConflicts ! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/13/2004 00:25'! testSelectAllMethodCategory self selectBogusCategory. self selectBogusA. self select: '-- all --'. self assertAListIncludes: self bogusClassNames. self assertAListIncludes: #('letters' 'numbers'). self assertAListIncludes: #('one' 'two' 'three' 'five' 'a' 'b'). self assertTextIs: self methodTemplate! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 7/18/2007 21:45'! testSelectBogusA self selectBogusCategory. self selectBogusA. self assertAListIncludes: self bogusClassNames. self assertAListIncludes: #('letters' 'numbers'). self assertCurrentItemIs: '-- all --'. self assertTextIs: self bogusATemplate! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 8/3/2007 23:00'! testSelectBogusAClassSide self selectBogusCategory. self selectBogusA. self switchToClassSide. self assertAListIncludes: self bogusClassNames. self assertAListIncludes: #('capitals'). self assertCurrentItemIs: '-- all --'. self assertTextIs: self bogusAClassTemplate! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/13/2004 00:23'! testSelectBogusAComment self selectBogusCategory. self selectBogusA. self switchToComment. self assertAListIncludes: self bogusClassNames. self denyAListIncludes: #('letters' 'numbers'). self assertCurrentItemIs: self bogusAName. self assertTextIs: BogusInfo aComment.! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/10/2004 21:16'! testSelectCategory self selectBogusCategory. self assertAListIncludes: {self bogusCategoryName}. self assertAListIncludes: self bogusClassNames. self assertTextIs: self classTemplate! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/13/2004 00:26'! testSelectNumbers self selectBogusCategory. self selectBogusA. self select: 'numbers'. self assertAListIncludes: self bogusClassNames. self assertAListIncludes: #('letters' 'numbers'). self assertAListIncludes: #('one' 'two' 'three'). self assertTextIs: self methodTemplate. self assertTextIsSelected.! ! !OBCodeBrowserTest methodsFor: 'testing' stamp: 'cwp 12/13/2004 00:30'! testSelectOne self selectBogusCategory. self selectBogusA. self select: 'numbers'. self select: 'one'. self assertAListIncludes: self bogusClassNames. self assertAListIncludes: #('letters' 'numbers'). self assertAListIncludes: #('one' 'two' 'three'). self assertTextIs: BogusInfo aOneSource! ! OBCodeBrowserTest subclass: #OBHierImageBrowserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! OBHierImageBrowserTest subclass: #OBClassHierImageBrowserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBClassHierImageBrowserTest methodsFor: 'set up' stamp: 'lr 8/4/2007 11:11'! node ^ BogusA asClassSideNode! ! !OBHierImageBrowserTest class methodsFor: 'testing' stamp: 'cwp 12/12/2004 23:32'! shouldInheritSelectors ^ true! ! !OBHierImageBrowserTest methodsFor: 'constants' stamp: 'cwp 1/8/2005 11:52'! bogusClassNames ^ #('ProtoObject' 'Object' 'BogusA' 'BogusE')! ! !OBHierImageBrowserTest methodsFor: 'constants' stamp: 'cwp 12/13/2004 00:11'! bogusDDefinition ^ 'BogusA subclass: #BogusD instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: ''', self bogusCategoryName, ''''! ! !OBHierImageBrowserTest methodsFor: 'constants' stamp: 'cwp 1/8/2005 12:07'! bogusDName ^ 'BogusD'! ! !OBHierImageBrowserTest methodsFor: 'constants' stamp: 'cwp 12/13/2004 00:31'! bogusEDefinition ^ 'BogusA subclass: #BogusE instanceVariableNames: ''foo'' classVariableNames: '''' poolDictionaries: '''' category: ''', self bogusCategoryName, ''''! ! !OBHierImageBrowserTest methodsFor: 'constants' stamp: 'cwp 1/8/2005 12:05'! bogusEName ^ 'BogusE'! ! !OBHierImageBrowserTest methodsFor: 'set up' stamp: 'cwp 8/22/2007 23:16'! browserClass ^ OBHierarchyBrowser! ! !OBHierImageBrowserTest methodsFor: 'set up' stamp: 'dvf 8/31/2005 13:17'! node ^BogusA asNode! ! !OBHierImageBrowserTest methodsFor: 'simulating' stamp: 'cwp 12/12/2004 23:43'! selectBogusCategory ! ! !OBHierImageBrowserTest methodsFor: 'tests' stamp: 'cwp 12/13/2004 00:07'! testButtonRemoval "Not applicable to hierarchy browser"! ! !OBHierImageBrowserTest methodsFor: 'tests' stamp: 'cwp 7/18/2007 21:46'! testCreateClassFromClass self selectBogusCategory. self select: self bogusEName. damage add: #Definition ofClass: #BogusD. self setText: self bogusDDefinition. self assertAListIncludes: {self bogusDName}. self assertCurrentItemIs: '-- all --'! ! !OBHierImageBrowserTest methodsFor: 'tests' stamp: 'cwp 12/13/2004 00:15'! testCreateClassFromTemplate "doesn't apply for now"! ! !OBHierImageBrowserTest methodsFor: 'tests' stamp: 'cwp 12/13/2004 00:34'! testDeselectFakeA self selectBogusCategory. self selectBogusA. self deselect: self bogusAName. self assertAListIncludes: self bogusClassNames. self denyAListIncludes: #('letters' 'numbers'). self assertTextIs: '' "for now"! ! !OBHierImageBrowserTest methodsFor: 'tests' stamp: 'cwp 7/18/2007 21:45'! testEditClass self selectBogusCategory. self select: self bogusEName. damage add: #Definition ofClass: #BogusE. self setText: self bogusEDefinition. self assertAListIncludes: self bogusClassNames. self assertCurrentItemIs: '-- all --'. self assert: BogusE instVarNames = #(foo)! ! !OBHierImageBrowserTest methodsFor: 'tests' stamp: 'cwp 12/15/2004 21:13'! testEditComment self selectBogusCategory. self selectBogusA. self switchToComment. damage add: #Comment ofClass: #BogusA. self setText: self bogusBComment. self assertAListIncludes: self bogusClassNames. self assertCurrentItemIs: self bogusAName. self assert: BogusA comment = self bogusBComment! ! !OBHierImageBrowserTest methodsFor: 'tests' stamp: 'lr 2/7/2010 11:30'! testInitialDisplay self assert: self listMorphs size = 3. self assertListAt: 1 includes: self bogusClassNames. self assertTextIs: ''.! ! !OBHierImageBrowserTest methodsFor: 'tests' stamp: 'cwp 12/12/2004 23:24'! testJumpToFakes "Not applicable to the hierarchy browser"! ! !OBHierImageBrowserTest methodsFor: 'tests' stamp: 'cwp 12/12/2004 23:44'! testSelectCategory "Not applicable to the hierarchy browser"! ! !OBHierImageBrowserTest methodsFor: 'tests' stamp: 'lr 2/7/2010 11:32'! testSelectionPath self selectBogusCategory. self selectBogusA. self assert: model selectionPath size = 2. self assert: model selectionPath first = (OBClassNode on: BogusA). self assert: model selectionPath second = (OBAllMethodCategoryNode on: BogusA)! ! OBCodeBrowserTest subclass: #OBImageBrowserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBImageBrowserTest methodsFor: 'set up' stamp: 'cwp 12/10/2004 21:27'! browserClass ^ OBSystemBrowser! ! !OBImageBrowserTest methodsFor: 'set up' stamp: 'cwp 12/10/2004 21:28'! node ^ OBEnvironmentNode forImage! ! !OBImageBrowserTest methodsFor: 'tests' stamp: 'lr 2/7/2010 11:28'! testInitialDisplay self assert: self listMorphs size = 4. self assertListAt: 1 includes: {self bogusCategoryName}. self assertTextIs: ''. ! ! OBBrowserTest subclass: #OBInheritanceBrowserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBInheritanceBrowserTest methodsFor: 'running' stamp: 'cwp 12/8/2004 23:49'! interiorNode ^ OBMethodNode on: #isString inClass: BogusA! ! !OBInheritanceBrowserTest methodsFor: 'running' stamp: 'cwp 12/8/2004 23:49'! leafNode ^ OBMethodNode on: #isString inClass: BogusE! ! !OBInheritanceBrowserTest methodsFor: 'running' stamp: 'avi 9/17/2005 01:11'! metagraph ^ OBInheritanceBrowser defaultMetaNode! ! !OBInheritanceBrowserTest methodsFor: 'running' stamp: 'cwp 12/8/2004 23:49'! rootNode ^ OBCollectionNode on: {OBMethodNode on: #isString inClass: Object}! ! !OBInheritanceBrowserTest methodsFor: 'running' stamp: 'cwp 11/28/2004 10:22'! setUp! ! !OBInheritanceBrowserTest methodsFor: 'running' stamp: 'cwp 7/9/2007 00:58'! setUpWith: targetNode [OBInheritanceBrowser openRoot: self rootNode selection: targetNode] on: OBBrowseRequest do: [:notification | model := notification browser. widget := OBFakeBuilder build: model]. self forceLayout.! ! !OBInheritanceBrowserTest methodsFor: 'testing' stamp: 'cwp 9/17/2005 18:09'! testInitialDisplay self setUpWith: self interiorNode. self assertListAt: 1 contains: #('Object>>isString'); assertListAt: 2 contains: #('BogusA>>isString' 'String>>isString'); assertListAt: 3 contains: #('BogusE>>isString'); assertCurrentItemIs: 'BogusA>>isString'! ! !OBInheritanceBrowserTest methodsFor: 'testing' stamp: 'cwp 9/17/2005 18:09'! testInitialDisplay2 self setUpWith: self leafNode. self assertListAt: 1 contains: #('Object>>isString'); assertListAt: 2 contains: #('BogusA>>isString' 'String>>isString'); assertListAt: 3 contains: #('BogusE>>isString'); assertCurrentItemIs: 'BogusE>>isString'! ! OBBrowserTest subclass: #OBReferencesBrowserTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBReferencesBrowserTest methodsFor: 'constants' stamp: 'cwp 6/11/2009 20:10'! bogusCReferences ^ #('OBCodeBrowserTest>>testEditClass {testing}' 'OBReferencesBrowserTest>>node {configuration}' 'OBReferencesBrowserTest>>refersToBogusC {bogus}' )! ! !OBReferencesBrowserTest methodsFor: 'configuration' stamp: 'avi 9/17/2005 01:43'! browserClass ^ OBReferencesBrowser! ! !OBReferencesBrowserTest methodsFor: 'configuration' stamp: 'dvf 8/31/2005 13:17'! node ^BogusC asNode! ! !OBReferencesBrowserTest methodsFor: 'bogus' stamp: 'cwp 12/1/2004 00:58'! refersToBogusC ^ BogusC! ! !OBReferencesBrowserTest methodsFor: 'tests' stamp: 'cwp 6/11/2009 20:11'! testClassNameSelection self select: 'OBReferencesBrowserTest>>node {configuration}'. self assertSelectedTextIs: 'BogusC'! ! !OBReferencesBrowserTest methodsFor: 'tests' stamp: 'cwp 11/30/2004 20:31'! testInitialDisplay self assertListAt: 1 contains: self bogusCReferences! ! !OBReferencesBrowserTest methodsFor: 'tests' stamp: 'cwp 6/11/2009 20:09'! testSelectorSelection self select: 'OBReferencesBrowserTest>>refersToBogusC {bogus}'. self deny: self textMorph getSelection = (9 to: 13)! ! OBBrowserTest subclass: #OBVersionsBrowserTest instanceVariableNames: 'oldSourcePointer' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBVersionsBrowserTest methodsFor: 'constants' stamp: 'cwp 11/27/2004 21:43'! expectedHeadings ^ #('BogusA>>two cwp 3/11/2004 20:07' 'BogusA>>two cwp 3/11/2004 20:06' 'BogusA>>two cwp 3/11/2004 20:06' 'BogusA>>two cwp 3/11/2004 20:07' 'BogusA>>two cwp 3/11/2004 20:06' 'BogusA>>two cwp 3/11/2004 20:06')! ! !OBVersionsBrowserTest methodsFor: 'running' stamp: 'avi 9/17/2005 01:11'! metagraph ^ OBVersionBrowser defaultMetaNode! ! !OBVersionsBrowserTest methodsFor: 'running' stamp: ''! node ^ OBMethodNode on: #two inClass: BogusA! ! !OBVersionsBrowserTest methodsFor: 'running' stamp: 'lr 3/4/2010 21:47'! setUp oldSourcePointer := (BogusA compiledMethodAt: #two) sourcePointer. (BogusA compiledMethodAt: #two) setSourcePointer: self twoSourcePointer. [OBVersionBrowser openOn: self node] on: OBBrowseRequest, OBSourceFilesRequest do: [:notification | notification isBrowseRequest ifTrue: [model := notification browser. widget := OBFakeBuilder build: model] ifFalse: [notification resume: self sourceFiles]]. self forceLayout ! ! !OBVersionsBrowserTest methodsFor: 'emulating' stamp: ''! sourceFiles ^ OBSourceFilesResource current sources! ! !OBVersionsBrowserTest methodsFor: 'running' stamp: 'lr 3/4/2010 21:46'! tearDown (BogusA compiledMethodAt: #two) setSourcePointer: oldSourcePointer! ! !OBVersionsBrowserTest methodsFor: 'testing' stamp: ''! testInitialDisplay self assertListAt: 1 contains: self expectedHeadings! ! !OBVersionsBrowserTest methodsFor: 'testing' stamp: 'cwp 11/27/2004 21:39'! testSourceDisplay self select: 'BogusA>>two cwp 3/11/2004 20:07'. self assertTextIs: self twoLatestVersionText! ! !OBVersionsBrowserTest methodsFor: 'constants' stamp: ''! twoLatestVersionText ^ 'two ^ 6' asText makeSelectorBold! ! !OBVersionsBrowserTest methodsFor: 'constants' stamp: ''! twoSourcePointer ^ 33555020! ! OBCommandTest subclass: #OBCategoryCommandTest instanceVariableNames: 'announcer organizer' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCategoryCommandTest class methodsFor: 'testing' stamp: 'cwp 11/2/2006 00:13'! isAbstract ^ self name == #OBCategoryCommandTest! ! !OBCategoryCommandTest methodsFor: 'emulating' stamp: 'cwp 9/28/2006 09:15'! announce: anObject ^ announcer announce: anObject! ! !OBCategoryCommandTest methodsFor: 'accessing' stamp: 'cwp 9/28/2006 09:17'! announcer ^ announcer! ! !OBCategoryCommandTest methodsFor: 'emulating' stamp: 'cwp 6/25/2006 17:38'! organization ^ organizer! ! !OBCategoryCommandTest methodsFor: 'emulating' stamp: 'cwp 5/31/2007 20:59'! selectedNode ^ self! ! !OBCategoryCommandTest methodsFor: 'emulating' stamp: 'lr 11/26/2010 11:57'! selection ^ 1! ! !OBCategoryCommandTest methodsFor: 'running' stamp: 'lr 11/7/2009 18:32'! setUp announcer := OBAnnouncer new. organizer := SystemOrganizer defaultList: #()! ! !OBCategoryCommandTest methodsFor: 'emulating' stamp: 'lr 8/4/2007 10:35'! theNonMetaClass ^ self! ! !OBCategoryCommandTest methodsFor: 'emulating' stamp: 'lr 9/22/2010 21:57'! withAllSuperclasses ^ #()! ! OBCategoryCommandTest subclass: #OBCmdAutoCategorizeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdAutoCategorizeTest methodsFor: 'running' stamp: 'cwp 11/2/2006 00:19'! factory ^OBCmdAutoCategorize! ! !OBCmdAutoCategorizeTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionRejectsClassCatNode | node | node := OBClassCategoryNode on: 'Foo' inEnvironment: self. self deny: (self isActiveOn: node for: self)! ! !OBCmdAutoCategorizeTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05ConditionRejectsMethodCatNode | node | node := OBMethodCategoryNode on: 'tests' inClass: self class. self deny: (self isActiveOn: node for: self)! ! !OBCmdAutoCategorizeTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test06ConditionRejectsEnvironmentNode | node | node := OBEnvironmentNode on: self. self deny: (self isActiveOn: node for: self)! ! !OBCmdAutoCategorizeTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test07ConditionAcceptsClassNode | node | node := OBClassNode on: self class. self assert: (self isActiveOn: node for: self)! ! !OBCmdAutoCategorizeTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test09Execution "Just execute the code to ensure there's nothing horribly wrong. Trying to assert that it classifies methods correctly would be a pain." | node | node := OBClassNode on: self class. self executeOn: node for: self! ! OBCategoryCommandTest subclass: #OBCmdCreateCategoryTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdCreateCategoryTest class methodsFor: 'testing' stamp: 'lr 9/22/2010 22:00'! isAbstract ^ self name = #OBCmdCreateCategoryTest! ! !OBCmdCreateCategoryTest methodsFor: 'support' stamp: 'lr 11/26/2010 11:58'! children ^ #()! ! OBCmdCreateCategoryTest subclass: #OBCmdCreateClassCategoryTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdCreateClassCategoryTest methodsFor: 'support' stamp: 'lr 9/22/2010 21:47'! factory ^OBCmdCreateClassCategory! ! !OBCmdCreateClassCategoryTest methodsFor: 'tests' stamp: 'lr 9/26/2010 19:07'! test08Execution | node | node := OBEnvironmentNode on: self. [ self executeOn: node for: self ] on: OBCompletionRequest do: [ :n | self assert: n prompt = 'Add Category'. self assert: n default isEmpty. self assert: n assisted. self assert: (n valuesFor: '') notEmpty. n resume: 'Test-Category' ]. self assert: (organizer categories includes: 'Test-Category')! ! OBCmdCreateCategoryTest subclass: #OBCmdCreateMethodCategoryTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdCreateMethodCategoryTest methodsFor: 'support' stamp: 'lr 9/22/2010 21:47'! factory ^OBCmdCreateMethodCategory! ! !OBCmdCreateMethodCategoryTest methodsFor: 'tests' stamp: 'lr 9/26/2010 19:07'! test08Execution | node | node := OBClassNode on: self. [ self executeOn: node for: self ] on: OBCompletionRequest do: [ :n | self assert: n prompt = 'Add Category'. self assert: n default isEmpty. self assert: n assisted. self assert: (n valuesFor: '') notEmpty. n resume: 'test-protocol' ]. self assert: (organizer categories includes: 'test-protocol')! ! OBCategoryCommandTest subclass: #OBCmdPromoteCategoriesTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdPromoteCategoriesTest methodsFor: 'accessing' stamp: 'Alexandre Bergel 7/1/2010 15:32'! browser ^ self! ! !OBCmdPromoteCategoriesTest methodsFor: 'support' stamp: 'lr 7/21/2010 08:41'! factory ^OBCmdPromoteCategories! ! !OBCmdPromoteCategoriesTest methodsFor: 'running' stamp: 'Alexandre Bergel 7/1/2010 15:40'! setUp super setUp. organizer addCategory: 'A'. organizer addCategory: 'A-A1'. organizer addCategory: 'A-B1'. organizer addCategory: 'B-B1'. organizer addCategory: 'C-C1'.! ! !OBCmdPromoteCategoriesTest methodsFor: 'tests' stamp: 'Alexandre Bergel 7/1/2010 15:45'! test02HasCorrectKeystroke self assert: self command keystroke isNil! ! !OBCmdPromoteCategoriesTest methodsFor: 'tests' stamp: 'Alexandre Bergel 7/1/2010 17:31'! test04ConditionAcceptsClassCatNode | node env | env := OBEnvironmentNode new. node := OBClassCategoryNode on: 'Foo' inEnvironment: self class environment. isSelected := true. self deny: (self isActiveOn: node for: self)! ! !OBCmdPromoteCategoriesTest methodsFor: 'tests' stamp: 'Alexandre Bergel 7/1/2010 15:57'! test05ConditionAcceptsMethodCatNode | node | node := OBMethodCategoryNode on: 'tests' inClass: self class. self deny: (self isActiveOn: node for: self)! ! !OBCmdPromoteCategoriesTest methodsFor: 'tests' stamp: 'Alexandre Bergel 7/1/2010 15:57'! test05ConditionRejectMethodCatNode | node | node := OBMethodCategoryNode on: 'tests' inClass: self class. self deny: (self isActiveOn: node for: self)! ! !OBCmdPromoteCategoriesTest methodsFor: 'tests' stamp: 'Alexandre Bergel 7/1/2010 15:55'! test06ConditionRejectsEnvironmentNode | node | node := OBEnvironmentNode on: organizer. self deny: (self isActiveOn: node for: self)! ! !OBCmdPromoteCategoriesTest methodsFor: 'tests' stamp: 'Alexandre Bergel 7/1/2010 15:55'! test07ConditionRejectsClassNode | node | node := OBClassNode on: self class. self deny: (self isActiveOn: node for: self)! ! !OBCmdPromoteCategoriesTest methodsFor: 'tests' stamp: 'Alexandre Bergel 7/1/2010 15:44'! test08ExecutionOnEnvironmentNode | node | node := OBEnvironmentNode on: self. [ self executeOn: node for: self ] on: OBTextRequest do: [ :n | self assert: n template = 'Package*'. n resume: 'Pack*' ]. "does nothing since there is no package matching Pack*" self assert: (organizer categories = #(#A #'A-A1' #'A-B1' #'B-B1' #'C-C1')). "We move C*" [ self executeOn: node for: self ] on: OBTextRequest do: [ :n | n resume: 'C*' ]. self assert: (organizer categories = #(#'C-C1' #A #'A-A1' #'A-B1' #'B-B1')). "We move A*" [ self executeOn: node for: self ] on: OBTextRequest do: [ :n | n resume: 'A*' ]. self assert: (organizer categories = #(#A #'A-A1' #'A-B1' #'C-C1' #'B-B1')). ! ! OBCategoryCommandTest subclass: #OBCmdRemoveCatTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdRemoveCatTest methodsFor: 'running' stamp: 'cwp 11/2/2006 00:23'! factory ^OBCmdRemoveCat! ! !OBCmdRemoveCatTest methodsFor: 'emulating' stamp: 'cwp 7/17/2006 13:50'! removeCategory: aSymbol organizer removeCategory: aSymbol! ! !OBCmdRemoveCatTest methodsFor: 'tests' stamp: 'cwp 9/28/2006 08:36'! test02HasCorrectKeystroke self assert: self command keystroke = $x.! ! !OBCmdRemoveCatTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionAcceptsClassCatNode | node | node := OBClassCategoryNode on: 'Foo' inEnvironment: self. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdRemoveCatTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05ConditionAcceptsMethodCatNode | node | node := OBMethodCategoryNode on: 'tests' inClass: self class. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdRemoveCatTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test06ConditionRejectsEnvironmentNode | node | node := OBEnvironmentNode on: organizer. self deny: (self isActiveOn: node for: self)! ! !OBCmdRemoveCatTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test07ConditionRejectsClassNode | node | node := OBClassNode on: self class. self deny: (self isActiveOn: node for: self)! ! !OBCmdRemoveCatTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test08ExecutionOnClassCatNode | node | organizer := SystemOrganizer defaultList: #(). organizer addCategory: 'Some-Category'. node := OBClassCategoryNode on: 'Some-Category' inEnvironment: self. self executeOn: node for: self. self deny: (organizer categories includes: 'Some-Category')! ! !OBCmdRemoveCatTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test09ExecutionOnMethodCatNode | node | organizer := ClassOrganizer defaultList: #(). organizer addCategory: #category. node := OBMethodCategoryNode on: #category inClass: self. self executeOn: node for: self. self deny: (organizer categories includes: #category)! ! OBCategoryCommandTest subclass: #OBCmdRemoveEmptyCatsTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdRemoveEmptyCatsTest methodsFor: 'emulating' stamp: 'cwp 8/20/2009 08:22'! browser ^ self! ! !OBCmdRemoveEmptyCatsTest methodsFor: 'support' stamp: 'cwp 11/2/2006 00:23'! factory ^OBCmdRemoveEmptyCats! ! !OBCmdRemoveEmptyCatsTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionRejectsClassCatNode | node | node := OBClassCategoryNode on: 'Foo' inEnvironment: self. self deny: (self isActiveOn: node for: self)! ! !OBCmdRemoveEmptyCatsTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05ConditionRejectsMethodCatNode | node | node := OBMethodCategoryNode on: 'tests' inClass: self class. self deny: (self isActiveOn: node for: self)! ! !OBCmdRemoveEmptyCatsTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test06ConditionAcceptsEnvironmentNode | node | node := OBEnvironmentNode on: self. self assert: (self isActiveOn: node for: self)! ! !OBCmdRemoveEmptyCatsTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test07ConditionAcceptsClassNode | node | node := OBClassNode on: self class. self assert: (self isActiveOn: node for: self)! ! !OBCmdRemoveEmptyCatsTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test08ExecutionOnEnvironmentNode | node | organizer := SystemOrganizer defaultList: #(). organizer addCategory: 'Empty'. organizer classify: #'not-a-class-name' under: 'NotEmpty'. node := OBEnvironmentNode on: self. self executeOn: node for: self. self deny: (organizer categories includes: 'Empty'). self assert: (organizer categories includes: 'NotEmpty')! ! !OBCmdRemoveEmptyCatsTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test09ExecutionOnClassNode | node | organizer := ClassOrganizer defaultList: #(). organizer addCategory: 'Empty'. organizer classify: #'not-a-selector' under: 'NotEmpty'. node := OBClassNode on: self. self executeOn: node for: self. self deny: (organizer categories includes: 'Empty'). self assert: (organizer categories includes: 'NotEmpty')! ! OBCategoryCommandTest subclass: #OBCmdRenameCategoryTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdRenameCategoryTest class methodsFor: 'as yet unclassified' stamp: 'lr 9/22/2010 22:01'! isAbstract ^ self name = #OBCmdRenameCategoryTest! ! !OBCmdRenameCategoryTest methodsFor: 'emulating' stamp: 'lr 9/22/2010 22:13'! allSuperclasses ^ #()! ! !OBCmdRenameCategoryTest methodsFor: 'emulating' stamp: 'lr 9/22/2010 22:13'! categories ^ #()! ! !OBCmdRenameCategoryTest methodsFor: 'emulating' stamp: 'lr 9/22/2010 22:13'! parent ^ self! ! !OBCmdRenameCategoryTest methodsFor: 'emulating' stamp: 'cwp 7/25/2006 17:54'! removeCategory: aSymbol organizer removeCategory: aSymbol! ! OBCmdRenameCategoryTest subclass: #OBCmdRenameClassCategoryTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdRenameClassCategoryTest methodsFor: 'running' stamp: 'lr 9/22/2010 22:01'! factory ^OBCmdRenameClassCategory! ! !OBCmdRenameClassCategoryTest methodsFor: 'tests' stamp: 'lr 9/22/2010 22:07'! test04ConditionAcceptsClassCatNode | node | node := OBClassCategoryNode on: 'Foo' inEnvironment: self. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdRenameClassCategoryTest methodsFor: 'tests' stamp: 'lr 9/22/2010 22:07'! test07ConditionRejectsClassNode | node | node := OBClassNode on: self class. self deny: (self isActiveOn: node for: self)! ! !OBCmdRenameClassCategoryTest methodsFor: 'tests' stamp: 'lr 9/22/2010 22:14'! test08ExecutionOnClassCatNode | node | organizer := SystemOrganizer defaultList: #(). organizer addCategory: 'Some-Category'. node := OBClassCategoryNode on: 'Some-Category' inEnvironment: self. [ self executeOn: node for: self ] on: OBCompletionRequest do: [ :n | self assert: n prompt = 'Rename Category'. self assert: n default = 'Some-Category'. self assert: n assisted. self assert: (n valuesFor: '') isEmpty. n resume: 'Test-Category' ]. self deny: (organizer categories includes: 'Some-Category'). self assert: (organizer categories includes: 'Test-Category')! ! OBCmdRenameCategoryTest subclass: #OBCmdRenameMethodCategoryTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdRenameMethodCategoryTest methodsFor: 'running' stamp: 'lr 9/22/2010 22:01'! factory ^OBCmdRenameMethodCategory! ! !OBCmdRenameMethodCategoryTest methodsFor: 'tests' stamp: 'lr 9/22/2010 22:04'! test05ConditionAcceptsMethodCatNode | node | node := OBMethodCategoryNode on: 'tests' inClass: self class. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdRenameMethodCategoryTest methodsFor: 'tests' stamp: 'lr 9/22/2010 22:04'! test06ConditionRejectsEnvironmentNode | node | node := OBEnvironmentNode on: self. self deny: (self isActiveOn: node for: self)! ! !OBCmdRenameMethodCategoryTest methodsFor: 'tests' stamp: 'lr 9/22/2010 22:14'! test09ExecutionOnMethodCatNode | node | organizer := ClassOrganizer defaultList: #(). organizer addCategory: #category. node := OBMethodCategoryNode on: #category inClass: self. [ self executeOn: node for: self ] on: OBCompletionRequest do: [ :n | self assert: n prompt = 'Rename Category'. self assert: n default = #category. self assert: n assisted. self assert: (n valuesFor: '') notEmpty. n resume: 'new name' ]. self deny: (organizer categories includes: #category). self assert: (organizer categories includes: #'new name')! ! OBCategoryCommandTest subclass: #OBCmdReorgCatTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdReorgCatTest methodsFor: 'support' stamp: 'cwp 11/2/2006 00:23'! factory ^OBCmdReorgCats! ! !OBCmdReorgCatTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionRejectsClassCatNode | node | node := OBClassCategoryNode on: 'Foo' inEnvironment: organizer. self deny: (self isActiveOn: node for: self)! ! !OBCmdReorgCatTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05ConditionRejectsMethodCatNode | node | node := OBMethodCategoryNode on: 'tests' inClass: self class. self deny: (self isActiveOn: node for: self)! ! !OBCmdReorgCatTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test06ConditionAcceptsEnvironmentNode | node | node := OBEnvironmentNode on: self. self assert: (self isActiveOn: node for: self)! ! !OBCmdReorgCatTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test07ConditionAcceptsClassNode | node | node := OBClassNode on: self class. self assert: (self isActiveOn: node for: self)! ! !OBCmdReorgCatTest methodsFor: 'tests' stamp: 'lr 12/3/2010 10:34'! test08ExecutionOnEnvironmentNode | ann node | ann := nil. self announcer on: OBDefinitionChanged do: [ :obj | ann := obj ]. node := OBEnvironmentNode on: self. self executeOn: node for: self. self deny: ann isNil! ! !OBCmdReorgCatTest methodsFor: 'tests' stamp: 'lr 12/3/2010 10:34'! test09ExecutionOnClassNode | ann node | ann := nil. self announcer on: OBDefinitionChanged do: [ :obj | ann := obj ]. node := OBClassNode on: self. self executeOn: node for: self. self deny: ann isNil! ! OBCommandTest subclass: #OBCmdBrowseHierarchyTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdBrowseHierarchyTest methodsFor: 'support' stamp: 'cwp 11/2/2006 00:21'! factory ^OBCmdBrowseHierarchy! ! !OBCmdBrowseHierarchyTest methodsFor: 'tests' stamp: 'dr 1/9/2008 14:54'! test02HasCorrectKeystroke self assert: self command keystroke notNil. self assert: self command keystroke = $h.! ! !OBCmdBrowseHierarchyTest methodsFor: 'tests' stamp: 'cwp 3/11/2007 19:47'! test03DoesntWantButton self assert: self command wantsButton! ! !OBCmdBrowseHierarchyTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionAcceptsClass | node | node := OBClassNode on: self class. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdBrowseHierarchyTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05ConditionIgnoresParentNode | node | node := OBClassNode on: self class. isSelected := false. self deny: (self isActiveOn: node for: self)! ! !OBCmdBrowseHierarchyTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test06OpensHierarchyBrowser | node browser | node := OBClassNode on: self class. [ self executeOn: node for: self ] on: OBBrowseRequest do: [ :req | browser := req browser ]. self assert: (browser isKindOf: OBHierarchyBrowser). self assert: browser root = node! ! OBCommandTest subclass: #OBCmdBrowseMethodVersionsTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdBrowseMethodVersionsTest methodsFor: 'support' stamp: 'cwp 11/2/2006 00:22'! factory ^OBCmdBrowseMethodVersions! ! !OBCmdBrowseMethodVersionsTest methodsFor: 'tests' stamp: 'cwp 10/9/2006 17:59'! test02HasCorrectKeystroke self assert: self command keystroke = $v! ! !OBCmdBrowseMethodVersionsTest methodsFor: 'tests' stamp: 'cwp 3/11/2007 19:50'! test03DoesntWantButton self assert: self command wantsButton! ! !OBCmdBrowseMethodVersionsTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionAcceptsMethod | node | node := OBMethodNode on: #setUp inClass: self class. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdBrowseMethodVersionsTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05OpensVersionsBrowser | node browser | node := OBMethodNode on: #test05OpensVersionsBrowser inClass: self class. [ self executeOn: node for: self ] on: OBBrowseRequest do: [ :req | browser := req browser ]. self assert: (browser isKindOf: OBVersionBrowser). self assert: browser root = node! ! OBCommandTest subclass: #OBCmdBrowseReferencesTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdBrowseReferencesTest methodsFor: 'support' stamp: 'cwp 12/7/2006 21:40'! factory ^ OBCmdBrowseReferences! ! !OBCmdBrowseReferencesTest methodsFor: 'tests' stamp: 'lr 8/3/2007 11:33'! test02HasCorrectKeystroke self assert: (self command keystroke = $N)! ! !OBCmdBrowseReferencesTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionAcceptsClass | node | node := OBClassNode on: self class. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdBrowseReferencesTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05ConditionIgnoresParentNode | node | node := OBClassNode on: self class. isSelected := false. self deny: (self isActiveOn: node for: self)! ! !OBCmdBrowseReferencesTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test06OpensBrowserOnClass | node browser | node := OBClassNode on: self class. [ self executeOn: node for: self ] on: OBBrowseRequest do: [ :req | browser := req browser ]. self assert: (browser isKindOf: OBReferencesBrowser). self assert: browser currentOrRootNode = node! ! !OBCmdBrowseReferencesTest methodsFor: 'tests' stamp: 'cwp 12/7/2006 22:30'! test07BelongsToNavigationGroup self assert: self command group = #navigation! ! OBCommandTest subclass: #OBCmdBrowseTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdBrowseTest methodsFor: 'support' stamp: 'lr 11/7/2009 18:32'! assertOpensOn: node | target | [ self executeOn: node for: self ] on: OBBrowseRequest do: [ :req | target := req browser currentOrRootNode ]. self assert: target = node! ! !OBCmdBrowseTest methodsFor: 'support' stamp: 'cwp 11/2/2006 00:22'! factory ^OBCmdBrowse! ! !OBCmdBrowseTest methodsFor: 'tests' stamp: 'cwp 10/9/2006 15:18'! test02HasCorrectKeystroke self assert: self command keystroke = $b! ! !OBCmdBrowseTest methodsFor: 'tests' stamp: 'cwp 3/11/2007 19:46'! test03DoesntWantButton self assert: self command wantsButton! ! !OBCmdBrowseTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionAcceptsClassCategory | node | node := OBClassCategoryNode on: self class category inEnvironment: self class environment. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdBrowseTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05ConditionAcceptsClass | node | node := OBClassNode on: self class. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdBrowseTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test06ConditionAcceptsMethodCategory | node | node := OBMethodCategoryNode on: 'tests' inClass: self class. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdBrowseTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test07ConditionAcceptsMethod | node | node := OBMethodNode on: #setUp inClass: self class. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdBrowseTest methodsFor: 'tests' stamp: 'cwp 10/9/2006 15:34'! test08OpensBrowserOnClassCategory self assertOpensOn: (OBClassCategoryNode on: self class category inEnvironment: self class environment)! ! !OBCmdBrowseTest methodsFor: 'tests' stamp: 'cwp 10/9/2006 15:33'! test09OpensBrowserOnClass self assertOpensOn: (OBClassNode on: self class)! ! !OBCmdBrowseTest methodsFor: 'tests' stamp: 'cwp 10/9/2006 15:36'! test10OpensBrowserOnMethodCategory self assertOpensOn: (OBMethodCategoryNode on: 'tests' inClass: self class)! ! !OBCmdBrowseTest methodsFor: 'tests' stamp: 'cwp 10/15/2006 21:04'! test11OpensBrowserOnMethod self assertOpensOn: (OBMethodNode on: #test11OpensBrowserOnMethod inClass: self class)! ! OBCommandTest subclass: #OBCmdChaseVarabiesTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdChaseVarabiesTest methodsFor: 'support' stamp: 'cwp 11/2/2006 00:22'! factory ^OBCmdChaseVariables! ! !OBCmdChaseVarabiesTest methodsFor: 'tests' stamp: 'cwp 3/11/2007 19:47'! test03DoesntWantButton self assert: self command wantsButton! ! !OBCmdChaseVarabiesTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionAcceptsClass | node | node := OBClassNode on: self class. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdChaseVarabiesTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05ConditionIgnoresParentNode | node | node := OBClassNode on: self class. isSelected := false. self deny: (self isActiveOn: node for: self)! ! !OBCmdChaseVarabiesTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test06ExecutionOpensBrowser | node browser | node := OBClassNode on: self class. [ self executeOn: node for: self ] on: OBBrowseRequest do: [ :req | browser := req browser ]. self assert: browser root = node! ! OBCommandTest subclass: #OBCmdClassTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdClassTest class methodsFor: 'testing' stamp: 'cwp 11/2/2006 22:40'! isAbstract ^ self name = #OBCmdClassTest! ! !OBCmdClassTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionAcceptsClass | node | isSelected := true. node := OBClassNode on: self class. self assert: (self isActiveOn: node for: self)! ! !OBCmdClassTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05ConditionRequiresSelection | node | isSelected := false. node := OBClassNode on: self class. self deny: (self isActiveOn: node for: self)! ! OBCmdClassTest subclass: #OBCmdCopyClassTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdCopyClassTest methodsFor: 'support' stamp: 'cwp 11/2/2006 20:05'! factory ^ OBCmdCopyClass! ! OBCmdClassTest subclass: #OBCmdRemoveClassTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdRemoveClassTest methodsFor: 'support' stamp: 'cwp 11/3/2006 00:10'! factory ^ OBCmdRemoveClass! ! !OBCmdRemoveClassTest methodsFor: 'tests' stamp: 'cwp 11/3/2006 00:17'! test02HasCorrectKeystroke self assert: self command keystroke = $x! ! OBCmdClassTest subclass: #OBCmdRenameClassTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdRenameClassTest methodsFor: 'support' stamp: 'cwp 11/2/2006 22:46'! factory ^ OBCmdRenameClass! ! OBCommandTest subclass: #OBCmdFileOutTest instanceVariableNames: 'fileOutSent' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdFileOutTest methodsFor: 'support' stamp: 'cwp 11/2/2006 00:22'! factory ^OBCmdFileOut! ! !OBCmdFileOutTest methodsFor: 'support' stamp: 'lr 11/7/2009 18:32'! fileOut fileOutSent := true! ! !OBCmdFileOutTest methodsFor: 'support' stamp: 'cwp 10/7/2006 11:29'! selectedNode ^ nil! ! !OBCmdFileOutTest methodsFor: 'tests' stamp: 'cwp 6/11/2009 17:07'! test02HasCorrectKeystroke self assert: self command keystroke = $o! ! !OBCmdFileOutTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionTestsForFileOutMethod | node | node := Object new. self deny: (self isActiveOn: node for: self)! ! !OBCmdFileOutTest methodsFor: 'tests' stamp: 'cwp 10/7/2006 11:31'! test05ActionSendsFileOut self executeOn: self for: self. self assert: fileOutSent! ! !OBCmdFileOutTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test06ConditionRejectsParentNode isSelected := false. self deny: (self isActiveOn: self for: self)! ! OBCommandTest subclass: #OBCmdFindClassTest instanceVariableNames: 'found' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdFindClassTest methodsFor: 'support' stamp: 'lr 12/3/2010 10:34'! announcer | announcer | announcer := OBAnnouncer new. announcer on: OBSelectingNode do: [ :ann | found := ann node theClass ]. ^ announcer! ! !OBCmdFindClassTest methodsFor: 'emulating' stamp: 'lr 8/3/2007 11:34'! classNames ^ #('BravoCharlie' 'AlphaBravoCharlie' 'Bravo' 'AlphaCharlie') asSortedCollection! ! !OBCmdFindClassTest methodsFor: 'support' stamp: 'cwp 11/2/2006 00:22'! factory ^OBCmdFindClass! ! !OBCmdFindClassTest methodsFor: 'tests' stamp: 'cwp 10/9/2006 13:38'! test02HasCorrectKeystroke self assert: self command keystroke = $f.! ! !OBCmdFindClassTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionAcceptsEnvironmentNode | node | node := OBEnvironmentNode forImage. self assert: (self isActiveOn: node for: self)! ! !OBCmdFindClassTest methodsFor: 'tests' stamp: 'lr 9/22/2010 14:12'! test05FindsClassFromExactName | node | node := OBEnvironmentNode forImage. [ self executeOn: node for: self ] on: OBCompletionRequest do: [ :req | req resume: self class ]. self assert: found = self class! ! !OBCmdFindClassTest methodsFor: 'emulating' stamp: 'lr 8/3/2007 11:47'! traitNames ^ #()! ! OBCommandTest subclass: #OBCmdFindMethodTest instanceVariableNames: 'handler' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdFindMethodTest methodsFor: 'support' stamp: 'lr 12/3/2010 10:34'! announcer ^ OBAnnouncer new on: OBAnnouncement do: handler; yourself! ! !OBCmdFindMethodTest methodsFor: 'support' stamp: 'cwp 6/11/2009 18:33'! factory ^ OBCmdFindMethod! ! !OBCmdFindMethodTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionAcceptsClass | node | isSelected := true. node := OBClassNode on: self class. self assert: (self isActiveOn: node for: self)! ! !OBCmdFindMethodTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05ConditionTargetToBeSelected | node | node := OBClassNode on: self class. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdFindMethodTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test06ActionFindsExistingSelectors | node choice | node := OBClassNode on: self class. [ self executeOn: node for: self ] on: OBChoiceRequest do: [ :req | choice := req ]. self deny: choice isNil. self assert: (choice labels includesAllOf: self class selectors)! ! !OBCmdFindMethodTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test07ActionOpensBrowser | node selector announcement | handler := [ :ann | announcement := ann ]. node := OBClassNode on: self class. [ self executeOn: node for: self ] on: OBChoiceRequest do: [ :choice | selector := choice labels first. choice select: choice labels first ]. self deny: selector isNil. self assert: announcement node selector = selector! ! OBCommandTest subclass: #OBCmdRemoveMethodTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdRemoveMethodTest methodsFor: 'support' stamp: 'cwp 12/8/2006 23:16'! factory ^ OBCmdRemoveMethod! ! !OBCmdRemoveMethodTest methodsFor: 'tests' stamp: 'cwp 12/8/2006 23:17'! test02HasCorrectKeystroke self assert: self command keystroke = $x! ! !OBCmdRemoveMethodTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionAcceptsMethod | node | isSelected := true. node := OBMethodNode on: #test04ConditionAcceptsMethod inClass: self class. self assert: (self isActiveOn: node for: self)! ! !OBCmdRemoveMethodTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05ConditionRequiresSelection | node | isSelected := false. node := OBMethodNode on: #test04ConditionAcceptsMethod inClass: self class. self deny: (self isActiveOn: node for: self)! ! OBCommandTest subclass: #OBCmdRevertMethodTest instanceVariableNames: 'fileInSent' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdRevertMethodTest methodsFor: 'support' stamp: 'cwp 11/2/2006 00:23'! factory ^OBCmdRevertMethod! ! !OBCmdRevertMethodTest methodsFor: 'emulating' stamp: 'lr 3/12/2010 10:42'! fileIn: aClass fileInSent := true! ! !OBCmdRevertMethodTest methodsFor: 'tests' stamp: 'cwp 10/9/2006 18:26'! test02HasCorrectKeystroke self assert: self command keystroke = $r! ! !OBCmdRevertMethodTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionAcceptsMethodVersion | node | node := OBMethodVersionNode on: self. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdRevertMethodTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05ExecutionSendsFileIn | node | node := OBMethodVersionNode on: self. self executeOn: node for: self. self assert: fileInSent! ! !OBCmdRevertMethodTest methodsFor: 'emulating' stamp: 'cwp 10/9/2006 18:31'! theClass ^ self class! ! OBCommandTest subclass: #OBCmdSelectorNodeTest instanceVariableNames: 'announcer' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! OBCmdSelectorNodeTest subclass: #OBCmdBrowseHierarchyImplementorsTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdBrowseHierarchyImplementorsTest methodsFor: 'as yet unclassified' stamp: 'lr 9/23/2010 11:58'! expectedAnnouncement ^ OBShowHierarchyImplementors! ! !OBCmdBrowseHierarchyImplementorsTest methodsFor: 'as yet unclassified' stamp: 'lr 9/23/2010 11:58'! expectedBrowser ^ OBImplementorsBrowser! ! !OBCmdBrowseHierarchyImplementorsTest methodsFor: 'as yet unclassified' stamp: 'lr 9/23/2010 11:59'! factory ^OBCmdBrowseHierarchyImplementors! ! !OBCmdBrowseHierarchyImplementorsTest methodsFor: 'support' stamp: 'lr 9/23/2010 12:51'! theClass ^ self class! ! OBCmdSelectorNodeTest subclass: #OBCmdBrowseHierarchySendersTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdBrowseHierarchySendersTest methodsFor: 'as yet unclassified' stamp: 'lr 9/23/2010 11:58'! expectedAnnouncement ^ OBShowHierarchySenders! ! !OBCmdBrowseHierarchySendersTest methodsFor: 'as yet unclassified' stamp: 'lr 9/23/2010 11:58'! expectedBrowser ^ OBSendersBrowser! ! !OBCmdBrowseHierarchySendersTest methodsFor: 'as yet unclassified' stamp: 'lr 9/23/2010 11:59'! factory ^OBCmdBrowseHierarchySenders! ! !OBCmdBrowseHierarchySendersTest methodsFor: 'support' stamp: 'lr 9/23/2010 12:51'! theClass ^ self class! ! OBCmdSelectorNodeTest subclass: #OBCmdBrowseImplementorsTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdBrowseImplementorsTest methodsFor: 'support' stamp: 'cwp 8/20/2007 22:57'! expectedAnnouncement ^ OBShowImplementors! ! !OBCmdBrowseImplementorsTest methodsFor: 'support' stamp: 'cwp 10/17/2006 21:19'! expectedBrowser ^ OBImplementorsBrowser! ! !OBCmdBrowseImplementorsTest methodsFor: 'support' stamp: 'cwp 11/2/2006 00:21'! factory ^OBCmdBrowseImplementors! ! !OBCmdBrowseImplementorsTest methodsFor: 'tests' stamp: 'cwp 10/15/2006 21:14'! test02HasCorrectKeystroke self assert: (self command keystroke = $m)! ! !OBCmdBrowseImplementorsTest methodsFor: 'tests' stamp: 'cwp 3/11/2007 19:49'! test03DoesntWantButton self assert: self command wantsButton! ! !OBCmdBrowseImplementorsTest methodsFor: 'support' stamp: 'cwp 10/15/2006 20:23'! theClass ^ self class! ! OBCmdSelectorNodeTest subclass: #OBCmdBrowseInheritanceTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdBrowseInheritanceTest methodsFor: 'support' stamp: 'cwp 10/17/2006 21:19'! expectedBrowser ^ OBInheritanceBrowser! ! !OBCmdBrowseInheritanceTest methodsFor: 'support' stamp: 'cwp 11/2/2006 00:22'! factory ^OBCmdBrowseInheritance! ! !OBCmdBrowseInheritanceTest methodsFor: 'support' stamp: 'cwp 8/21/2007 00:27'! rootNode ^ OBMethodNode on: #setUp inClass: TestCase! ! !OBCmdBrowseInheritanceTest methodsFor: 'tests' stamp: 'cwp 3/11/2007 19:48'! test03DoesntWantButton self assert: self command wantsButton! ! !OBCmdBrowseInheritanceTest methodsFor: 'tests' stamp: 'cwp 8/22/2007 22:29'! test09ExecutionTriggersAnnouncement ! ! !OBCmdBrowseInheritanceTest methodsFor: 'support' stamp: 'cwp 10/17/2006 21:10'! theClass ^ self class! ! OBCmdSelectorNodeTest subclass: #OBCmdBrowseSendersTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdBrowseSendersTest methodsFor: 'support' stamp: 'cwp 8/20/2007 22:58'! expectedAnnouncement ^ OBShowSenders! ! !OBCmdBrowseSendersTest methodsFor: 'support' stamp: 'cwp 10/17/2006 21:19'! expectedBrowser ^ OBSendersBrowser! ! !OBCmdBrowseSendersTest methodsFor: 'support' stamp: 'cwp 11/2/2006 00:22'! factory ^OBCmdBrowseSenders! ! !OBCmdBrowseSendersTest methodsFor: 'tests' stamp: 'cwp 10/15/2006 21:01'! test02HasCorrectKeystroke self assert: (self command keystroke = $n)! ! !OBCmdBrowseSendersTest methodsFor: 'tests' stamp: 'cwp 3/11/2007 19:48'! test03DoesntWantButton self assert: self command wantsButton! ! !OBCmdBrowseSendersTest methodsFor: 'support' stamp: 'cwp 10/11/2006 20:59'! theClass ^ self class! ! !OBCmdSelectorNodeTest class methodsFor: 'testing' stamp: 'cwp 11/2/2006 00:14'! isAbstract ^ self name = #OBCmdSelectorNodeTest ! ! !OBCmdSelectorNodeTest methodsFor: 'support' stamp: 'cwp 8/20/2007 22:22'! announce: anObject ^ announcer announce: anObject! ! !OBCmdSelectorNodeTest methodsFor: 'support' stamp: 'cwp 8/20/2007 22:54'! expectedAnnouncement self subclassResponsibility ! ! !OBCmdSelectorNodeTest methodsFor: 'support' stamp: 'cwp 10/17/2006 21:19'! expectedBrowser self subclassResponsibility ! ! !OBCmdSelectorNodeTest methodsFor: 'support' stamp: 'lr 9/23/2010 11:57'! rootNode ^ OBMethodNode on: #setUp inClass: self class! ! !OBCmdSelectorNodeTest methodsFor: 'running' stamp: 'lr 11/7/2009 18:32'! setUp announcer := OBAnnouncer new! ! !OBCmdSelectorNodeTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionAcceptsMethod | node | isSelected := true. node := OBMethodNode on: #setUp inClass: self class. self assert: (self isActiveOn: node for: self)! ! !OBCmdSelectorNodeTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05ConditionAcceptsMethodVersion | node | isSelected := true. node := OBMethodVersionNode on: self. self assert: (self isActiveOn: node for: self)! ! !OBCmdSelectorNodeTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test06ConditionAcceptsSelector | node | isSelected := true. node := OBSelectorNode on: #setUp. self assert: (self isActiveOn: node for: self)! ! !OBCmdSelectorNodeTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test07ConditionRejectsParent | node | isSelected := false. node := OBSelectorNode on: #setUp. self deny: (self isActiveOn: node for: self)! ! !OBCmdSelectorNodeTest methodsFor: 'tests' stamp: 'lr 9/23/2010 08:37'! test08ExecutionOpensChasingBrowser | node browser | node := self rootNode. [ [ self executeOn: node for: self ] on: OBCompletionRequest do: [ :req | req resume: req default ] ] on: OBBrowseRequest do: [ :req | browser := req browser ]. self assert: (browser isKindOf: self expectedBrowser). self assert: browser currentOrRootNode = node! ! !OBCmdSelectorNodeTest methodsFor: 'tests' stamp: 'lr 12/3/2010 10:34'! test09ExecutionTriggersAnnouncement | node ann | node := self rootNode. announcer on: OBNavigate do: [ :arg | ann := arg. ann bid: 1 toDo: [ ] ]. [ self executeOn: node for: self ] on: OBCompletionRequest do: [ :n | n resume: n default ]. self assert: (ann isKindOf: self expectedAnnouncement). self assert: ann fan parent = node. self assert: ann fan children size >= 1! ! OBCommandTest subclass: #OBCmdSubclassTemplateTest instanceVariableNames: 'handler' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdSubclassTemplateTest methodsFor: 'support' stamp: 'cwp 12/7/2006 23:28'! announce: anAnnouncement handler value: anAnnouncement! ! !OBCmdSubclassTemplateTest methodsFor: 'support' stamp: 'cwp 12/7/2006 23:04'! factory ^ OBCmdSubclassTemplate! ! !OBCmdSubclassTemplateTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test04ConditionAcceptsClass | node | node := OBClassNode on: self class. isSelected := true. self assert: (self isActiveOn: node for: self)! ! !OBCmdSubclassTemplateTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05ConditionIgnoresParentNode | node | node := OBClassNode on: self class. isSelected := false. self deny: (self isActiveOn: node for: self)! ! !OBCmdSubclassTemplateTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test06ChangesDefinition | ann node | handler := [ :arg | ann := arg ]. node := OBClassNode on: self class. self executeOn: node for: self. self assert: (ann isKindOf: OBDefinitionChanged). self assert: (ann definition text beginsWith: self class name)! ! OBCommandTest subclass: #OBCmdTextualTest instanceVariableNames: 'announcer' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! OBCmdTextualTest subclass: #OBCmdBrowseImplementorsOfItTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdBrowseImplementorsOfItTest methodsFor: 'support' stamp: 'cwp 8/24/2007 01:37'! announcementClass ^ OBShowImplementors! ! !OBCmdBrowseImplementorsOfItTest methodsFor: 'support' stamp: 'cwp 10/16/2006 21:41'! browserClass ^ OBImplementorsBrowser! ! !OBCmdBrowseImplementorsOfItTest methodsFor: 'support' stamp: 'cwp 11/2/2006 00:21'! factory ^OBCmdBrowseImplementorsOfIt! ! !OBCmdBrowseImplementorsOfItTest methodsFor: 'tests' stamp: 'cwp 10/16/2006 21:44'! test02HasCorrectKeystroke self assert: (self command keystroke = $m)! ! OBCmdTextualTest subclass: #OBCmdBrowseSendersOfItTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCmdBrowseSendersOfItTest methodsFor: 'support' stamp: 'cwp 8/24/2007 00:24'! announcementClass ^ OBShowSenders! ! !OBCmdBrowseSendersOfItTest methodsFor: 'support' stamp: 'cwp 10/16/2006 21:41'! browserClass ^ OBSendersBrowser! ! !OBCmdBrowseSendersOfItTest methodsFor: 'support' stamp: 'cwp 11/2/2006 00:22'! factory ^OBCmdBrowseSendersOfIt! ! !OBCmdBrowseSendersOfItTest methodsFor: 'tests' stamp: 'cwp 10/16/2006 21:44'! test02HasCorrectKeystroke self assert: (self command keystroke = $n)! ! !OBCmdTextualTest class methodsFor: 'testing' stamp: 'cwp 11/2/2006 00:14'! isAbstract ^ self name = #OBCmdTextualTest! ! !OBCmdTextualTest methodsFor: 'running' stamp: 'cwp 8/24/2007 00:23'! announce: anObject ^ announcer announce: anObject! ! !OBCmdTextualTest methodsFor: 'support' stamp: 'lr 2/7/2010 10:22'! announcementClass self subclassResponsibility! ! !OBCmdTextualTest methodsFor: 'support' stamp: 'lr 2/7/2010 10:22'! browserClass self subclassResponsibility! ! !OBCmdTextualTest methodsFor: 'running' stamp: 'lr 11/7/2009 18:32'! setUp announcer := OBAnnouncer new! ! !OBCmdTextualTest methodsFor: 'tests' stamp: 'cwp 10/16/2006 21:12'! test04ConditionAlwaysAnswersTrue self assert: (self isActiveOn: nil for: nil)! ! !OBCmdTextualTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test05EnabledIfSelectorPresent | selection text | text := 'setUp'. selection := OBTextSelection on: (1 to: text size) inText: text. self assert: (self isEnabledOn: selection for: self)! ! !OBCmdTextualTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! test06DisabledIfSelectorNotPresent | selection | selection := OBTextSelection on: (1 to: 3) inText: '234'. self deny: (self isEnabledOn: selection for: self)! ! !OBCmdTextualTest methodsFor: 'tests' stamp: 'cwp 10/16/2006 21:21'! test07ExecutionOpensChasingBrowser | browser selection | selection := OBTextSelection onAllOf: 'setUp'. [self executeOn: selection for: self] on: OBBrowseRequest do: [:req | browser := req browser]. self assert: (browser isKindOf: self browserClass). self assert: browser root = (OBSelectorNode on: #setUp)! ! !OBCmdTextualTest methodsFor: 'tests' stamp: 'cwp 11/1/2006 22:38'! test08TakesText self assert: self factory takesText! ! !OBCmdTextualTest methodsFor: 'tests' stamp: 'cwp 11/1/2006 22:38'! test09DoesntTakeNodes self deny: self factory takesNodes! ! !OBCmdTextualTest methodsFor: 'tests' stamp: 'lr 12/3/2010 10:34'! test10ExecutionSendsAnnouncement | selection ann | announcer on: OBNavigate do: [ :a | ann := a. a bid: 1 toDo: [ ] ]. selection := OBTextSelection onAllOf: 'setUp'. self shouldnt: [ self executeOn: selection for: self ] raise: OBBrowseRequest. self assert: (ann isKindOf: self announcementClass). self assert: ann fan parent selector = #setUp! ! OBOpenTest subclass: #OBStandardOpenTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBStandardOpenTest class methodsFor: 'accessing' stamp: 'lr 3/14/2010 09:10'! packageNamesUnderTest ^ #('OB-Standard')! ! !OBStandardOpenTest methodsFor: 'tests' stamp: 'avi 9/17/2005 01:29'! testListBrowseRoot self open: [OBSendersBrowser browseRoot: (OBMethodNode on: #one inClass: BogusA)]. self assert: browser navigationPanel minPanes = 1. self assert: browser navigationPanel maxPanes = 2. self assert: browser currentNode isNil! ! !OBStandardOpenTest methodsFor: 'tests' stamp: 'avi 9/17/2005 01:37'! testListBrowseRootTitle self open: [OBSendersBrowser browseRoot: (OBMethodNode on: #one inClass: BogusA) title: 'My senders of']. self assert: browser navigationPanel minPanes = 1. self assert: browser navigationPanel maxPanes = 2. self assert: browser currentNode isNil. self assert: browser defaultLabel = 'My senders of #one'! ! !OBStandardOpenTest methodsFor: 'tests' stamp: 'lr 1/15/2010 09:50'! testSystemOpen self open: [ OBSystemBrowser open ]. self assert: browser navigationPanel minPanes = 4. self assert: browser navigationPanel maxPanes = 4. self assert: browser currentNode isNil! ! !OBStandardOpenTest methodsFor: 'tests' stamp: 'cwp 12/5/2004 18:31'! testSystemOpenOnClass self open: [OBSystemBrowser openOnClass: BogusA]. self assert: browser navigationPanel minPanes = 4. self assert: browser navigationPanel maxPanes = 4. self assert: browser currentNode name = #BogusA! ! !OBStandardOpenTest methodsFor: 'tests' stamp: 'cwp 12/5/2004 17:44'! testSystemOpenOnClassSelector self open: [OBSystemBrowser openOnClass: BogusA selector: #one]. self assert: browser navigationPanel minPanes = 4. self assert: browser navigationPanel maxPanes = 4. self assert: browser currentNode name = #one! ! !OBStandardOpenTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testVersionsOpenOn | root | root := OBMethodNode on: #testVersionsOpenOn inClass: self class. self open: [ OBVersionBrowser openOn: root ]. self assert: browser navigationPanel minPanes = 1. self assert: browser navigationPanel maxPanes = 1. self deny: browser currentNode isNil. self assert: browser root = root! ! BogusTestCase subclass: #OBBogusTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBBogusTest class methodsFor: 'testing' stamp: 'lr 2/7/2010 10:22'! isAbstract ^ self name = #OBBogusTest! ! !OBBogusTest methodsFor: 'support' stamp: 'cwp 12/9/2006 18:58'! execute: factory on: target for: requestor | command | command := factory on: target for: requestor. ^command execute! ! OBBogusTest subclass: #OBClassCommandTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBClassCommandTest methodsFor: 'support' stamp: 'cwp 11/2/2006 23:45'! announcer ^ OBAnnouncer new! ! !OBClassCommandTest methodsFor: 'asserting' stamp: 'cwp 11/2/2006 21:06'! assertCorrectBrowser: aBrowser self assert: (aBrowser isKindOf: OBListBrowser)! ! !OBClassCommandTest methodsFor: 'support' stamp: 'lr 1/28/2010 15:08'! classBNode ^(Smalltalk at: #BogusB) asNode! ! !OBClassCommandTest methodsFor: 'support' stamp: 'cwp 11/2/2006 21:06'! classFNode ^(Smalltalk at: #BogusF) asNode! ! !OBClassCommandTest methodsFor: 'emulating' stamp: 'cwp 11/2/2006 21:06'! definition: aDefinition self assert: aDefinition notNil. self assert: aDefinition text = self subclassTemplate. ! ! !OBClassCommandTest methodsFor: 'constants' stamp: 'cwp 11/2/2006 21:06'! nodeLabels ^ #('remove' 'rename...' 'copy...' 'subclass template')! ! !OBClassCommandTest methodsFor: 'constants' stamp: 'cwp 11/2/2006 21:06'! ownClassNode ^(Smalltalk at: self class name) asNode! ! !OBClassCommandTest methodsFor: 'constants' stamp: 'cwp 11/2/2006 21:06'! parentLabels ^ #()! ! !OBClassCommandTest methodsFor: 'constants' stamp: 'cwp 11/2/2006 21:06'! subclassTemplate ^ 'BogusA subclass: #NameOfSubclass instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: ''Bogus-Base'''! ! !OBClassCommandTest methodsFor: 'tests' stamp: 'djr 3/30/2010 13:00'! testCopy | node classB classX | self assert: (Smalltalk classNamed: #BogusX) isNil. damage add: #Definition ofClass: #BogusB. damage add: #Definition ofClass: #BogusX. node := self classBNode. [ self execute: OBCmdCopyClass on: node for: self ] on: OBTextRequest do: [ :n | n resume: 'BogusX' ]. classB := Smalltalk classNamed: #BogusB. classX := Smalltalk classNamed: #BogusX. self assert: classB notNil. self assert: classX notNil. self deny: classB == classX. self assert: classB category = classX category. self assert: classB selectors asSortedCollection = classX selectors asSortedCollection. self assert: classB instVarNames = classX instVarNames. self assert: classB classVarNames = classX classVarNames. self assert: classB poolDictionaryNames = classX poolDictionaryNames. self assert: classB class selectors = classX class selectors. self assert: classB class instVarNames = classX class instVarNames! ! !OBClassCommandTest methodsFor: 'tests' stamp: 'cwp 11/3/2006 00:12'! testRemove damage add: #Definition ofClass: #BogusF. [self execute: OBCmdRemoveClass on: self classFNode for: self] on: OBConfirmationRequest do: [:n | n resume: true]. self deny: (Smalltalk hasClassNamed: #BogusF)! ! !OBClassCommandTest methodsFor: 'tests' stamp: 'cwp 11/2/2006 23:46'! testRename damage addRenameOf: #BogusF to: #BogusX. [self execute: OBCmdRenameClass on: self classFNode for: self] on: OBInteractionRequest do: [:n | n resume: 'BogusX']. self deny: (Smalltalk hasClassNamed: #BogusF). self assert: (Smalltalk hasClassNamed: #BogusX)! ! !OBClassCommandTest methodsFor: 'tests' stamp: 'cwp 11/2/2006 23:52'! testRenameNoReferences | newName | newName := self class name, 'X'. damage addRenameOf: self class name to: newName asSymbol. self shouldnt: [[self execute: OBCmdRenameClass on: self class asNode for: self] on: OBTextRequest do: [:n | n resume: newName]] raise: OBBrowseRequest. ! ! !OBClassCommandTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testRenamedReferences | raised node | damage addRenameOf: #BogusA to: #BogusX. node := (Smalltalk at: #BogusA) asNode. raised := false. [ self execute: OBCmdRenameClass on: node for: self ] on: OBTextRequest , OBBrowseRequest do: [ :n | n isBrowseRequest ifTrue: [ self assertCorrectBrowser: n browser. raised := true ] ifFalse: [ n resume: 'BogusX' ] ]. self assert: raised! ! OBBogusTest subclass: #OBClassCommentDefinitionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBClassCommentDefinitionTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testAccept | defn | defn := OBClassCommentDefinition on: BogusA. damage add: #Comment ofClass: #BogusA. self assert: (defn accept: 'Changed comment' notifying: self). self assert: BogusA comment = 'Changed comment'! ! !OBClassCommentDefinitionTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testText | defn | defn := OBClassCommentDefinition on: BogusA. self assert: defn text = BogusInfo aComment! ! OBBogusTest subclass: #OBMethodCommandTest instanceVariableNames: 'handler' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBMethodCommandTest methodsFor: 'requestor' stamp: 'cwp 12/9/2006 19:55'! announce: anObject handler value: anObject! ! !OBMethodCommandTest methodsFor: 'emulating' stamp: 'cwp 6/11/2009 15:27'! previous ^ nil! ! !OBMethodCommandTest methodsFor: 'tests' stamp: 'cwp 12/9/2006 20:29'! remove: node self remove: node selecting: 'Remove it'! ! !OBMethodCommandTest methodsFor: 'tests' stamp: 'cwp 12/9/2006 20:29'! remove: node selecting: aString damage add: node selector ofClass: node class name. [self execute: OBCmdRemoveMethod on: node for: self] on: OBChoiceRequest do: [:n | n select: aString]. ! ! !OBMethodCommandTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! setUp super setUp. handler := [ :obj | ]! ! !OBMethodCommandTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testAsksForConfirmationWhenSendersExist | node request | node := OBMethodNode on: #a inClass: BogusA. [ self execute: OBCmdRemoveMethod on: node for: self ] on: OBChoiceRequest do: [ :obj | request := obj ]. self deny: request isNil. self assert: (request prompt beginsWith: 'This message has'). self assert: (request prompt endsWith: 'senders.'). self assert: request labels = #('Remove it' 'Remove, then browse senders' 'Don''t remove, but show me those senders' 'Forget it -- do nothing -- sorry I asked')! ! !OBMethodCommandTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testBrowseSenders | node request | node := OBMethodNode on: #a inClass: BogusA. [ self remove: node selecting: 'Don''t remove, but show me those senders' ] on: OBInteractionRequest do: [ :obj | request := obj ]. self deny: request isNil. self assert: (request isKindOf: OBBrowseRequest). self assert: request browser currentOrRootNode = node! ! !OBMethodCommandTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testDoNothing | node | node := OBMethodNode on: #a inClass: BogusA. [ self remove: node selecting: 'Forget it -- do nothing -- sorry I asked' ] on: OBInteractionRequest do: [ :obj | self assert: false ]! ! !OBMethodCommandTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testRemovalAnnounced | node ann | damage add: #a ofClass: #BogusA. handler := [ :obj | ann := obj ]. node := OBMethodNode on: #a inClass: BogusA. self remove: node. self deny: ann isNil. self assert: (ann isKindOf: OBNodeDeleted). self assert: ann node = node! ! !OBMethodCommandTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testRemoveAndBrowseSenders | node request | damage add: #a ofClass: #BogusA. node := OBMethodNode on: #a inClass: BogusA. [ self remove: node selecting: 'Remove, then browse senders' ] on: OBInteractionRequest do: [ :obj | request := obj ]. self deny: request isNil. self assert: (request isKindOf: OBBrowseRequest). self assert: request browser currentOrRootNode = node! ! !OBMethodCommandTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testRemoveAndBrowseSendersRemoval | node | damage add: #a ofClass: #BogusA. node := OBMethodNode on: #a inClass: BogusA. [ self remove: node selecting: 'Remove, then browse senders' ] on: OBInteractionRequest do: [ :obj | obj resume ]. self deny: (BogusA includesSelector: #a)! ! !OBMethodCommandTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testRemoveMethod | node | damage add: #a ofClass: #BogusA. node := OBMethodNode on: #a inClass: BogusA. self remove: node. self deny: (BogusA includesSelector: #a)! ! !OBMethodCommandTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testRemoveMethodConfirmed | node | damage add: #a ofClass: #BogusA. node := OBMethodNode on: #a inClass: BogusA. [ self remove: node ] on: OBInteractionRequest do: [ :req | self assert: false ]. self deny: (BogusA includesSelector: #a)! ! !OBMethodCommandTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testRemoveMethodNoInteraction | node selector | selector := 'bogusUnsentSelector' asSymbol. damage add: selector ofClass: #BogusA. node := OBMethodNode on: selector inClass: BogusA. [ self execute: OBCmdRemoveMethod on: node for: self ] on: OBInteractionRequest do: [ :req | self assert: false ]. self deny: (BogusA includesSelector: selector)! ! BogusTestCase subclass: #OBOrganizationDefinitionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBOrganizationDefinitionTest methodsFor: 'constants' stamp: 'cwp 9/22/2004 22:08'! definition ^ OBOrganizationDefinition on: BogusA organization! ! !OBOrganizationDefinitionTest methodsFor: 'constants' stamp: 'lr 11/26/2010 12:06'! newOrgText ^ '(''alphanum'' a b five one three two) (''other'' bogusHopefullyUniqueSelector bogusOtherUniqueSelector bogusUnsentSelector isString) (''*bogusext'' foo) (''*bogusext-testing'' isFake) (''letters'') '! ! !OBOrganizationDefinitionTest methodsFor: 'constants' stamp: 'lr 11/26/2010 12:06'! orgText ^ '(''*bogusext'' foo) (''*bogusext-testing'' isFake) (''letters'' a b) (''numbers'' five one three two) (''other'' bogusHopefullyUniqueSelector bogusOtherUniqueSelector bogusUnsentSelector isString) '! ! !OBOrganizationDefinitionTest methodsFor: 'tests' stamp: 'lr 12/3/2010 10:35'! testAccept | definition announcer ann | damage add: #Categories ofClass: #BogusA. announcer := OBAnnouncer new. announcer on: OBRefreshRequired do: [ :arg | ann := arg ]. definition := self definition. [ definition accept: self newOrgText notifying: self ] on: OBAnnouncerRequest do: [ :req | req resume: announcer ]. self assert: definition text = self newOrgText. self assert: BogusA organization asString = self newOrgText. self deny: ann isNil! ! !OBOrganizationDefinitionTest methodsFor: 'tests' stamp: 'lr 5/10/2010 14:11'! testDisplay BogusA organization sortCategories. self assert: self definition text = self orgText! ! TestResource subclass: #OBBrowserResource instanceVariableNames: 'model' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBBrowserResource methodsFor: 'accessing' stamp: 'lr 2/7/2010 10:19'! metagraph self subclassResponsibility! ! !OBBrowserResource methodsFor: 'accessing' stamp: ''! model ^ model! ! !OBBrowserResource methodsFor: 'accessing' stamp: 'lr 2/7/2010 10:19'! node self subclassResponsibility! ! !OBBrowserResource methodsFor: 'running' stamp: 'lr 2/7/2010 11:26'! setUp model := OBBrowser metaNode: self metagraph node: self node. model addPanel: (OBDefinitionPanel inBrowser: model)! ! OBBrowserResource subclass: #OBImageBrowserResource instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBImageBrowserResource methodsFor: 'running' stamp: 'cwp 5/19/2007 23:36'! metagraph ^ OBSystemBrowser defaultMetaNode! ! !OBImageBrowserResource methodsFor: 'running' stamp: ''! node ^ OBEnvironmentNode forImage! ! TestResource subclass: #OBSourceFilesResource instanceVariableNames: 'sources' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBSourceFilesResource methodsFor: 'initializing' stamp: ''! changesStream ^ ReadStream on: self changesString! ! !OBSourceFilesResource methodsFor: 'initializing' stamp: ''! changesString ^ '!!BogusA methodsFor: ''as yet unclassified'' stamp: ''cwp 3/11/2004 20:05'' prior: 16777764!! one ^ 4!! !! !!BogusA methodsFor: ''as yet unclassified'' stamp: ''cwp 3/11/2004 20:06'' prior: 16777864!! two ^ 4!! !! !!BogusA methodsFor: ''as yet unclassified'' stamp: ''cwp 3/11/2004 20:06'' prior: 33554520!! one ^ 5!! !! !!BogusA methodsFor: ''as yet unclassified'' stamp: ''cwp 3/11/2004 20:06'' prior: 33554620!! two ^ 5!! !! !!BogusA methodsFor: ''as yet unclassified'' stamp: ''cwp 3/11/2004 20:07'' prior: 33554720!! one ^ 6!! !! !!BogusA methodsFor: ''as yet unclassified'' stamp: ''cwp 3/11/2004 20:07'' prior: 33554820!! two ^ 6!! !! !!BogusA class methodsFor: ''as yet unclassified'' stamp: ''cwp 3/11/2004 20:07'' prior: 16777462!! three ^ 2!! !!'! ! !OBSourceFilesResource methodsFor: 'initializing' stamp: ''! setUp sources := StandardSourceFileArray new: 2. sources at: 1 put: self sourceStream. sources at: 2 put: self changesStream.! ! !OBSourceFilesResource methodsFor: 'initializing' stamp: ''! sourceStream ^ ReadStream on: self sourceString! ! !OBSourceFilesResource methodsFor: 'initializing' stamp: ''! sourceString ^ '!!BogusA methodsFor: ''as yet unclassified'' stamp: ''cwp 3/11/2004 20:05''!! one ^ 1!! !! !!BogusA methodsFor: ''as yet unclassified'' stamp: ''cwp 3/11/2004 20:06''!! two ^ 1!! !! !!BogusA class methodsFor: ''as yet unclassified'' stamp: ''cwp 3/11/2004 20:06''!! three ^ 1!! !! !!BogusA methodsFor: ''as yet unclassified'' stamp: ''cwp 3/11/2004 20:06'' prior: 16777288!! one ^ 2!! !! !!BogusA methodsFor: ''as yet unclassified'' stamp: ''cwp 3/11/2004 20:06'' prior: 16777372!! two ^ 2!! !! !!BogusA methodsFor: ''as yet unclassified'' stamp: ''cwp 3/11/2004 20:07'' prior: 16777600!! one ^ 3!! !! !!BogusA methodsFor: ''as yet unclassified'' stamp: ''cwp 3/11/2004 20:07'' prior: 16777664!! two ^ 3!! !!'! ! !OBSourceFilesResource methodsFor: 'accessing' stamp: ''! sources ^ sources! ! TestCase subclass: #OBAncestryTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBAncestryTest methodsFor: 'asserting' stamp: ''! assert: ancestor isAncestorOf: descendant self assert: (ancestor isAncestorOf: descendant)! ! !OBAncestryTest methodsFor: 'asserting' stamp: ''! deny: ancestor isAncestorOf: descendant self deny: (ancestor isAncestorOf: descendant)! ! !OBAncestryTest methodsFor: 'tests' stamp: ''! testClassCategoryIdentity self assert: (OBClassCategoryNode on: 'Bogus-Base' inEnvironment: Smalltalk) isAncestorOf: (OBClassCategoryNode on: 'Bogus-Base' inEnvironment: Smalltalk). ! ! !OBAncestryTest methodsFor: 'tests' stamp: ''! testClassCategoryOther self deny: (OBClassCategoryNode on: 'Bogus-Base' inEnvironment: Smalltalk) isAncestorOf: (OBClassCategoryNode on: 'Bogus-Formats' inEnvironment: Smalltalk) ! ! !OBAncestryTest methodsFor: 'tests' stamp: 'dvf 8/31/2005 13:17'! testClassIdentity self assert: BogusA asNode isAncestorOf: BogusA asNode! ! !OBAncestryTest methodsFor: 'tests' stamp: 'dvf 8/31/2005 13:17'! testClassInClassCategory | cat | cat := OBClassCategoryNode on: 'Bogus-Base' inEnvironment: Smalltalk. self assert: cat isAncestorOf: BogusA asNode! ! !OBAncestryTest methodsFor: 'tests' stamp: 'lr 2/7/2010 11:11'! testClassInOtherCategory | cat | cat := OBClassCategoryNode on: 'Bogus-Base' inEnvironment: Smalltalk. self deny: cat isAncestorOf: BogusJ asNode! ! !OBAncestryTest methodsFor: 'tests' stamp: 'cwp 12/5/2004 12:55'! testClassMethodInClassCat self assert: (OBClassCategoryNode on: #'Bogus-Base' inEnvironment: Smalltalk) isAncestorOf: (OBMethodNode on: #a inClass: BogusA class) ! ! !OBAncestryTest methodsFor: 'tests' stamp: 'dvf 8/31/2005 13:17'! testClassOther self deny: BogusB asNode isAncestorOf: BogusA asNode! ! !OBAncestryTest methodsFor: 'tests' stamp: 'cwp 9/24/2005 22:28'! testClassVarInClass self assert: BogusB asNode isAncestorOf: (OBInstanceVariableNode on: 'FirstClassVariableB' inClass: BogusB)! ! !OBAncestryTest methodsFor: 'tests' stamp: 'cwp 9/24/2005 22:27'! testInstVarInClass self assert: BogusB asNode isAncestorOf: (OBInstanceVariableNode on: 'firstInstanceVariableB' inClass: BogusB)! ! !OBAncestryTest methodsFor: 'tests' stamp: ''! testMethodCatIdentity self assert: (OBMethodCategoryNode on: #letters inClass: BogusA) isAncestorOf: (OBMethodCategoryNode on: #letters inClass: BogusA)! ! !OBAncestryTest methodsFor: 'tests' stamp: ''! testMethodCatOther self deny: (OBMethodCategoryNode on: #numbers inClass: BogusA) isAncestorOf: (OBMethodCategoryNode on: #letters inClass: BogusA)! ! !OBAncestryTest methodsFor: 'tests' stamp: ''! testMethodIdentity self assert: (OBMethodNode on: #a inClass: BogusA) isAncestorOf: (OBMethodNode on: #a inClass: BogusA)! ! !OBAncestryTest methodsFor: 'tests' stamp: 'dvf 8/31/2005 13:17'! testMethodInClass self assert: BogusA asNode isAncestorOf: (OBMethodNode on: #a inClass: BogusA)! ! !OBAncestryTest methodsFor: 'tests' stamp: 'cwp 12/5/2004 12:54'! testMethodInClassCat self assert: (OBClassCategoryNode on: #'Bogus-Base' inEnvironment: Smalltalk) isAncestorOf: (OBMethodNode on: #a inClass: BogusA) ! ! !OBAncestryTest methodsFor: 'tests' stamp: 'dvf 8/31/2005 13:17'! testMethodInMetaclass self deny: BogusA asNode isAncestorOf: (OBMethodNode on: #a inClass: BogusA class)! ! !OBAncestryTest methodsFor: 'tests' stamp: ''! testMethodInMethodCat self assert: (OBMethodCategoryNode on: #letters inClass: BogusA) isAncestorOf: (OBMethodNode on: #a inClass: BogusA)! ! !OBAncestryTest methodsFor: 'tests' stamp: 'dvf 8/31/2005 13:17'! testMethodInOtherClass self deny: BogusA asNode isAncestorOf: (OBMethodNode on: #isString inClass: BogusE)! ! !OBAncestryTest methodsFor: 'tests' stamp: 'cwp 12/8/2004 21:48'! testMethodOverride self assert: (OBMethodNode on: #isString inClass: BogusA) isAncestorOf: (OBMethodNode on: #isString inClass: BogusE). ! ! !OBAncestryTest methodsFor: 'tests' stamp: 'cwp 2/28/2006 17:32'! testMethodSiblings self deny: (OBMethodNode on: #isString inClass: String) isAncestorOf: (OBMethodNode on: #isString inClass: BogusA). ! ! TestCase subclass: #OBAnnotationPanelTest instanceVariableNames: 'announcer' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBAnnotationPanelTest methodsFor: 'accessing' stamp: 'lr 3/14/2010 09:33'! announcer ^ announcer! ! !OBAnnotationPanelTest methodsFor: 'accessing' stamp: 'lr 3/14/2010 09:30'! panel ^ OBAnnotationPanel inBrowser: self! ! !OBAnnotationPanelTest methodsFor: 'accessing' stamp: 'lr 3/14/2010 09:43'! request ^ OBAnnotationRequest onClass: self class selector: testSelector! ! !OBAnnotationPanelTest methodsFor: 'running' stamp: 'lr 3/14/2010 09:29'! setUp announcer := OBAnnouncer new! ! !OBAnnotationPanelTest methodsFor: 'testing-request' stamp: 'lr 3/14/2010 09:47'! testAllChangeSets self shouldnt: [ self request allChangeSets ] raise: Error! ! !OBAnnotationPanelTest methodsFor: 'testing-request' stamp: 'lr 3/14/2010 09:47'! testDocumentation self shouldnt: [ self request documentation ] raise: Error! ! !OBAnnotationPanelTest methodsFor: 'testing-interactions' stamp: 'lr 3/14/2010 09:41'! testEdit self deny: (self panel accept: 'Edit' notifying: self)! ! !OBAnnotationPanelTest methodsFor: 'testing-request' stamp: 'lr 3/14/2010 09:47'! testFirstComment self shouldnt: [ self request firstComment ] raise: Error! ! !OBAnnotationPanelTest methodsFor: 'testing-request' stamp: 'lr 3/14/2010 09:47'! testImplementorsCount self shouldnt: [ self request implementorsCount ] raise: Error! ! !OBAnnotationPanelTest methodsFor: 'testing-request' stamp: 'lr 3/14/2010 09:47'! testMasterComment self shouldnt: [ self request masterComment ] raise: Error! ! !OBAnnotationPanelTest methodsFor: 'testing-request' stamp: 'lr 3/14/2010 09:48'! testMessageCategory self shouldnt: [ self request messageCategory ] raise: Error! ! !OBAnnotationPanelTest methodsFor: 'testing-request' stamp: 'lr 3/14/2010 09:44'! testPreferences | request | request := self request. self assert: request annotationRequests isArray. request annotationRequests do: [ :each | self assert: (each isSymbol). self assert: (request respondsTo: each) ]! ! !OBAnnotationPanelTest methodsFor: 'testing-request' stamp: 'lr 3/14/2010 09:48'! testPriorTimeStamp self shouldnt: [ self request priorTimeStamp ] raise: Error! ! !OBAnnotationPanelTest methodsFor: 'testing-request' stamp: 'lr 3/14/2010 09:48'! testPriorVersionsCount self shouldnt: [ self request priorVersionsCount ] raise: Error! ! !OBAnnotationPanelTest methodsFor: 'testing-request' stamp: 'lr 3/14/2010 09:48'! testRecentChangeSet self shouldnt: [ self request recentChangeSet ] raise: Error! ! !OBAnnotationPanelTest methodsFor: 'testing' stamp: 'lr 8/15/2010 17:52'! testSelectAnything | panel | panel := self panel. announcer announce: (OBSelectionChanged node: OBNode new). self wait: panel; assert: panel text isNil! ! !OBAnnotationPanelTest methodsFor: 'testing' stamp: 'lr 8/15/2010 17:52'! testSelectCategory | panel | panel := self panel. announcer announce: (OBSelectionChanged node: (OBClassCategoryNode on: self class category)). self wait: panel; assert: panel text isNil! ! !OBAnnotationPanelTest methodsFor: 'testing' stamp: 'lr 8/15/2010 17:52'! testSelectClass | panel | panel := self panel. announcer announce: (OBSelectionChanged node: self class asNode). self wait: panel; assert: panel text = ('Class definition for ' , self class name)! ! !OBAnnotationPanelTest methodsFor: 'testing' stamp: 'lr 8/15/2010 17:52'! testSelectComment | panel | panel := self panel. announcer announce: (OBSelectionChanged node: self class asCommentNode). self wait: panel; assert: panel text = ('Class definition for ' , self class name)! ! !OBAnnotationPanelTest methodsFor: 'testing' stamp: 'lr 8/15/2010 17:52'! testSelectMetaclass | panel | panel := self panel. announcer announce: (OBSelectionChanged node: self class asClassSideNode). self wait: panel; assert: panel text = ('Class definition for ' , self class class name)! ! !OBAnnotationPanelTest methodsFor: 'testing' stamp: 'lr 8/15/2010 17:52'! testSelectMethod | panel | panel := self panel. announcer announce: (OBSelectionChanged node: (OBMethodNode on: #testSelectMethod inClass: self class)). self wait: panel. self assert: panel text isString. self assert: panel text isEmpty not.! ! !OBAnnotationPanelTest methodsFor: 'testing' stamp: 'lr 8/15/2010 17:53'! testSelectProtocol | panel | panel := self panel. announcer announce: (OBSelectionChanged node: self class asNode categories first). self wait: panel; assert: panel text = ('Class definition for ' , self class name)! ! !OBAnnotationPanelTest methodsFor: 'testing-request' stamp: 'lr 3/14/2010 09:48'! testSendersCount self shouldnt: [ self request sendersCount ] raise: Error! ! !OBAnnotationPanelTest methodsFor: 'testing-request' stamp: 'lr 3/14/2010 09:48'! testTimeStamp self shouldnt: [ self request timeStamp ] raise: Error! ! !OBAnnotationPanelTest methodsFor: 'accessing' stamp: 'lr 8/15/2010 17:52'! wait: aPanel | process | process := aPanel process. [ process isTerminated ] whileFalse: [ (Delay forMilliseconds: 10) wait ]! ! TestCase subclass: #OBClassDefinitionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBClassDefinitionTest commentStamp: 'cwp 2/28/2005 23:31' prior: 0! Right now, OBClassDefinition is mostly covered by the browser tests. Eventually those tests should be moved here,! !OBClassDefinitionTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testDoItReceiverClass | definition | definition := OBClassDefinition environment: Smalltalk template: BogusA definition. self deny: definition doItReceiver isMeta! ! !OBClassDefinitionTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testRedefinitionConfirmation | definition | definition := OBClassDefinition environment: Smalltalk template: BogusA definition. [ definition accept: self class definition notifying: self ] on: OBConfirmationRequest do: [ :request | request resume: nil ]! ! TestCase subclass: #OBClassSortFilterTest instanceVariableNames: 'completeTree partialTree unrelatedClasses archivesClasses filter' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBClassSortFilterTest methodsFor: 'private' stamp: 'rw 7/7/2006 17:09'! asNodes: classCollection ^classCollection collect: [:cl | cl asNode]! ! !OBClassSortFilterTest methodsFor: 'private' stamp: 'lr 3/4/2010 20:59'! assert: aClass isIndented: count self assert: aClass isIndented: count in: completeTree! ! !OBClassSortFilterTest methodsFor: 'private' stamp: 'lr 3/4/2010 20:59'! assert: aClass isIndented: count in: anArray | node name | node := anArray detect: [ :ea | ea theClass == aClass ]. name := filter displayString: aClass name forParent: nil child: node. self assert: ((name first: count) allSatisfy: [ :char | char = $ ])! ! !OBClassSortFilterTest methodsFor: 'private' stamp: 'cwp 5/20/2007 02:31'! nodes: nodes shouldBe: correctNodes "sort the collection of nodes. The result should be the correctNodes" | sorted | sorted := filter nodesFrom: nodes forNode: nil. self assert: sorted size = correctNodes size. correctNodes with: sorted do: [:node :sortedNode | self assert: node = sortedNode]! ! !OBClassSortFilterTest methodsFor: 'setup' stamp: 'lr 3/4/2010 20:55'! setUp filter := OBClassSortFilter new. completeTree := self asNodes: {Number. Float. Integer. SmallInteger}. partialTree := self asNodes: {Magnitude. Integer. SmallInteger}. unrelatedClasses := self asNodes: {ArrayedCollection. Class. Compiler. Morph. Point}. archivesClasses := self asNodes: {Archive. TarArchive. ZipArchive. ArchiveMember. TarArchiveMember. ZipArchiveMember. ZipFileMember. ZipDirectoryMember. ZipNewFileMember. ZipStringMember. ZipFileConstants}! ! !OBClassSortFilterTest methodsFor: 'private' stamp: 'rw 7/7/2006 17:33'! sortByNameSize: collection ^collection asSortedCollection: [:x :y | x theClass name size < y theClass name size]! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'rw 7/20/2006 13:24'! testArchivesClassesReversed self nodes: archivesClasses reversed shouldBe: archivesClasses! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'rw 7/20/2006 13:24'! testArchivesClassesUnchanged self nodes: archivesClasses shouldBe: archivesClasses! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'rw 7/20/2006 13:24'! testArchivesClassesUnordered self nodes: (self sortByNameSize: archivesClasses) shouldBe: archivesClasses ! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'rw 7/7/2006 17:26'! testCompleteTreeReversed self nodes: completeTree reversed shouldBe: completeTree! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'rw 7/7/2006 17:26'! testCompleteTreeUnchanged self nodes: completeTree shouldBe: completeTree! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'rw 7/7/2006 17:33'! testCompleteTreeUnordered self nodes: (self sortByNameSize: completeTree) shouldBe: completeTree! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'lr 3/4/2010 20:57'! testIndenting filter nodesFrom: completeTree forNode: nil. self assert: Number isIndented: 0. self assert: Float isIndented: 2. self assert: Integer isIndented: 2. self assert: SmallInteger isIndented: 4.! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'cwp 5/20/2007 00:56'! testOneClass | pointNode sorted | pointNode := Point asNode. sorted := OBClassSortFilter new nodesFrom: (Array with: pointNode) forNode: nil. self assert: sorted size = 1. self assert: (sorted includes: pointNode)! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'lr 3/4/2010 20:59'! testPartialTreeIndenting filter nodesFrom: partialTree forNode: nil. self assert: Magnitude isIndented: 0 in: partialTree. self assert: Integer isIndented: 2 in: partialTree. self assert: SmallInteger isIndented: 4 in: partialTree! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'rw 7/7/2006 17:29'! testPartialTreeReversed self nodes: partialTree reversed shouldBe: partialTree! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'rw 7/7/2006 17:27'! testPartialTreeUnchanged self nodes: partialTree shouldBe: partialTree! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'rw 7/7/2006 17:34'! testPartialTreeUnsorted self nodes: (self sortByNameSize: partialTree) shouldBe: partialTree! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'lr 3/4/2010 21:01'! testUnrelatedClassesIndenting filter nodesFrom: unrelatedClasses forNode: nil. self assert: ArrayedCollection isIndented: 0 in: unrelatedClasses. self assert: Class isIndented: 0 in: unrelatedClasses. self assert: Compiler isIndented: 0 in: unrelatedClasses. self assert: Compiler isIndented: 0 in: unrelatedClasses. self assert: Morph isIndented: 0 in: unrelatedClasses. self assert: Point isIndented: 0 in: unrelatedClasses! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'rw 7/7/2006 17:31'! testUnrelatedClassesReversed self nodes: unrelatedClasses reversed shouldBe: unrelatedClasses! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'rw 7/7/2006 17:31'! testUnrelatedClassesUnchanged self nodes: unrelatedClasses shouldBe: unrelatedClasses! ! !OBClassSortFilterTest methodsFor: 'tests' stamp: 'rw 7/7/2006 17:34'! testUnrelatedClassesUnsorted self nodes: (self sortByNameSize: unrelatedClasses) shouldBe: unrelatedClasses! ! TestCase subclass: #OBCodeBrowserUiTest instanceVariableNames: 'browser' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCodeBrowserUiTest methodsFor: 'running' stamp: 'lr 11/7/2009 18:32'! setUp browser := OBSystemBrowser new. browser addDependent: self! ! !OBCodeBrowserUiTest methodsFor: 'running' stamp: 'cwp 12/6/2004 22:11'! tearDown browser removeDependent: self! ! !OBCodeBrowserUiTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testWindowMenu | menu | (Smalltalk includesKey: #SystemBrowser) ifFalse: [ ^ self ]. menu := MenuMorph new. browser addModelItemsToWindowMenu: menu. self deny: (menu itemWithWording: 'Register this Browser as default') isNil. self deny: (menu itemWithWording: 'Choose new default browser') isNil! ! TestCase subclass: #OBCodeNodeEqualityTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCodeNodeEqualityTest methodsFor: 'tests' stamp: 'cwp 12/20/2004 00:47'! testClassCategoryEquality self assert: (OBClassCategoryNode on: #'Bogus-Base' inEnvironment: Smalltalk) = (OBClassCategoryNode on: #'Bogus-Base' inEnvironment: Smalltalk)! ! !OBCodeNodeEqualityTest methodsFor: 'tests' stamp: 'cwp 12/20/2004 00:48'! testClassCategoryInequality self deny: (OBClassCategoryNode on: #'Bogus-Base' inEnvironment: Smalltalk) = (OBClassCategoryNode on: #'Bogus-Formats' inEnvironment: Smalltalk)! ! !OBCodeNodeEqualityTest methodsFor: 'tests' stamp: 'cwp 12/20/2004 22:21'! testClassCommentEquality self assert: (OBClassCommentNode on: BogusA) = (OBClassCommentNode on: BogusA)! ! !OBCodeNodeEqualityTest methodsFor: 'tests' stamp: 'cwp 12/20/2004 22:23'! testClassCommentInequality self deny: (OBClassCommentNode on: BogusA) = (OBClassCommentNode on: BogusB)! ! !OBCodeNodeEqualityTest methodsFor: 'tests' stamp: 'dvf 8/31/2005 13:14'! testClassEquality self assert: BogusA asNode = BogusA asNode! ! !OBCodeNodeEqualityTest methodsFor: 'tests' stamp: 'dvf 8/31/2005 13:17'! testClassInequality self deny: BogusA asNode = BogusB asNode! ! !OBCodeNodeEqualityTest methodsFor: 'tests' stamp: 'cwp 12/20/2004 00:39'! testMethod self assert: (OBMethodNode on: #one inClass: BogusA) = (OBMethodNode on: #one inClass: BogusA)! ! !OBCodeNodeEqualityTest methodsFor: 'tests' stamp: 'cwp 12/20/2004 00:46'! testMethodCategoryEquality self assert: (OBMethodCategoryNode on: #numbers inClass: BogusA) = (OBMethodCategoryNode on: #numbers inClass: BogusA)! ! !OBCodeNodeEqualityTest methodsFor: 'tests' stamp: 'cwp 12/20/2004 00:46'! testMethodCategoryInequality1 self deny: (OBMethodCategoryNode on: #numbers inClass: BogusA) = (OBMethodCategoryNode on: #letters inClass: BogusA)! ! !OBCodeNodeEqualityTest methodsFor: 'tests' stamp: 'cwp 12/20/2004 00:47'! testMethodCategoryInequality2 self deny: (OBMethodCategoryNode on: #numbers inClass: BogusA) = (OBMethodCategoryNode on: #numbers inClass: BogusB)! ! !OBCodeNodeEqualityTest methodsFor: 'tests' stamp: 'cwp 12/20/2004 00:45'! testMethodEquality self assert: (OBMethodNode on: #one inClass: BogusA) = (OBMethodNode on: #one inClass: BogusA)! ! !OBCodeNodeEqualityTest methodsFor: 'tests' stamp: 'cwp 12/20/2004 00:45'! testMethodInequality1 self deny: (OBMethodNode on: #one inClass: BogusA) = (OBMethodNode on: #two inClass: BogusA)! ! !OBCodeNodeEqualityTest methodsFor: 'tests' stamp: 'cwp 12/20/2004 00:46'! testMethodInequality2 self deny: (OBMethodNode on: #one inClass: BogusA) = (OBMethodNode on: #one inClass: BogusB)! ! TestCase subclass: #OBCodeSanityCheckTest instanceVariableNames: 'node' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBCodeSanityCheckTest methodsFor: 'constants' stamp: ''! bogusARedefinition ^ BogusA definition! ! !OBCodeSanityCheckTest methodsFor: 'constants' stamp: ''! bogusCDefinition ^ 'Object subclass: #BogusC instanceVariableNames: '''' classVariableNames: '''' poolDictionaries: '''' category: ''', BogusInfo baseCategory, ''''! ! !OBCodeSanityCheckTest methodsFor: 'callbacks' stamp: ''! selectionInterval ^ 1 to: 0! ! !OBCodeSanityCheckTest methodsFor: 'testing' stamp: ''! testClassCreation node := OBClassCategoryNode on: BogusInfo baseCategory inEnvironment: Smalltalk. self should: [node definition accept: self bogusCDefinition notifying: self] raise: OBConfirmationRequest! ! !OBCodeSanityCheckTest methodsFor: 'testing' stamp: 'dvf 8/31/2005 13:17'! testClassDefinition node := BogusA asNode. self should: [node definition accept: self bogusCDefinition notifying: self] raise: OBConfirmationRequest! ! !OBCodeSanityCheckTest methodsFor: 'testing' stamp: 'dvf 8/31/2005 13:17'! testClassRedefinition node := BogusA asNode. self shouldnt: [node accept: self bogusARedefinition notifying: self] raise: OBConfirmationRequest! ! !OBCodeSanityCheckTest methodsFor: 'callbacks' stamp: ''! text ^ node text asText! ! TestCase subclass: #OBMercuryPanelTest instanceVariableNames: 'isSearch node announcer' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBMercuryPanelTest methodsFor: 'emulating' stamp: 'lr 11/7/2009 18:32'! addChild: aNode node := aNode! ! !OBMercuryPanelTest methodsFor: 'emulating' stamp: 'cwp 4/15/2007 23:52'! announce: anObject ^ announcer announce: anObject! ! !OBMercuryPanelTest methodsFor: 'emulating' stamp: 'cwp 4/15/2007 23:42'! announcer ^ announcer! ! !OBMercuryPanelTest methodsFor: 'support' stamp: 'lr 12/3/2010 10:35'! handleNavWith: block announcer on: OBNavigate do: [ :a | block value: a. a bid: 1 toDo: []]! ! !OBMercuryPanelTest methodsFor: 'emulating' stamp: 'cwp 4/18/2007 23:57'! isClassBrowser ^ isSearch not! ! !OBMercuryPanelTest methodsFor: 'emulating' stamp: 'cwp 4/15/2007 22:46'! isSearchBrowser ^ isSearch! ! !OBMercuryPanelTest methodsFor: 'emulating' stamp: 'lr 11/7/2009 18:32'! jumpTo: aNode node := aNode! ! !OBMercuryPanelTest methodsFor: 'emulating' stamp: 'lr 11/7/2009 18:32'! noteChanges node := #noteChanges! ! !OBMercuryPanelTest methodsFor: 'support' stamp: 'cwp 4/15/2007 22:33'! panel ^ OBMercuryPanel inBrowser: self! ! !OBMercuryPanelTest methodsFor: 'emulating' stamp: 'cwp 4/15/2007 23:13'! root ^ self! ! !OBMercuryPanelTest methodsFor: 'running' stamp: 'lr 11/7/2009 18:32'! setUp isSearch := false. announcer := OBAnnouncer new! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testAddsChildInSearchBrowser isSearch := true. self panel accept: 'val*' notifying: self. self assert: (node isKindOf: OBMethodSearchNode)! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 12/3/2010 10:35'! testBrowseIsRefreshedIfSelectionIsVetoed isSearch := true. announcer on: OBAboutToChange do: [ :ann | ann veto ]. self panel accept: 'val*' notifying: self. self assert: node == #noteChanges! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testClassName | panel | panel := self panel. self shouldnt: [ panel accept: 'String' notifying: self ] raise: OBBrowseRequest. self assert: (node isKindOf: OBClassNode). self assert: node theClass = String! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testClassRefs | panel request | panel := self panel. [ panel accept: self class name printString notifying: self ] on: OBBrowseRequest do: [ :r | request := r ]. self deny: request isNil. self assert: (request browser isKindOf: OBSearchBrowser). self assert: request browser currentOrRootNode query = self class name! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 8/22/2010 11:18'! testComment | panel | panel := self panel. self should: [ panel accept: '"printOn:"' notifying: self ] raise: OBInformRequest! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testDoesntOpenNewSearchBrowser | panel | isSearch := true. panel := self panel. self shouldnt: [ panel accept: 'val*' notifying: self ] raise: OBBrowseRequest! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testFindClass | panel | panel := self panel. isSearch := true. panel accept: 'Strin*' notifying: self. self assert: (node isKindOf: OBClassSearchNode). self assert: node query first = 'Strin'! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 4/5/2010 12:57'! testFindClassExact | panel request | panel := self panel. panel accept: 'OBMercuryPanel' notifying: self. self assert: (node isKindOf: OBClassNode). self assert: (node name = 'OBMercuryPanel'). isSearch := true. panel accept: 'OBMercuryPanel' notifying: self. self assert: (node isKindOf: OBClassSearchNode). self assert: node query first = 'OBMercuryPanel'! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 4/5/2010 12:58'! testFindClassPrefix | panel prefix | panel := self panel. panel accept: 'OBMercuryPanelTe' notifying: self. self assert: (node isKindOf: OBClassNode). self assert: (node name = 'OBMercuryPanelTest'). isSearch := true. panel accept: 'OBMercuryPanelTe' notifying: self. self assert: (node isKindOf: OBClassSearchNode). self assert: node query first = 'OBMercuryPanelTe'! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testFindMethod | panel | panel := self panel. isSearch := true. panel accept: 'valu*' notifying: self. self assert: (node isKindOf: OBMethodSearchNode). self assert: node query = 'valu'! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testImplementors | panel ann | panel := self panel. self handleNavWith: [ :a | ann := a ]. self shouldnt: [ panel accept: 'value' notifying: self ] raise: OBBrowseRequest. self assert: (ann isKindOf: OBShowImplementors)! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testMorph | panel morph | panel := self panel. morph := OBMorphBuilder build: panel. self assert: (morph isKindOf: OBPluggableTextMorph)! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 12/3/2010 10:35'! testNodeIsSelected | ann | isSearch := true. announcer on: OBSelectingNode do: [ :arg | ann := arg ]. self panel accept: 'val*' notifying: self. self assert: (ann node isKindOf: OBMethodSearchNode)! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testPartialClassName | panel | panel := self panel. isSearch := true. panel accept: 'Strin' notifying: self. self assert: (node isKindOf: OBClassSearchNode). self assert: node query first = 'Strin'! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testPartialSelector | panel | panel := self panel. self should: [ panel accept: 'valu' notifying: self ] raise: OBInformRequest! ! !OBMercuryPanelTest methodsFor: 'tests' stamp: 'cwp 8/31/2007 23:24'! testSenders | panel ann | panel := self panel. self handleNavWith: [:a | ann := a]. self shouldnt: [panel accept: '#value' notifying: self] raise: OBBrowseRequest. self assert: (ann isKindOf: OBShowSenders).! ! TestCase subclass: #OBMethodDefinitionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBMethodDefinitionTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testDoItReceiverCategory | panel | panel := OBMethodDefinition inCategory: #letters inClass: BogusA. self deny: panel doItReceiver isMeta! ! !OBMethodDefinitionTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testDoItReceiverClassMethod | panel | panel := OBMethodDefinition source: (BogusA class sourceCodeAt: #a) inClass: BogusA class. self deny: panel doItReceiver isMeta! ! !OBMethodDefinitionTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testDoItReceiverInstMethod | panel | panel := OBMethodDefinition source: (BogusA sourceCodeAt: #one) inClass: BogusA. self deny: panel doItReceiver isMeta! ! TestCase subclass: #OBMethodIconFilterTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBMethodIconFilterTest methodsFor: 'simulating' stamp: 'lr 8/2/2007 19:58'! breakpoint self halt! ! !OBMethodIconFilterTest methodsFor: 'simulating' stamp: 'lr 1/3/2010 16:19'! flagged self flag: 'This is a flag'! ! !OBMethodIconFilterTest methodsFor: 'simulating' stamp: 'cwp 6/11/2009 17:16'! noIcon! ! !OBMethodIconFilterTest methodsFor: 'tests' stamp: 'lr 3/10/2010 11:11'! testBoth | filter node | filter := OBMethodIconFilter new. node := OBMethodNode on: #= inClass: Integer. self assert: (filter icon: nil forNode: node) = #arrowUpAndDown! ! !OBMethodIconFilterTest methodsFor: 'tests' stamp: 'lr 3/10/2010 11:11'! testBreakpoint | filter node | filter := OBMethodIconFilter new. node := OBMethodNode on: #breakpoint inClass: self class. self assert: (filter icon: nil forNode: node) = #breakpoint! ! !OBMethodIconFilterTest methodsFor: 'tests' stamp: 'lr 3/10/2010 11:11'! testFlag | filter node | filter := OBMethodIconFilter new. node := OBMethodNode on: #flagged inClass: self class. self assert: (filter icon: nil forNode: node) = #flag! ! !OBMethodIconFilterTest methodsFor: 'tests' stamp: 'lr 3/10/2010 11:11'! testNoIcon | filter node | filter := OBMethodIconFilter new. node := OBMethodNode on: #noIcon inClass: self class. self assert: (filter icon: nil forNode: node) = #blank! ! !OBMethodIconFilterTest methodsFor: 'tests' stamp: 'lr 3/10/2010 11:11'! testOverridden | filter node | filter := OBMethodIconFilter new. node := OBMethodNode on: #setUp inClass: TestCase. self assert: (filter icon: nil forNode: node) = #arrowDown! ! !OBMethodIconFilterTest methodsFor: 'tests' stamp: 'lr 3/10/2010 11:11'! testOverrides | filter node | filter := OBMethodIconFilter new. node := OBMethodNode on: #setUp inClass: self class. self assert: (filter icon: nil forNode: node) = #arrowUp! ! TestCase subclass: #OBMethodVersionTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBMethodVersionTest methodsFor: 'constants' stamp: ''! fakeSourceFileArray ^ OBSourceFilesResource current sources! ! !OBMethodVersionTest methodsFor: 'constants' stamp: ''! methodReference | ref | ref := MethodReference new. ref setStandardClass: self class methodSymbol: #testScanFromMethodRef. ^ ref! ! !OBMethodVersionTest methodsFor: 'testing' stamp: ''! testScanFromMethodRef | changes | changes := OBMethodVersion versionsOfMethod: self methodReference. self deny: changes isEmpty! ! !OBMethodVersionTest methodsFor: 'testing' stamp: ''! testScanFromPointer | changes sourcePointer sources | sources := self fakeSourceFileArray. sourcePointer := sources sourcePointerFromFileIndex: 2 andPosition: 488. changes := OBMethodVersion scan: sources from: sourcePointer. self assert: changes size = 6. changes do: [:ea | self assert: ea theClassName = #BogusA. self assert: ea category = 'as yet unclassified'. self assert: (ea stamp beginsWith: 'cwp 3/11/2004 20:0')]! ! !OBMethodVersionTest methodsFor: 'testing' stamp: ''! testScanFromPointerToClassMethod | changes sourcePointer sources | sources := self fakeSourceFileArray. sourcePointer := sources sourcePointerFromFileIndex: 2 andPosition: 694. changes := OBMethodVersion scan: sources from: sourcePointer. self assert: changes size = 2. changes do: [:ea | self assert: ea theClassName = #'BogusA class'. self assert: ea category = 'as yet unclassified'. self assert: (ea stamp beginsWith: 'cwp 3/11/2004 20:0')]! ! TestCase subclass: #OBNavigateTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBNavigateTest class methodsFor: 'testing' stamp: 'cwp 8/26/2007 01:49'! isAbstract ^ self name = #OBNavigateTest! ! !OBNavigateTest methodsFor: 'support' stamp: 'lr 2/7/2010 10:15'! announcementClass self subclassResponsibility! ! !OBNavigateTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testTestDefaultAction | node ann | node := OBMethodNode on: #setUp inClass: self class. ann := self announcementClass of: node. self should: [ ann execute ] raise: OBBrowseRequest! ! OBNavigateTest subclass: #OBShowImplementorsTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBShowImplementorsTest methodsFor: 'support' stamp: 'cwp 8/26/2007 00:27'! announcementClass ^ OBShowImplementors! ! !OBShowImplementorsTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testFan | node ann fan | node := OBMethodNode on: #setUp inClass: self class. ann := OBShowImplementors of: node. fan := ann fan. self assert: fan parent = node. self assert: fan children size > 1. self assert: (fan children anySatisfy: [ :ea | ea theClass = TestCase ]). self assert: (fan children allSatisfy: [ :ea | ea selector = #setUp ])! ! !OBShowImplementorsTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testTestDefaultActionNoChildren | node ann | node := OBMethodNode on: 'kjluhuttt' asSymbol inClass: self class. ann := self announcementClass of: node. self shouldnt: [ self should: [ ann execute ] raise: OBInformRequest ] raise: OBBrowseRequest! ! OBNavigateTest subclass: #OBShowSendersTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBShowSendersTest methodsFor: 'support' stamp: 'cwp 8/26/2007 00:19'! announcementClass ^ OBShowSenders! ! !OBShowSendersTest methodsFor: 'support' stamp: 'cwp 8/26/2007 00:21'! assertFanHasCorrectChildren: fan self assert: (fan children anySatisfy: [:ea | ea theClass = TestCase and: [ea selector = #runCase]])! ! !OBShowSendersTest methodsFor: 'tests' stamp: 'cwp 8/26/2007 00:21'! testFan | node ann fan | node := OBMethodNode on: #setUp inClass: self class. ann := self announcementClass of: node. fan := ann fan. self assert: fan parent = node. self assert: fan children size > 1. self assertFanHasCorrectChildren: fan! ! !OBShowSendersTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testTestDefaultActionNoChildren | node ann | node := OBMethodNode on: 'kjluhuttt' asSymbol inClass: self class. ann := OBShowSenders of: node. self shouldnt: [ self should: [ ann execute ] raise: OBInformRequest ] raise: OBBrowseRequest! ! TestCase subclass: #OBSearchNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! OBSearchNodeTest subclass: #OBClassRefSearchNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBClassRefSearchNodeTest methodsFor: 'support' stamp: 'cwp 4/15/2007 20:27'! nodeClass ^ OBClassRefSearchNode ! ! !OBClassRefSearchNodeTest methodsFor: 'support' stamp: 'lr 2/7/2010 11:36'! searchNodeForThisClass ^ OBClassRefSearchNode on: Class name! ! !OBClassRefSearchNodeTest methodsFor: 'testing' stamp: 'lr 11/7/2009 18:32'! testAncestryOfMethodNode | node node2 | node := OBClassRefSearchNode on: #Class. node2 := OBMethodNode on: #testAncestryOfMethodNode inClass: self class. self assert: (node isAncestorOf: node2)! ! !OBClassRefSearchNodeTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testClassesNotDuplicated | node classes | node := OBClassRefSearchNode on: #Class. classes := node classes. self assert: classes size = classes asSet size! ! !OBClassRefSearchNodeTest methodsFor: 'tests' stamp: 'lr 11/7/2009 18:32'! testName | node | node := OBClassRefSearchNode on: 'Class'. self assert: node name = '#Class (class refs)'! ! OBSearchNodeTest subclass: #OBClassSearchNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBClassSearchNodeTest methodsFor: 'support' stamp: 'cwp 4/15/2007 20:28'! nodeClass ^ OBClassSearchNode! ! !OBClassSearchNodeTest methodsFor: 'support' stamp: 'cwp 7/20/2007 22:16'! searchNodeForThisClass ^ OBClassSearchNode on: (Array with: 'Class').! ! !OBClassSearchNodeTest methodsFor: 'testing' stamp: 'lr 11/7/2009 18:32'! testName | node | node := OBClassSearchNode on: (Array with: 'Class'). self assert: node name = '*Class* (classes)'! ! OBSearchNodeTest subclass: #OBImplementorSearchNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBImplementorSearchNodeTest methodsFor: 'support' stamp: 'cwp 4/15/2007 22:01'! nodeClass ^OBImplementorSearchNode! ! !OBImplementorSearchNodeTest methodsFor: 'support' stamp: 'cwp 4/15/2007 22:01'! searchNodeForThisClass ^OBImplementorSearchNode on: #searchNodeForThisClass! ! !OBImplementorSearchNodeTest methodsFor: 'testing' stamp: 'cwp 4/15/2007 22:01'! testAncestryOfMethodNode | node node2 | node := OBImplementorSearchNode on: #testAncestryOfMethodNode. node2 := OBMethodNode on: #testAncestryOfMethodNode inClass: self class. self assert: (node isAncestorOf: node2)! ! !OBImplementorSearchNodeTest methodsFor: 'testing' stamp: 'cwp 7/20/2007 22:25'! testName | node | node := OBImplementorSearchNode on: 'testName'. self assert: node name = 'testName (implementors)'! ! OBSearchNodeTest subclass: #OBMethodSearchNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBMethodSearchNodeTest methodsFor: 'support' stamp: 'cwp 4/19/2007 00:39'! nodeClass ^ OBMethodSearchNode! ! !OBMethodSearchNodeTest methodsFor: 'support' stamp: 'cwp 4/19/2007 00:25'! searchNodeForThisClass ^ OBMethodSearchNode on: #searchNodeForThisC! ! !OBMethodSearchNodeTest methodsFor: 'testing' stamp: 'cwp 4/19/2007 00:41'! testAncestryOfMethodNode | node node2 | node := OBMethodSearchNode on: #testAncestry. node2 := OBMethodNode on: #testAncestryOfMethodNode inClass: self class. self assert: (node isAncestorOf: node2). ! ! !OBMethodSearchNodeTest methodsFor: 'testing' stamp: 'lr 11/7/2009 18:32'! testClassesContainNoDuplicates | node classes | node := OBMethodSearchNode on: #yoursel. classes := node classes collect: [ :ea | ea theClass ]. self assert: classes size = classes asIdentitySet size! ! !OBMethodSearchNodeTest methodsFor: 'testing' stamp: 'lr 11/7/2009 18:32'! testName | node | node := OBMethodSearchNode on: #yoursel. self assert: node name = 'yoursel* (implementors)'! ! !OBSearchNodeTest class methodsFor: 'testing' stamp: 'cwp 4/15/2007 20:29'! isAbstract ^ self name = #OBSearchNodeTest! ! !OBSearchNodeTest class methodsFor: 'testing' stamp: 'cwp 4/15/2007 20:29'! shouldInheritSelectors ^ true! ! !OBSearchNodeTest methodsFor: 'support' stamp: 'lr 2/7/2010 10:15'! nodeClass self subclassResponsibility! ! !OBSearchNodeTest methodsFor: 'support' stamp: 'lr 2/7/2010 10:15'! searchNodeForThisClass self subclassResponsibility! ! !OBSearchNodeTest methodsFor: 'testing' stamp: 'lr 11/7/2009 18:32'! testAncestryOfEqualNode | node node2 | node := self nodeClass on: 'Test'. node2 := self nodeClass on: 'Test'. self assert: (node isAncestorOf: node2)! ! !OBSearchNodeTest methodsFor: 'testing' stamp: 'lr 11/7/2009 18:32'! testAncestryOfMethodNode | node node2 | node := OBClassSearchNode on: (Array with: 'Test'). node2 := OBMethodNode on: #testAncestryOfMethodNode inClass: self class. self assert: (node isAncestorOf: node2)! ! !OBSearchNodeTest methodsFor: 'testing' stamp: 'lr 11/7/2009 18:32'! testClasses | node classes | node := self searchNodeForThisClass. classes := node classes. self assert: classes size >= 1. self assert: (classes allSatisfy: [ :ea | ea isKindOf: OBClassNode ]). self assert: (classes anySatisfy: [ :ea | ea theClass = self class ])! ! OBSearchNodeTest subclass: #OBSenderSearchNodeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBSenderSearchNodeTest methodsFor: 'support' stamp: 'cwp 4/15/2007 21:16'! nodeClass ^ OBSenderSearchNode! ! !OBSenderSearchNodeTest methodsFor: 'support' stamp: 'cwp 4/15/2007 21:21'! searchNodeForThisClass ^ OBSenderSearchNode on: #yourself! ! !OBSenderSearchNodeTest methodsFor: 'support' stamp: 'cwp 4/15/2007 21:23'! sendsYourself ^ self yourself! ! !OBSenderSearchNodeTest methodsFor: 'testing' stamp: 'lr 11/7/2009 18:32'! testAncestryOfMethodNode | node node2 | node := OBSenderSearchNode on: #assert:. node2 := OBMethodNode on: #testAncestryOfMethodNode inClass: self class. self assert: (node isAncestorOf: node2)! ! !OBSenderSearchNodeTest methodsFor: 'testing' stamp: 'lr 11/7/2009 18:32'! testName | node | node := OBSenderSearchNode on: #yourself. self assert: node name = '#yourself (senders)'! ! TestCase subclass: #OBSystemBrowserAdaptorTest instanceVariableNames: 'oldDefault browser registry' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBSystemBrowserAdaptorTest methodsFor: 'running' stamp: 'lr 11/7/2009 18:32'! openWith: aBlock aBlock on: OBBrowseRequest do: [ :n | browser := n browser ]. self deny: browser isNil! ! !OBSystemBrowserAdaptorTest methodsFor: 'running' stamp: 'lr 11/7/2009 18:32'! setUp registry := Smalltalk at: #SystemBroser ifAbsent: [ nil ]. registry ifNotNil: [ oldDefault := registry defaultOrNil. registry default: OBSystemBrowserAdaptor ]! ! !OBSystemBrowserAdaptorTest methodsFor: 'running' stamp: 'cwp 6/3/2006 19:28'! tearDown registry ifNotNil: [registry default: oldDefault]! ! !OBSystemBrowserAdaptorTest methodsFor: 'testing' stamp: 'cwp 6/3/2006 19:27'! testDefaultOpenBrowser registry ifNil: [^ self]. self openWith: [registry defaultOpenBrowser]. self assert: browser currentNode isNil! ! !OBSystemBrowserAdaptorTest methodsFor: 'testing' stamp: 'cwp 6/3/2006 19:27'! testFullOnClassSelector registry ifNil: [^ self]. self openWith: [Browser fullOnClass: BogusA selector: #one]. self assert: browser currentNode theClass = BogusA. self assert: browser currentNode selector = #one! ! TestCase subclass: #OBTextCmdTest instanceVariableNames: 'announcer' classVariableNames: '' poolDictionaries: '' category: 'OB-Tests-Standard'! !OBTextCmdTest methodsFor: 'emulating' stamp: 'cwp 8/24/2007 01:22'! announce: anObject ^ announcer announce: anObject! ! !OBTextCmdTest methodsFor: 'emulating' stamp: 'cwp 8/24/2007 01:22'! announcer ^ announcer! ! !OBTextCmdTest methodsFor: 'asserting' stamp: 'cwp 9/24/2005 00:10'! assertPanel: actionBlock browser: assertionBlock | notification panel | panel := OBDefinitionPanel inBrowser: self. [self assert: (actionBlock value: panel)] on: OBBrowseRequest do: [:ex | notification := ex]. self deny: notification isNil. self assert: (assertionBlock value: notification browser)! ! !OBTextCmdTest methodsFor: 'running' stamp: 'lr 11/7/2009 18:32'! setUp announcer := OBAnnouncer new! ! !OBTextCmdTest methodsFor: 'tests' stamp: 'cwp 10/31/2004 01:30'! testBrowseItWithClass self assertPanel: [:p | p browseIt: #BogusA] browser: [:browser | browser currentNode theClass = BogusA]! ! !OBTextCmdTest methodsFor: 'tests' stamp: 'lr 11/7/2009 19:19'! testBrowseItWithGlobal self assertPanel: [:p | p browseIt: #Object] browser: [:browser | browser currentNode theClass = Object]! ! !OBTextCmdTest methodsFor: 'tests' stamp: 'cwp 10/31/2004 01:32'! testBrowseItWithSelector self assertPanel: [:p | p browseIt: #testBrowseItWithSelector] browser: [:browser | browser root selector = #testBrowseItWithSelector]! ! !OBTextCmdTest methodsFor: 'tests' stamp: 'cwp 10/31/2004 01:35'! testImpementorsOfIt self assertPanel: [:p | p implementorsOfIt: #testBrowseItWithSelector] browser: [:browser | browser root selector = #testBrowseItWithSelector]! ! !OBTextCmdTest methodsFor: 'tests' stamp: 'cwp 10/31/2004 01:43'! testReferencesToIt self assertPanel: [:p | p referencesToIt: #BogusA] browser: [:browser | browser root theClass = BogusA]! ! !OBTextCmdTest methodsFor: 'tests' stamp: 'cwp 10/31/2004 01:36'! testSendersOfIt self assertPanel: [:p | p sendersOfIt: #testBrowseItWithSelector] browser: [:browser | browser root selector = #testBrowseItWithSelector]! !