Added test for part 1 of #121

GemTalk · Aug 29, 2018 · ea48cdf · ea48cdf
1 parent eb12a60
commit ea48cdf
Show file tree

Hide file tree

Showing 2 changed files with 37 additions and 4 deletions.
diff --git a/sources/JadeiteProjectBrowserTestCase.cls b/sources/JadeiteProjectBrowserTestCase.cls
@@ -125,6 +125,17 @@ selectServicesNamed: anArray in: presenter
 						add: service;
 						yourself)]!
 
+selectTreeServicesNamed: anArray in: presenter
+	presenter resetSelection.
+	anArray do: 
+			[:name |
+			| service |
+			service := presenter model asBag detect: [:svc | svc name = name]
+						ifNone: [self error: 'Tree element ' , name , ' not found'].
+			presenter selections: (presenter selections asOrderedCollection
+						add: service;
+						yourself)]!
+
 serviceNamed: name in: presenter
 	| service |
 	service := presenter list detect: [:service | service name = name] ifNone: [].
@@ -169,6 +180,23 @@ test_classListNotBlank
 
 	!
 
+test_extensionColoringInHierarchy
+	| testClass |
+	self selectServicesNamed: (Array with: 'Rowan') in: self projectListPresenter.
+	self selectServicesNamed: #('Rowan-Specifications') in: self packageListPresenter.
+	self selectServicesNamed: (Array with: 'RwPlatformSpecification') in: self classListPresenter.
+	testClass := self classListPresenter list
+				detect: [:classService | classService name = 'RwGemStoneSpecification']
+				ifNone: [].
+	self assertIsNil: testClass.	"Our guy is an extension"
+	self selectHierarchyTab.
+	self
+		assert: self projectsPresenter classHierarchyPresenter selection name = 'RwPlatformSpecification'.
+	self deny: self projectsPresenter classHierarchyPresenter selection shouldColorAsExtension.
+	self selectTreeServicesNamed: (Array with: 'RwGemStoneSpecification')
+		in: self projectsPresenter classHierarchyPresenter.
+	self assert: self projectsPresenter classHierarchyPresenter selection shouldColorAsExtension!
+
 test_hierarchySelectTwoBrowsers
 	| secondBrowser firstBrowser |
 	self testsIssue: #issue122 withTitle: 'Hierarchy tab selection updates incorrectly.'.
@@ -301,11 +329,13 @@ waitForPresenter: presenter
 !JadeiteProjectBrowserTestCase categoriesFor: #selectHierarchyTabIn:!private!selection! !
 !JadeiteProjectBrowserTestCase categoriesFor: #selectRowanSample1Class!private!selection! !
 !JadeiteProjectBrowserTestCase categoriesFor: #selectServicesNamed:in:!private!selection! !
+!JadeiteProjectBrowserTestCase categoriesFor: #selectTreeServicesNamed:in:!private!selection! !
 !JadeiteProjectBrowserTestCase categoriesFor: #serviceNamed:in:!private!selection! !
 !JadeiteProjectBrowserTestCase categoriesFor: #setUp!private!setup teardown! !
 !JadeiteProjectBrowserTestCase categoriesFor: #tearDown!private!setup teardown! !
 !JadeiteProjectBrowserTestCase categoriesFor: #test_addRemoveCategory!public!test! !
 !JadeiteProjectBrowserTestCase categoriesFor: #test_classListNotBlank!public!test! !
+!JadeiteProjectBrowserTestCase categoriesFor: #test_extensionColoringInHierarchy!public!test! !
 !JadeiteProjectBrowserTestCase categoriesFor: #test_hierarchySelectTwoBrowsers!public!test! !
 !JadeiteProjectBrowserTestCase categoriesFor: #test_markDirty!public!test! !
 !JadeiteProjectBrowserTestCase categoriesFor: #test_openProjectsBrowser!public!test! !

diff --git a/sources/RowanClassService.cls b/sources/RowanClassService.cls
@@ -98,10 +98,7 @@ displayString
 	^displayString!
 
 displayStringFor: displayThing
-	definedPackageName = self notRowanizedPackageName
-		ifFalse: 
-			[(self selectedPackageNames includes: definedPackageName)
-				ifFalse: [displayThing forecolor: Color darkMagenta]].
+	self shouldColorAsExtension ifTrue: [displayThing forecolor: Color darkMagenta].
 	^self displayString!
 
 excludedInstVars
@@ -228,6 +225,11 @@ shouldClearMethods
 
 	^(#(#removeMethods) includes: command) not!
 
+shouldColorAsExtension
+	^definedPackageName = self notRowanizedPackageName
+		ifTrue: [false]
+		ifFalse: [(self selectedPackageNames includes: definedPackageName) not]!
+
 stonOn: stonWriter
 	| instanceVariableNames |
 	(instanceVariableNames := self class allInstVarNames reject: [:iv | self excludedInstVars includes: iv]) isEmpty
@@ -307,6 +309,7 @@ variables
 !RowanClassService categoriesFor: #selectedPackageServices!accessing!private! !
 !RowanClassService categoriesFor: #selectedPackageServices:!accessing!private! !
 !RowanClassService categoriesFor: #shouldClearMethods!public!replication!testing! !
+!RowanClassService categoriesFor: #shouldColorAsExtension!public!testing! !
 !RowanClassService categoriesFor: #stonOn:!must not strip!public!ston! !
 !RowanClassService categoriesFor: #template!accessing!private! !
 !RowanClassService categoriesFor: #template:!accessing!private! !