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.!