[Pkg] The Trunk: ToolsTests-pre.85.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Sep 26 15:35:20 UTC 2018


Patrick Rein uploaded a new version of ToolsTests to project The Trunk:
http://source.squeak.org/trunk/ToolsTests-pre.85.mcz

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

Name: ToolsTests-pre.85
Author: pre
Time: 26 September 2018, 4:34:58.153741 pm
UUID: 2b48f990-2373-5e47-a8f9-763dcda16e13
Ancestors: ToolsTests-eem.84

Actual change is a fix of the BrowserTest>>#testMessageCategoryList. From my brief study of the source code the test does not make any statement about the sorting of the categories.

Could not resist improving the categorization of tests while being at it.

=============== Diff against ToolsTests-eem.84 ===============

Item was changed:
+ ----- Method: BrowserTest>>testAlphabetizeMessageCategories (in category 'tests') -----
- ----- Method: BrowserTest>>testAlphabetizeMessageCategories (in category 'as yet unclassified') -----
  testAlphabetizeMessageCategories
  	| categories |
  	browser selectSystemCategory: browser class category.
  	self deny: browser alphabetizeMessageCategories.
  	
  	browser selectClass: browser class.
  	browser metaClassIndicated: false.
  	self assert: browser alphabetizeMessageCategories.
  	categories := browser classOrMetaClassOrganizer categories.
  	self assert: (categories select: [:c| c first == $*]) isSorted.
  	self assert: (categories select: [:c| c beginsWith: 'private']) isSorted.
  	self assert: (categories reject: [:c| c first == $* or: [c beginsWith: 'private']]) isSorted.
  	
  	browser metaClassIndicated: true.
  	self assert: browser alphabetizeMessageCategories.
  	self assert: browser classOrMetaClassOrganizer categories isSorted.!

Item was changed:
+ ----- Method: BrowserTest>>testAlphabetizeMessageCategoriesLeavesClassSelected (in category 'tests') -----
- ----- Method: BrowserTest>>testAlphabetizeMessageCategoriesLeavesClassSelected (in category 'as yet unclassified') -----
  testAlphabetizeMessageCategoriesLeavesClassSelected
  	browser selectSystemCategory: browser class category.
  	browser selectClassNamed: browser class name.
  	
  	"This is a no-op."
  	browser alphabetizeMessageCategories.
  	self assert: browser selectedClassName = browser class name.!

Item was changed:
+ ----- Method: BrowserTest>>testAlphabetizingMethodsPreservesPlace (in category 'tests - message list') -----
- ----- Method: BrowserTest>>testAlphabetizingMethodsPreservesPlace (in category 'testing - message list') -----
  testAlphabetizingMethodsPreservesPlace
  	| oldCategory oldMethod |
  	oldCategory := 'breakpoints'.
  	oldMethod := #toggleBreakOnEntry.
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	browser selectMessageCategoryNamed: oldCategory.
  	browser selectMessageNamed: oldMethod.
  	browser alphabetizeMessageCategories.
  
  	self assert: browser selectedMessageCategoryName = oldCategory.
  	self assert: browser selectedMessageName = oldMethod.!

Item was changed:
+ ----- Method: BrowserTest>>testAlphabetizingMethodsPreservesPlaceWhenNoMessageCategorySelected (in category 'tests - message list') -----
- ----- Method: BrowserTest>>testAlphabetizingMethodsPreservesPlaceWhenNoMessageCategorySelected (in category 'testing - message list') -----
  testAlphabetizingMethodsPreservesPlaceWhenNoMessageCategorySelected
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	browser selectMessageCategoryNamed: nil.
  	browser selectMessageNamed: nil.
  	browser alphabetizeMessageCategories.
  
  	self assert: browser selectedMessageCategoryName = nil.
  	self assert: browser selectedMessageName = nil.!

Item was changed:
+ ----- Method: BrowserTest>>testAlphabetizingMethodsPreservesPlaceWhenNoMethodSelected (in category 'tests - message list') -----
- ----- Method: BrowserTest>>testAlphabetizingMethodsPreservesPlaceWhenNoMethodSelected (in category 'testing - message list') -----
  testAlphabetizingMethodsPreservesPlaceWhenNoMethodSelected
  	| oldCategory |
  	oldCategory := 'breakpoints'.
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	browser selectMessageCategoryNamed: oldCategory.
  	browser selectMessageNamed: nil.
  	browser alphabetizeMessageCategories.
  
  	self assert: browser selectedMessageCategoryName = oldCategory.
  	self assert: browser selectedMessageName = nil.!

Item was changed:
+ ----- Method: BrowserTest>>testBuildMessageCategoryBrowserEditString (in category 'tests') -----
- ----- Method: BrowserTest>>testBuildMessageCategoryBrowserEditString (in category 'as yet unclassified') -----
  testBuildMessageCategoryBrowserEditString
  	| spawn |
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	browser messageCategoryListIndex: 1.
  	browser messageListIndex: 1.
  	
  	spawn := browser buildMessageCategoryBrowserEditString: 'We don''t yet test that we do the right thing with this string!!'.
  	[self assert: spawn selectedSystemCategory = browser selectedSystemCategory.
  	self assert: spawn selectedClass = browser selectedClass.
  	self assert: spawn messageCategoryListIndex = browser messageCategoryListIndex.
  	self assert: spawn messageListIndex = browser messageListIndex]
  		ensure: [ [ToolBuilder default close: spawn topView] valueSupplyingAnswer: true].!

Item was changed:
+ ----- Method: BrowserTest>>testBuildMessageCategoryBrowserEditStringNoCategorySelected (in category 'tests') -----
- ----- Method: BrowserTest>>testBuildMessageCategoryBrowserEditStringNoCategorySelected (in category 'as yet unclassified') -----
  testBuildMessageCategoryBrowserEditStringNoCategorySelected
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	browser messageCategoryListIndex: 0.
  	
  	self assert: (browser buildMessageCategoryBrowserEditString: 'foo') isNil.!

Item was changed:
+ ----- Method: BrowserTest>>testChangeMessageCategoriesLeavesClassSelected (in category 'tests') -----
- ----- Method: BrowserTest>>testChangeMessageCategoriesLeavesClassSelected (in category 'as yet unclassified') -----
  testChangeMessageCategoriesLeavesClassSelected
  	browser selectSystemCategory: browser class category.
  	browser selectClassNamed: browser class name.
  	
  	"This is a no-op."
  	browser changeMessageCategories: browser classOrMetaClassOrganizer printString.
  	self assert: browser selectedClassName = browser class name.!

Item was changed:
+ ----- Method: BrowserTest>>testClassCommentAnnotation (in category 'tests') -----
- ----- Method: BrowserTest>>testClassCommentAnnotation (in category 'as yet unclassified') -----
  testClassCommentAnnotation
  	| annotation |
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	annotation := browser annotationForClassCommentFor: browser class.
  	self assert: (annotation includesSubstring: browser class organization commentStamp).
  	self assert: (annotation includesSubstring: 'class comment for').
  	self assert: (annotation includesSubstring: browser className).!

Item was changed:
+ ----- Method: BrowserTest>>testClassCommentAnnotationIgnoresParameter (in category 'tests') -----
- ----- Method: BrowserTest>>testClassCommentAnnotationIgnoresParameter (in category 'as yet unclassified') -----
  testClassCommentAnnotationIgnoresParameter
  	| annotation |
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	"And the method ignores the parameter:"
  	annotation := browser annotationForClassCommentFor: browser class superclass.
  	self assert: (annotation includesSubstring: browser className).!

Item was changed:
+ ----- Method: BrowserTest>>testClassCommentViewingPersists (in category 'tests') -----
- ----- Method: BrowserTest>>testClassCommentViewingPersists (in category 'as yet unclassified') -----
  testClassCommentViewingPersists
  	browser selectSystemCategory: browser class category.
  	self assert: browser classList size > 1 description: 'We use the first TWO classes in the category!!'.
  	browser classListIndex: 1.
  	browser metaClassIndicated: false.
  	browser editComment.
  	
  	browser classListIndex: 2.
  	self assert: browser editSelection = #editComment.!

Item was changed:
+ ----- Method: BrowserTest>>testClassDefinitionAnnotation (in category 'tests') -----
- ----- Method: BrowserTest>>testClassDefinitionAnnotation (in category 'as yet unclassified') -----
  testClassDefinitionAnnotation
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	self assert: browser class comment equals: (browser annotationForClassDefinitionFor: browser class).
  	"And the method ignores the parameter:"
  	self assert: browser class comment equals: (browser annotationForClassDefinitionFor: browser class superclass).!

Item was changed:
+ ----- Method: BrowserTest>>testContentsNewClass (in category 'tests') -----
- ----- Method: BrowserTest>>testContentsNewClass (in category 'as yet unclassified') -----
  testContentsNewClass
  	browser selectSystemCategory: browser class category.
  
  	self assert: (Class template: browser selectedSystemCategory) equals: browser contents.
  	
  	self flag: #todo. "I don't know how to test the other half of this: see Browser >> #newClassContents".!

Item was changed:
+ ----- Method: BrowserTest>>testContentsSelection (in category 'tests') -----
- ----- Method: BrowserTest>>testContentsSelection (in category 'as yet unclassified') -----
  testContentsSelection
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  
  	"No category or message selected."
  	self assert: browser contentsSelection isEmpty.
  
  	"Category selected, but no message selected."
  	browser messageCategoryListIndex: 1.
  	browser selectMessageNamed: browser messageList first.
  	self assert: browser contentsSelection isEmpty.
  	
  	"Category and message selected."
  	browser selectMessageNamed: nil.
  	self deny: browser contentsSelection isEmpty.!

Item was changed:
+ ----- Method: BrowserTest>>testCreateHierarchyTreeOf (in category 'tests') -----
- ----- Method: BrowserTest>>testCreateHierarchyTreeOf (in category 'as yet unclassified') -----
  testCreateHierarchyTreeOf
  	"Empty."
  	self assert: (browser createHierarchyTreeOf: #()) isEmpty.
  	"Single class."
  	self assert: { Browser -> #() } = (browser createHierarchyTreeOf: { Browser }).
  	"Single class + 1 subclass"
  	self assert: { Browser->{HierarchyBrowser->#()} } = (browser createHierarchyTreeOf: { Browser. HierarchyBrowser. }).
  	"Single class + 2 subclasses"
  	self assert: { Browser->{HierarchyBrowser->#() . FileContentsBrowser->#()} } = (browser createHierarchyTreeOf: { Browser. HierarchyBrowser. FileContentsBrowser. }).
  	"Superclass, class, subclass"
  	self assert: { CodeHolder->{Browser->{HierarchyBrowser->#()}} } = (browser createHierarchyTreeOf: { CodeHolder. Browser. HierarchyBrowser. }).
  	"Two 'unrelated' classes"
  	self assert: {Browser->#() . SmallInteger->#()} = (browser createHierarchyTreeOf: { Browser. SmallInteger }).
  	"Two 'unrelated' classes and a common ancestor"
  	self assert: {Browser->#() . SmallInteger->#() . ProtoObject->#()} = (browser createHierarchyTreeOf: { Browser. SmallInteger. ProtoObject }).!

Item was changed:
+ ----- Method: BrowserTest>>testDefaultClassList (in category 'tests') -----
- ----- Method: BrowserTest>>testDefaultClassList (in category 'as yet unclassified') -----
  testDefaultClassList
  	browser selectSystemCategory: nil.
  	self assert: browser defaultClassList isEmpty.
  	
  	browser selectSystemCategory: Browser category.
  	self assert: browser defaultClassList = (SystemOrganization listAtCategoryNamed: Browser category)!

Item was changed:
+ ----- Method: BrowserTest>>testFileOutMessageCategories (in category 'tests') -----
- ----- Method: BrowserTest>>testFileOutMessageCategories (in category 'as yet unclassified') -----
  testFileOutMessageCategories
  	| fileName |	
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	browser messageCategoryListIndex: 1.
  	
  	"Handcrafted from ClassDescription>>fileOutCategory:asHtml:"
  	fileName := browser selectedClass name, '-', browser selectedMessageCategoryName, FileDirectory dot, 'st'.
  	self deny: (FileDirectory default fileExists: fileName).
  	
  	[browser fileOutMessageCategories.
  	self assert: (FileDirectory default fileExists: fileName).
  	] ensure: [FileDirectory default deleteFileNamed: fileName].!

Item was changed:
+ ----- Method: BrowserTest>>testFlattenHierarchyTreeOnIndent (in category 'tests') -----
- ----- Method: BrowserTest>>testFlattenHierarchyTreeOnIndent (in category 'as yet unclassified') -----
  testFlattenHierarchyTreeOnIndent
  	| flatten |
  	flatten := [:coll | (browser
  		flattenHierarchyTree: (browser createHierarchyTreeOf: coll)
  		on: OrderedCollection new
  		indent: '') asArray ].
  	"Empty collection."
  	self assert: (flatten value: #()) isEmpty.
  	"Single class."
  	self assert: #('Browser') equals: (flatten value: {Browser}).
  	"Single class + subclass."
  	self assert: #('Browser' '  HierarchyBrowser') equals: (flatten value: {Browser. HierarchyBrowser}).
  	"Single class + 2 subclasses"
  	self assert: #('Browser' '  HierarchyBrowser' '  FileContentsBrowser') equals: (flatten value: { Browser. HierarchyBrowser. FileContentsBrowser. }).
  	"Superclass, class, subclass"
  	self assert: #('CodeHolder' '  Browser' '    HierarchyBrowser') equals: (flatten value: { CodeHolder. Browser. HierarchyBrowser. }).
  	"Two 'unrelated' classes"
  	self assert: #('Browser' 'SmallInteger') equals: (flatten value: { Browser. SmallInteger }).
  	"Two 'unrelated' classes and a common ancestor"
  	self assert: #('Browser' 'SmallInteger' 'ProtoObject') equals: (flatten value: { Browser. SmallInteger. ProtoObject }).!

Item was changed:
+ ----- Method: BrowserTest>>testFlattenHierarchyTreeOnIndentBy (in category 'tests') -----
- ----- Method: BrowserTest>>testFlattenHierarchyTreeOnIndentBy (in category 'as yet unclassified') -----
  testFlattenHierarchyTreeOnIndentBy
  	| flatten |
  	flatten := [:coll | (browser
  		flattenHierarchyTree: (browser createHierarchyTreeOf: coll)
  		on: OrderedCollection new
  		indent: ''
  		by: 'x') asArray ].
  	"Empty collection."
  	self assert: (flatten value: #()) isEmpty.
  	"Single class."
  	self assert: #('Browser') equals: (flatten value: {Browser}).
  	"Single class + subclass."
  	self assert: #('Browser' 'xHierarchyBrowser') equals: (flatten value: {Browser. HierarchyBrowser}).
  	"Single class + 2 subclasses"
  	self assert: #('Browser' 'xHierarchyBrowser' 'xFileContentsBrowser') equals: (flatten value: { Browser. HierarchyBrowser. FileContentsBrowser. }).
  	"Superclass, class, subclass"
  	self assert: #('CodeHolder' 'xBrowser' 'xxHierarchyBrowser') equals: (flatten value: { CodeHolder. Browser. HierarchyBrowser. }).
  	"Two 'unrelated' classes"
  	self assert: #('Browser' 'SmallInteger') equals: (flatten value: { Browser. SmallInteger }).
  	"Two 'unrelated' classes and a common ancestor"
  	self assert: #('Browser' 'SmallInteger' 'ProtoObject') equals: (flatten value: { Browser. SmallInteger. ProtoObject }).!

Item was changed:
+ ----- Method: BrowserTest>>testGetSystemCategoryListIndex (in category 'tests') -----
- ----- Method: BrowserTest>>testGetSystemCategoryListIndex (in category 'as yet unclassified') -----
  testGetSystemCategoryListIndex
  	| cat |
  	cat := browser systemCategoryList first.
  	browser selectSystemCategory: cat.
  	self assert: browser systemCategoryListIndex = (browser systemCategoryList indexOf: browser selectedSystemCategory).!

Item was changed:
+ ----- Method: BrowserTest>>testHasClassSelected (in category 'tests') -----
- ----- Method: BrowserTest>>testHasClassSelected (in category 'as yet unclassified') -----
  testHasClassSelected
  	browser selectSystemCategory: browser class category.
  	self deny: browser hasClassSelected.
  
  	browser selectClass: browser class.
  	self assert: browser hasClassSelected.
  
  	browser selectClass: nil.
  	self deny: browser hasClassSelected.
  
  	browser selectClassNamed: browser class name asString.
  	self assert: browser hasClassSelected.!

Item was changed:
+ ----- Method: BrowserTest>>testHasMessageCategorySelected (in category 'tests') -----
- ----- Method: BrowserTest>>testHasMessageCategorySelected (in category 'as yet unclassified') -----
  testHasMessageCategorySelected
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	browser messageCategoryListIndex: 0.
  	self deny: browser hasMessageCategorySelected.
  	
  	browser messageCategoryListIndex: 1.
  	self assert: browser hasMessageCategorySelected.
  	
  	browser messageCategoryListIndex: 0.
  	self deny: browser hasMessageCategorySelected.!

Item was changed:
+ ----- Method: BrowserTest>>testHasMessageSelected (in category 'tests') -----
- ----- Method: BrowserTest>>testHasMessageSelected (in category 'as yet unclassified') -----
  testHasMessageSelected
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	browser messageCategoryListIndex: 1.
  	
  	self deny: browser hasMessageSelected.
  	
  	browser messageListIndex: 0.
  	self deny: browser hasMessageSelected.
  	
  	browser messageListIndex: 1.
  	self assert: browser hasMessageSelected.
  	
  	browser messageListIndex: 0.
  	self deny: browser hasMessageSelected.!

Item was changed:
+ ----- Method: BrowserTest>>testHomeCategory (in category 'tests') -----
- ----- Method: BrowserTest>>testHomeCategory (in category 'as yet unclassified') -----
  testHomeCategory
  	"This also 'just happens' to test #selectOriginalCategoryForCurrentMethod. It's not appropriate to directly test a private method. (It's a private method because its comment says so, not its category.)"
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	browser messageCategoryListIndex: 0. "Select -- all --"
  	browser selectMessageNamed: browser messageList first.
  	browser showHomeCategory.
  	
  	self assert: browser selectedMessageCategoryName = (browser class organization categoryOfElement: browser selectedMessageName).!

Item was changed:
+ ----- Method: BrowserTest>>testKeepMethodSelectedWhenChangingClass (in category 'tests - message list') -----
- ----- Method: BrowserTest>>testKeepMethodSelectedWhenChangingClass (in category 'testing - message list') -----
  testKeepMethodSelectedWhenChangingClass
  	browser selectSystemCategory: SequenceableCollection category.
  	browser selectClass: SequenceableCollection.
  	browser selectMessageNamed: #add:.
  	self assert: browser selectedMessageName = #add:.
  	
  	"Even though we have no message category selected, stay looking at the #add: method."
  	browser selectClass: Collection.
  	self assert: browser selectedMessageName = #add:.!

Item was changed:
+ ----- Method: BrowserTest>>testLabelStringAlwaysShowsBrowserType (in category 'tests') -----
- ----- Method: BrowserTest>>testLabelStringAlwaysShowsBrowserType (in category 'as yet unclassified') -----
  testLabelStringAlwaysShowsBrowserType
  	browser selectSystemCategory: browser class category.
  	self assert: (browser labelString includesSubstring: 'System Browser').
  	browser selectClass: browser class.
  	self assert: (browser labelString includesSubstring: 'System Browser').
  	browser selectSystemCategory: DependencyBrowser category.
  	browser selectClass: DependencyBrowser.
  	self assert: (browser labelString includesSubstring: 'System Browser').!

Item was changed:
+ ----- Method: BrowserTest>>testLabelStringOfNewBrowserShowsBrowserType (in category 'tests') -----
- ----- Method: BrowserTest>>testLabelStringOfNewBrowserShowsBrowserType (in category 'as yet unclassified') -----
  testLabelStringOfNewBrowserShowsBrowserType
  	self assert: 'System Browser' equals: browser labelString.!

Item was changed:
+ ----- Method: BrowserTest>>testLabelStringShowsBrowsedClassName (in category 'tests') -----
- ----- Method: BrowserTest>>testLabelStringShowsBrowsedClassName (in category 'as yet unclassified') -----
  testLabelStringShowsBrowsedClassName
  	browser selectSystemCategory: DependencyBrowser category.
  	browser selectClass: DependencyBrowser.
  	self assert: (browser labelString includesSubstring: DependencyBrowser name).!

Item was changed:
+ ----- Method: BrowserTest>>testMessageCatListSingleton (in category 'tests') -----
- ----- Method: BrowserTest>>testMessageCatListSingleton (in category 'as yet unclassified') -----
  testMessageCatListSingleton
  	| catName |
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	
  	self assert: browser messageCatListSingleton = #().
  	
  	catName := browser messageCategoryList second.
  	browser selectMessageCategoryNamed: catName.
  	
  	self assert: browser messageCatListSingleton = {catName}.!

Item was changed:
+ ----- Method: BrowserTest>>testMessageCategoryList (in category 'tests') -----
- ----- Method: BrowserTest>>testMessageCategoryList (in category 'as yet unclassified') -----
  testMessageCategoryList
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	
+ 	self assert: ({ClassOrganizer allCategory}, browser class organization categories) sorted equals: browser messageCategoryList sorted.
- 	self assert: browser messageCategoryList = ({ClassOrganizer allCategory}, browser class organization categories).
  	
  	browser selectClass: nil.
+ 	self assert: #() equals: browser messageCategoryList.
- 	self assert: browser messageCategoryList = #().
  	
  	browser selectClass: browser class.
  	browser metaClassIndicated: true.
+ 	self assert: ({ClassOrganizer allCategory}, browser class classSide organization categories) equals: browser messageCategoryList.!
- 	self assert: browser messageCategoryList = ({ClassOrganizer allCategory}, browser class classSide organization categories).!

Item was changed:
+ ----- Method: BrowserTest>>testMessageCategoryListIndex (in category 'tests') -----
- ----- Method: BrowserTest>>testMessageCategoryListIndex (in category 'as yet unclassified') -----
  testMessageCategoryListIndex
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	
  	self assert: browser messageCategoryList size > 1 description: 'Sanity check: test refers to first two categories.'.
  	
  	browser messageCategoryListIndex: 0.
  	self assert: browser selectedMessageCategoryName isNil.
  	
  	browser messageCategoryListIndex: 1.
  	self assert: browser selectedMessageCategoryName = browser messageCategoryList first.
  	
  	browser messageListIndex: 1.
  	browser messageCategoryListIndex: 2.
  	self assert: browser selectedMessageName isNil description: 'Changing category deselects method'.!

Item was changed:
+ ----- Method: BrowserTest>>testMessageList (in category 'tests') -----
- ----- Method: BrowserTest>>testMessageList (in category 'as yet unclassified') -----
  testMessageList
  	browser selectSystemCategory: browser class category.
  	browser selectClass: nil.
  	self assert: browser messageList isEmpty.
  	
  	browser selectClass: browser class.
  	browser messageCategoryListIndex: 0.
  	self assert: browser messageList = browser classOrMetaClassOrganizer allMethodSelectors.
  	browser messageCategoryListIndex: 1. "-- all --"
  	self assert: browser messageList = browser classOrMetaClassOrganizer allMethodSelectors.
  	
  	browser messageCategoryListIndex: 2.
  	self assert: browser messageList = (browser classOrMetaClassOrganizer listAtCategoryNumber: 1).
  	
  	browser metaClassIndicated: true.
  	browser messageCategoryListIndex: 0.
  	self assert: browser messageList = browser classOrMetaClassOrganizer allMethodSelectors.
  	
  	browser messageCategoryListIndex: 1. "-- all --"
  	self assert: browser messageList = browser classOrMetaClassOrganizer allMethodSelectors.
  	
  	browser messageCategoryListIndex: 2.
  	self assert: browser messageList = (browser classOrMetaClassOrganizer listAtCategoryNumber: 1).!

Item was changed:
+ ----- Method: BrowserTest>>testMetaClassIndicatedFalseOnExistingClass (in category 'tests') -----
- ----- Method: BrowserTest>>testMetaClassIndicatedFalseOnExistingClass (in category 'as yet unclassified') -----
  testMetaClassIndicatedFalseOnExistingClass
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	browser metaClassIndicated: false.
  	
  	self assert: browser messageListIndex = 0.
  	self assert: browser messageCategoryListIndex = 0.
  	self deny: browser contents isEmpty. "It shows the class definition."
  	
  	self deny: browser messageCategoryList isEmpty.
  	
  	self assert: browser messageList = (browser class organization allMethodSelectors).
  	self assert: browser editSelection = #editClass.!

Item was changed:
+ ----- Method: BrowserTest>>testMetaClassIndicatedNotOnNoClass (in category 'tests') -----
- ----- Method: BrowserTest>>testMetaClassIndicatedNotOnNoClass (in category 'as yet unclassified') -----
  testMetaClassIndicatedNotOnNoClass
  	browser selectSystemCategory: browser class category.
  	browser selectClass: nil.
  	browser metaClassIndicated: false.
  	
  	self assert: browser messageListIndex = 0.
  	self assert: browser messageCategoryListIndex = 0.
  	self deny: browser contents isEmpty. "It shows the class definition."
  	
  	self assert: browser messageCategoryList isEmpty.
  	
  	self assert: browser messageList isEmpty.
  	self assert: browser editSelection = #newClass.!

Item was changed:
+ ----- Method: BrowserTest>>testMetaClassIndicatedNotWithNoSystemCategorySelected (in category 'tests') -----
- ----- Method: BrowserTest>>testMetaClassIndicatedNotWithNoSystemCategorySelected (in category 'as yet unclassified') -----
  testMetaClassIndicatedNotWithNoSystemCategorySelected
  	browser selectSystemCategory: nil.
  	browser metaClassIndicated: false.
  	
  	self assert: browser messageListIndex = 0.
  	self assert: browser messageCategoryListIndex = 0.
  	self assert: browser contents isEmpty. "It shows the Class definition."
  	self assert: browser messageCategoryList isEmpty.
  	self assert: browser editSelection = #none.!

Item was changed:
+ ----- Method: BrowserTest>>testMetaClassIndicatedOnNoClass (in category 'tests') -----
- ----- Method: BrowserTest>>testMetaClassIndicatedOnNoClass (in category 'as yet unclassified') -----
  testMetaClassIndicatedOnNoClass
  	browser selectSystemCategory: browser class category.
  	browser selectClass: nil.
  	browser metaClassIndicated: true.
  	
  	self assert: browser messageListIndex = 0.
  	self assert: browser messageCategoryListIndex = 0.
  	self assert: browser contents isEmpty.
  	
  	self assert: browser messageCategoryList isEmpty.
  	
  	self assert: browser messageList isEmpty.
  	self assert: browser editSelection = #none.!

Item was changed:
+ ----- Method: BrowserTest>>testMetaClassIndicatedTrueOnExistingClass (in category 'tests') -----
- ----- Method: BrowserTest>>testMetaClassIndicatedTrueOnExistingClass (in category 'as yet unclassified') -----
  testMetaClassIndicatedTrueOnExistingClass
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	browser metaClassIndicated: true.
  	
  	self assert: browser messageListIndex = 0.
  	self assert: browser messageCategoryListIndex = 0.
  	self deny: browser contents isEmpty. "It shows the Class definition."
  	self deny: browser messageCategoryList isEmpty.
  	
  	self assert: browser messageList = (browser class classSide organization allMethodSelectors).!

Item was changed:
+ ----- Method: BrowserTest>>testMetaClassIndicatedWithNoSystemCategorySelected (in category 'tests') -----
- ----- Method: BrowserTest>>testMetaClassIndicatedWithNoSystemCategorySelected (in category 'as yet unclassified') -----
  testMetaClassIndicatedWithNoSystemCategorySelected
  	browser selectSystemCategory: nil.
  	browser metaClassIndicated: true.
  	
  	self assert: browser messageListIndex = 0.
  	self assert: browser messageCategoryListIndex = 0.
  	self assert: browser contents isEmpty. "It shows the Class definition."
  	self assert: browser messageCategoryList isEmpty.
  	self assert: browser editSelection = #none.!

Item was changed:
+ ----- Method: BrowserTest>>testRawMessageCategoryList (in category 'tests') -----
- ----- Method: BrowserTest>>testRawMessageCategoryList (in category 'as yet unclassified') -----
  testRawMessageCategoryList
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	
  	self assert: browser rawMessageCategoryList = browser class organization categories.
  	
  	browser selectClass: nil.
  	self assert: browser rawMessageCategoryList = #().
  	
  	browser selectClass: browser class.
  	browser metaClassIndicated: true.
  	self assert: browser rawMessageCategoryList = browser class classSide organization categories.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectCategoryForClass (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectCategoryForClass (in category 'as yet unclassified') -----
  testSelectCategoryForClass
  	browser selectCategoryForClass: Browser.
  	self assert: browser selectedSystemCategory = Browser category.
  	
  	browser selectCategoryForClass: TestCase.
  	self assert: browser selectedSystemCategory = TestCase category.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectClass (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectClass (in category 'as yet unclassified') -----
  testSelectClass
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	self assert: browser hasClassSelected.
  	
  	browser selectClass: nil.
  	self deny: browser hasClassSelected.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectClassEditSelectionNoClass (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectClassEditSelectionNoClass (in category 'as yet unclassified') -----
  testSelectClassEditSelectionNoClass
  	browser selectSystemCategory: browser class category.
  	
  	browser selectClass: nil.
  	self assert: browser editSelection = #newClass.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectClassEditSelectionWhenCommentSelected (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectClassEditSelectionWhenCommentSelected (in category 'as yet unclassified') -----
  testSelectClassEditSelectionWhenCommentSelected
  	| editSelection |
  	browser selectSystemCategory: Heap category.
  	browser selectClass: Heap.
  	browser editComment.
  	browser messageListIndex: 0.
  	browser messageListIndex: 0.
  
  	editSelection := browser editSelection.
  	browser selectClass: Interval.
  	self assert: browser editSelection = editSelection.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectClassEditSelectionWhenEditingClass (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectClassEditSelectionWhenEditingClass (in category 'as yet unclassified') -----
  testSelectClassEditSelectionWhenEditingClass
  	browser selectSystemCategory: Heap category.
  	browser selectClass: Heap.
  	browser metaClassIndicated: false.
  	browser messageListIndex: 0.
  	browser messageListIndex: 0.
  	
  	browser selectClass: Interval.
  	self assert: browser editSelection = #editClass.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectClassEditSelectionWhenEditingMetaclass (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectClassEditSelectionWhenEditingMetaclass (in category 'as yet unclassified') -----
  testSelectClassEditSelectionWhenEditingMetaclass
  	browser selectSystemCategory: Heap category.
  	browser selectClass: Heap.
  	browser metaClassIndicated: true.
  	browser messageListIndex: 0.
  	browser messageListIndex: 0.
  	
  	browser selectClass: Interval.
  	self assert: browser editSelection = #editClass.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectClassEditSelectionWhenMsgSelected (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectClassEditSelectionWhenMsgSelected (in category 'as yet unclassified') -----
  testSelectClassEditSelectionWhenMsgSelected
  	browser selectSystemCategory: Heap category.
  	browser selectClass: Heap.
  	browser selectMessageCategoryNamed: 'adding'.
  	browser messageListIndex: (browser messageList indexOf: #add:).
  	
  	browser selectClass: Interval.
  	self assert: browser editSelection = #editMessage.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectClassEditSelectionWhenNoMsgButCatSelected (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectClassEditSelectionWhenNoMsgButCatSelected (in category 'as yet unclassified') -----
  testSelectClassEditSelectionWhenNoMsgButCatSelected
  	browser selectSystemCategory: Heap category.
  	browser selectClass: Heap.
  	browser selectMessageCategoryNamed: 'adding'.
  	browser messageListIndex: 0.
  	
  	browser selectClass: Interval.
  	self assert: browser editSelection = #newMessage.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectClassNamed (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectClassNamed (in category 'as yet unclassified') -----
  testSelectClassNamed
  	browser selectSystemCategory: browser class category.
  	browser selectClassNamed: browser class name.
  	self assert: browser selectedClassName = browser class name.
  	
  	browser selectClassNamed: nil.
  	self assert: browser selectedClassName isNil.
  	
  	browser selectClassNamed: browser class name asString.
  	self assert: browser selectedClassName = browser class name.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectClassNamedPreservesPlace (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectClassNamedPreservesPlace (in category 'as yet unclassified') -----
  testSelectClassNamedPreservesPlace
  	| commonCategory commonSelector otherClass |
  	browser selectSystemCategory: browser class category.
  	otherClass := HierarchyBrowser. "Unlikely to move out of Browser's package!!"
  	browser selectClassNamed: browser class name.
  	
  	commonCategory := (browser class organization categories intersection: otherClass organization categories) detect: [ :each | each == #'class list' ].
  	commonSelector := #classList.
  	browser selectMessageCategoryNamed: commonCategory.
  	browser selectMessageNamed: commonSelector.
  
  	browser selectClass: otherClass.
  	
  	self assert: browser selectedClassName = otherClass name.
  	self assert: browser selectedMessageCategoryName = commonCategory.
  	self assert: browser selectedMessageName = commonSelector.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectClassReselectsMessage (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectClassReselectsMessage (in category 'as yet unclassified') -----
  testSelectClassReselectsMessage
  	"Colections-Sequences contains a number of classes with similar protocols. In particular, several classes have a method called #add: in a category 'adding'."
  	| selectedMsgCat selectedMethod |
  	selectedMsgCat := 'adding'.
  	selectedMethod := #add:.
  	browser selectSystemCategory: Heap category.
  	browser selectClass: Heap.
  	browser selectMessageCategoryNamed: selectedMsgCat.
  	browser messageListIndex: (browser messageList indexOf: selectedMethod).
  	
  	browser selectClass: Interval.
  	
  	self assert: browser selectedMessageCategoryName = selectedMsgCat.
  	self assert: browser selectedMessageName = selectedMethod.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectClassSelectsClass (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectClassSelectsClass (in category 'as yet unclassified') -----
  testSelectClassSelectsClass
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	self assert: browser classListIndex ~= 0.
  	self assert: browser selectedClass = browser class.
  	self assert: browser selectedClassName = browser class name.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectClassWhenNothingSelected (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectClassWhenNothingSelected (in category 'as yet unclassified') -----
  testSelectClassWhenNothingSelected
  	self assert: browser editSelection = #none.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectMessageCategoryEditSelection (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectMessageCategoryEditSelection (in category 'as yet unclassified') -----
  testSelectMessageCategoryEditSelection
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	browser selectMessageCategoryNamed: browser messageCategoryList first.
  	
  	self assert: browser editSelection = #newMessage.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectMessageCategoryEditSelectionNoMsgCat (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectMessageCategoryEditSelectionNoMsgCat (in category 'as yet unclassified') -----
  testSelectMessageCategoryEditSelectionNoMsgCat
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  .
  	browser messageCategoryListIndex: 0.
  	
  	self assert: browser editSelection = #editClass.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectMessageCategoryEditSelectionNoMsgCatNoClass (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectMessageCategoryEditSelectionNoMsgCatNoClass (in category 'as yet unclassified') -----
  testSelectMessageCategoryEditSelectionNoMsgCatNoClass
  	browser selectSystemCategory: browser class category.
  	browser selectClass: nil.
  .
  	browser messageCategoryListIndex: 0.
  	
  	self assert: browser editSelection = #newClass.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectMessageCategoryNamed (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectMessageCategoryNamed (in category 'as yet unclassified') -----
  testSelectMessageCategoryNamed
  	| catName |
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	
  	catName := browser messageCategoryList anyOne.
  	browser selectMessageCategoryNamed: catName.
  	self assert: browser selectedMessageCategoryName = catName.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectMessageNamed (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectMessageNamed (in category 'as yet unclassified') -----
  testSelectMessageNamed
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	browser messageCategoryListIndex: 1.
  
  	browser selectMessageNamed: browser messageList first.
  	self assert: browser selectedMessageName = browser messageList first.
  	self assert: browser messageListIndex = 1.
  		
  	browser selectMessageNamed: nil.
  	self assert: browser selectedMessageName isNil.
  	self assert: browser messageListIndex = 0.
  	
  	browser selectMessageNamed: browser messageList second.
  	self assert: browser selectedMessageName = browser messageList second.
  	self assert: browser messageListIndex = 2.
  	
  	browser selectMessageNamed: browser messageList first asString.
  	self assert: browser selectedMessageName = browser messageList first.
  	self assert: browser messageListIndex = 1.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectedClass (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectedClass (in category 'as yet unclassified') -----
  testSelectedClass
  	browser selectSystemCategory: browser class category.
  	browser classListIndex: 0.
  	self assert: browser classListIndex = 0.
  	self assert: browser selectedClass isNil.
  	
  	browser classListIndex: 1.
  	self assert: browser classListIndex = 1.
  	self assert: browser selectedClass notNil.!

Item was changed:
+ ----- Method: BrowserTest>>testSelectedEnvironment (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectedEnvironment (in category 'as yet unclassified') -----
  testSelectedEnvironment
  	browser selectSystemCategory: browser class category.
  	self assert: browser selectedEnvironment = Smalltalk globals.
  	
  	"browser selectSystemCategory: nil.
  	self assert: browser selectedEnvironment isNil."
  	"selectedClass would not work in a hierarchy browser that has to display classes from different environments (because the correct categories might be missing)"!

Item was changed:
+ ----- Method: BrowserTest>>testSelectedSystemCategory (in category 'tests') -----
- ----- Method: BrowserTest>>testSelectedSystemCategory (in category 'as yet unclassified') -----
  testSelectedSystemCategory
  	| cat newCat |
  	cat := browser systemCategoryList first.
  	newCat := browser systemCategoryList second.
  	browser selectSystemCategory: cat.
  	self assert:	browser selectedSystemCategory = cat.
  		
  	browser systemCategoryListIndex: 2.
  	self assert:	browser selectedSystemCategory = newCat.!

Item was changed:
+ ----- Method: BrowserTest>>testShowHomeCategory (in category 'tests') -----
- ----- Method: BrowserTest>>testShowHomeCategory (in category 'as yet unclassified') -----
  testShowHomeCategory
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	"Select '--all--'."
  	browser selectMessageCategoryNamed: browser messageCategoryList first.
  	browser selectMessageNamed: browser messageList first.
  	
  	browser showHomeCategory.
  	self assert: browser messageCategoryListIndex > 1.!

Item was changed:
+ ----- Method: BrowserTest>>testSpawnHierarchy (in category 'tests') -----
- ----- Method: BrowserTest>>testSpawnHierarchy (in category 'as yet unclassified') -----
  testSpawnHierarchy
  	| spawn |
  	browser selectSystemCategory: browser class category.
  	browser selectClass: browser class.
  	browser selectMessageCategoryNamed: browser messageCategoryList last.
  	browser messageListIndex: (browser messageList size).
  
  	spawn := browser spawnHierarchy.
  	[self assert: spawn selectedSystemCategory = browser selectedSystemCategory.
  	self assert: spawn selectedClassName = browser selectedClassName.
  	self assert: spawn selectedMessageCategoryName = browser selectedMessageCategoryName.
  	self assert: spawn messageListIndex = browser messageListIndex.]
  		ensure: [ ToolBuilder default close: spawn topView ].!

Item was changed:
+ ----- Method: BrowserTest>>testSystemCategoryListIndex (in category 'tests') -----
- ----- Method: BrowserTest>>testSystemCategoryListIndex (in category 'as yet unclassified') -----
  testSystemCategoryListIndex
  	| oldCat |
  	
  	browser systemCategoryListIndex: 1.
  	oldCat := browser selectedSystemCategory.
  	self assert:	browser selectedSystemCategory = browser systemCategoryList first.
  		
  	browser systemCategoryListIndex: 2.
  	self deny: browser selectedSystemCategory = oldCat.
  	self assert:	browser selectedSystemCategory = browser systemCategoryList second.!




More information about the Packages mailing list