[squeak-dev] The Trunk: ToolsTests-fbs.38.mcz
commits at source.squeak.org
commits at source.squeak.org
Fri Apr 15 22:35:15 UTC 2011
Levente Uzonyi uploaded a new version of ToolsTests to project The Trunk:
http://source.squeak.org/trunk/ToolsTests-fbs.38.mcz
==================== Summary ====================
Name: ToolsTests-fbs.38
Author: fbs
Time: 31 March 2011, 9:53:12.097 am
UUID: 73e23739-61db-3240-be83-85fc0e677397
Ancestors: ToolsTests-fbs.37
When you view a class comment, and switch classes, you must still be viewing a class comment.
=============== Diff against ToolsTests-tbn.5 ===============
Item was changed:
----- Method: BrowserHierarchicalListTest>>hierarchicalClassListForCategory: (in category 'helper') -----
hierarchicalClassListForCategory: category
+ ^ Browser new
+ selectSystemCategory: category;
+ hierarchicalClassList.!
- | b index |
- b := Browser new.
- index := b systemCategoryList indexOf: category.
- b systemCategoryListIndex: index.
- ^ b hierarchicalClassList.
- !
Item was added:
+ TestCase subclass: #BrowserTest
+ instanceVariableNames: 'browser'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolsTests-Browser'!
+
+ !BrowserTest commentStamp: 'fbs 3/4/2011 07:22' prior: 0!
+ I provide the test suite for Browser.
+ !
Item was added:
+ ----- Method: BrowserTest>>setUp (in category 'as yet unclassified') -----
+ setUp
+ browser := Browser new.!
Item was added:
+ ----- Method: BrowserTest>>testAlphabetizeMessageCategories (in category 'as yet unclassified') -----
+ testAlphabetizeMessageCategories
+ browser selectSystemCategory: browser class category.
+ self deny: browser alphabetizeMessageCategories.
+
+ browser selectClass: browser class.
+ browser metaClassIndicated: false.
+ self assert: browser alphabetizeMessageCategories.
+ self assert: browser classOrMetaClassOrganizer categories isSorted.
+
+ browser metaClassIndicated: true.
+ self assert: browser alphabetizeMessageCategories.
+ self assert: browser classOrMetaClassOrganizer categories isSorted.!
Item was added:
+ ----- 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 added:
+ ----- 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 ].!
Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: BrowserTest>>testFlattenHierarchyTreeOnIndent (in category 'as yet unclassified') -----
+ testFlattenHierarchyTreeOnIndent
+ | flatten |
+ flatten := [:coll | browser
+ flattenHierarchyTree: (browser createHierarchyTreeOf: coll)
+ on: OrderedCollection new
+ indent: ''].
+ "Empty collection."
+ self assert: (flatten value: #()) isEmpty.
+ "Single class."
+ self assert: (OrderedCollection with: 'Browser') = (flatten value: {Browser}).
+ "Single class + subclass."
+ self assert: (OrderedCollection with: 'Browser' with: ' HierarchyBrowser') = (flatten value: {Browser. HierarchyBrowser}).
+ "Single class + 2 subclasses"
+ self assert: (OrderedCollection with: 'Browser' with: ' HierarchyBrowser' with: ' FileContentsBrowser') = (flatten value: { Browser. HierarchyBrowser. FileContentsBrowser. }).
+ "Superclass, class, subclass"
+ self assert: (OrderedCollection with: 'CodeHolder' with: ' Browser' with: ' HierarchyBrowser') = (flatten value: { CodeHolder. Browser. HierarchyBrowser. }).
+ "Two 'unrelated' classes"
+ self assert: (OrderedCollection with: 'Browser' with: 'SmallInteger') = (flatten value: { Browser. SmallInteger }).
+ "Two 'unrelated' classes and a common ancestor"
+ self assert: (OrderedCollection with: 'Browser' with: 'SmallInteger' with: 'ProtoObject') = (flatten value: { Browser. SmallInteger. ProtoObject }).!
Item was added:
+ ----- Method: BrowserTest>>testFlattenHierarchyTreeOnIndentBy (in category 'as yet unclassified') -----
+ testFlattenHierarchyTreeOnIndentBy
+ | flatten |
+ flatten := [:coll | browser
+ flattenHierarchyTree: (browser createHierarchyTreeOf: coll)
+ on: OrderedCollection new
+ indent: '' by: 'x'].
+ "Empty collection."
+ self assert: (flatten value: #()) isEmpty.
+ "Single class."
+ self assert: (OrderedCollection with: 'Browser') = (flatten value: {Browser}).
+ "Single class + subclass."
+ self assert: (OrderedCollection with: 'Browser' with: 'xHierarchyBrowser') = (flatten value: {Browser. HierarchyBrowser}).
+ "Single class + 2 subclasses"
+ self assert: (OrderedCollection with: 'Browser' with: 'xHierarchyBrowser' with: 'xFileContentsBrowser') = (flatten value: { Browser. HierarchyBrowser. FileContentsBrowser. }).
+ "Superclass, class, subclass"
+ self assert: (OrderedCollection with: 'CodeHolder' with: 'xBrowser' with: 'xxHierarchyBrowser') = (flatten value: { CodeHolder. Browser. HierarchyBrowser. }).
+ "Two 'unrelated' classes"
+ self assert: (OrderedCollection with: 'Browser' with: 'SmallInteger') = (flatten value: { Browser. SmallInteger }).
+ "Two 'unrelated' classes and a common ancestor"
+ self assert: (OrderedCollection with: 'Browser' with: 'SmallInteger' with: 'ProtoObject') = (flatten value: { Browser. SmallInteger. ProtoObject }).!
Item was added:
+ ----- Method: BrowserTest>>testGetSystemCategoryListIndex (in category 'as yet unclassified') -----
+ testGetSystemCategoryListIndex
+ | cat |
+ cat := SystemOrganization categories first.
+ browser selectSystemCategory: cat.
+ self assert: browser systemCategoryListIndex = (SystemOrganization categories indexOf: browser selectedSystemCategory).!
Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: BrowserTest>>testMessageCategoryList (in category 'as yet unclassified') -----
+ testMessageCategoryList
+ browser selectSystemCategory: browser class category.
+ browser selectClass: browser class.
+
+ self assert: browser messageCategoryList = ({ClassOrganizer allCategory}, browser class organization categories).
+
+ browser selectClass: nil.
+ self assert: browser messageCategoryList = #().
+
+ browser selectClass: browser class.
+ browser metaClassIndicated: true.
+ self assert: browser messageCategoryList = ({ClassOrganizer allCategory}, browser class classSide organization categories).!
Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: BrowserTest>>testSelectClassEditSelectionNoClass (in category 'as yet unclassified') -----
+ testSelectClassEditSelectionNoClass
+ browser selectSystemCategory: browser class category.
+
+ browser selectClass: nil.
+ self assert: browser editSelection = #newClass.!
Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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) first.
+ commonSelector := (otherClass organization allMethodSelectors intersection: browser class organization allMethodSelectors) first.
+ 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: BrowserTest>>testSelectClassWhenNothingSelected (in category 'as yet unclassified') -----
+ testSelectClassWhenNothingSelected
+ self assert: browser editSelection = #none.!
Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: BrowserTest>>testSelectedEnvironment (in category 'as yet unclassified') -----
+ testSelectedEnvironment
+ browser selectSystemCategory: browser class category.
+ self assert: browser selectedEnvironment = Smalltalk.
+
+ browser selectSystemCategory: nil.
+ self assert: browser selectedEnvironment isNil.!
Item was added:
+ ----- Method: BrowserTest>>testSelectedSystemCategory (in category 'as yet unclassified') -----
+ testSelectedSystemCategory
+ | cat newCat |
+ cat := SystemOrganization categories first.
+ newCat := SystemOrganization categories second.
+ browser selectSystemCategory: cat.
+ self assert: browser selectedSystemCategory = cat.
+
+ browser systemCategoryListIndex: 2.
+ self assert: browser selectedSystemCategory = newCat.!
Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: BrowserTest>>testSystemCategoryListIndex (in category 'as yet unclassified') -----
+ testSystemCategoryListIndex
+ | oldCat |
+
+ browser systemCategoryListIndex: 1.
+ oldCat := browser selectedSystemCategory.
+ self assert: browser selectedSystemCategory = SystemOrganization categories first.
+
+ browser systemCategoryListIndex: 2.
+ self deny: browser selectedSystemCategory = oldCat.
+ self assert: browser selectedSystemCategory = SystemOrganization categories second.!
Item was added:
+ TestCase subclass: #FileContentsBrowserTest
+ instanceVariableNames: 'browser'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolsTests-Browser'!
Item was added:
+ ----- Method: FileContentsBrowserTest>>expectedFailures (in category 'as yet unclassified') -----
+ expectedFailures
+ ^ #(testChangeMessageCategoriesLeavesClassSelected) "See Mantis #7615"!
Item was added:
+ ----- Method: FileContentsBrowserTest>>setUp (in category 'as yet unclassified') -----
+ setUp
+ | fileout testCat package packageDict organizer |
+ testCat := self class category.
+ fileout := ReadWriteStream on: (String new: 10000).
+ SystemOrganization fileOutCategory: testCat on: fileout.
+
+ packageDict := Dictionary new.
+ browser := FileContentsBrowser new.
+ organizer := SystemOrganizer defaultList: Array new.
+ package := (FilePackage new fullName: testCat; fileInFrom: fileout).
+ packageDict
+ at: package packageName
+ put: package.
+ organizer
+ classifyAll: package classes keys
+ under: package packageName.
+ (browser := FileContentsBrowser systemOrganizer: organizer)
+ packages: packageDict.!
Item was added:
+ ----- Method: FileContentsBrowserTest>>testChangeMessageCategoriesLeavesClassSelected (in category 'as yet unclassified') -----
+ testChangeMessageCategoriesLeavesClassSelected
+ browser selectSystemCategory: browser systemCategoryList first.
+ browser selectClassNamed: browser classList first.
+
+ "This is a no-op."
+ browser changeMessageCategories: browser classOrMetaClassOrganizer printString.
+ self assert: browser selectedClassName = browser class name.!
Item was added:
+ TestCase subclass: #HierarchyBrowserTest
+ instanceVariableNames: 'browser'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolsTests-Browser'!
Item was added:
+ ----- Method: HierarchyBrowserTest>>setUp (in category 'as yet unclassified') -----
+ setUp
+ browser := HierarchyBrowser new.!
Item was added:
+ ----- Method: HierarchyBrowserTest>>testClassList (in category 'as yet unclassified') -----
+ testClassList
+ | c displayedClasses hierarchy |
+ browser initHierarchyForClass: browser class.
+
+ c := browser class theNonMetaClass.
+ displayedClasses := browser classList collect: [:each | each withoutLeadingBlanks ].
+ hierarchy := (c allSuperclasses reversed, {browser class}, c allSubclasses) collect: [ :each | each name ].
+ self assert: displayedClasses = hierarchy.!
Item was added:
+ ----- Method: HierarchyBrowserTest>>testClassListIndex (in category 'as yet unclassified') -----
+ testClassListIndex
+ | expectedCat |
+ expectedCat := [:i | (Smalltalk at: (browser classList at: i) withoutLeadingBlanks asSymbol) category ].
+ browser initHierarchyForClass: browser class.
+ self deny: browser classListIndex = 0.
+
+ 1 to: 3 do:
+ [:n |
+ browser classListIndex: n.
+ self assert: browser classListIndex = n.
+ self assert: browser selectedSystemCategory = (expectedCat value: n)]!
Item was added:
+ ----- Method: HierarchyBrowserTest>>testClassListSansWhitespace (in category 'as yet unclassified') -----
+ testClassListSansWhitespace
+ | c displayedClasses hierarchy |
+ browser initHierarchyForClass: browser class.
+
+ c := browser class theNonMetaClass.
+ displayedClasses := browser classList collect: [:each | each withoutLeadingBlanks ].
+ hierarchy := (c allSuperclasses reversed, {browser class}, c allSubclasses) collect: [ :each | each name ].
+ self assert: displayedClasses = hierarchy.!
Item was added:
+ ----- Method: HierarchyBrowserTest>>testInitHierarchyForClass (in category 'as yet unclassified') -----
+ testInitHierarchyForClass
+ | b |
+
+ b := HierarchyBrowser new initHierarchyForClass: browser class.
+ self assert: b selectedClassName = browser class name.!
Item was added:
+ ----- Method: HierarchyBrowserTest>>testSelectClass (in category 'as yet unclassified') -----
+ testSelectClass
+ browser initHierarchyForClass: browser class.
+ browser selectClass: ProtoObject.
+ self assert: browser selectedClass = ProtoObject.
+
+ browser selectClass: CodeHolder.
+ self assert: browser selectedClass = CodeHolder.!
Item was added:
+ ----- Method: HierarchyBrowserTest>>testSelectedClassName (in category 'as yet unclassified') -----
+ testSelectedClassName
+ browser initHierarchyForClass: browser class.
+ self assert: browser selectedClassName = browser class name.
+
+ browser classListIndex: 0.
+ self assert: browser selectedClassName isNil.!
Item was added:
+ TestCase subclass: #MessageNamesTest
+ instanceVariableNames: 'browser'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolsTests-Browser'!
Item was added:
+ ----- Method: MessageNamesTest>>setUp (in category 'as yet unclassified') -----
+ setUp
+ browser := MessageNames openMessageNames.!
Item was added:
+ ----- Method: MessageNamesTest>>tearDown (in category 'as yet unclassified') -----
+ tearDown
+ ToolBuilder default close: browser topView.!
Item was added:
+ ----- Method: MessageNamesTest>>testCannotUnselectCategory (in category 'as yet unclassified') -----
+ testCannotUnselectCategory
+ | selectorList |
+ browser searchString: 'cull'.
+ browser selectorListIndex: 1.
+ selectorList := browser selectorList copy.
+
+ browser selectorListIndex: 0.
+ self assert: selectorList = browser selectorList.!
Item was added:
+ ----- Method: MessageNamesTest>>testOpenMessageNames (in category 'as yet unclassified') -----
+ testOpenMessageNames
+ | b |
+ b := MessageNames openMessageNames.
+ [self assert: (b isKindOf: MessageNames)]
+ ensure: [ToolBuilder default close: b topView].!
Item was added:
+ ----- Method: MessageNamesTest>>testSearchString (in category 'as yet unclassified') -----
+ testSearchString
+ | cCount cullCount cullCullCount |
+ browser searchString: 'c'.
+ cCount := browser selectorList size.
+
+ browser searchString: 'cull:'.
+ cullCount := browser selectorList size.
+
+ self assert: cullCount < cCount.
+
+ browser searchString: 'cull:cull:'.
+ cullCullCount := browser selectorList size.
+
+ self assert: cullCullCount < cullCount.!
Item was added:
+ ----- Method: MessageNamesTest>>testSelectedClassOrMetaClass (in category 'as yet unclassified') -----
+ testSelectedClassOrMetaClass
+ | firstClass |
+ browser searchString: 'cull'.
+ firstClass := browser messageList first actualClass.
+
+ browser messageListIndex: 1.
+ self assert: browser selectedClassOrMetaClass = firstClass.
+
+ browser messageListIndex: 0.
+ self assert: browser selectedClassOrMetaClass isNil.
+
+ "And just to be sure:"
+ browser messageListIndex: 1.
+ self assert: browser selectedClassOrMetaClass = firstClass.!
Item was added:
+ ----- Method: MessageNamesTest>>testSelectedMessageCategoryName (in category 'as yet unclassified') -----
+ testSelectedMessageCategoryName
+ browser searchString: 'cull'.
+ browser selectorListIndex: 1.
+ browser messageListIndex: 1.
+ self deny: browser selectedMessageCategoryName isNil.
+
+ browser messageListIndex: 0.
+ self assert: browser selectedMessageCategoryName isNil.!
Item was added:
+ ----- Method: MessageNamesTest>>testSelection (in category 'as yet unclassified') -----
+ testSelection
+ browser searchString: 'cull'.
+ browser selectorListIndex: 1.
+ browser messageListIndex: 1.
+ self assert: (browser selection isKindOf: MethodReference).
+ browser messageListIndex: 0.
+ self assert: browser selection isNil.!
Item was added:
+ TestCase subclass: #MessageSetTest
+ instanceVariableNames: 'browser'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolsTests-Browser'!
Item was added:
+ ----- Method: MessageSetTest>>setUp (in category 'as yet unclassified') -----
+ setUp
+ browser := (MessageSet
+ openMessageList: (SystemNavigation default allImplementorsOf: #browseAllImplementorsOf:)
+ name: 'Test MessageSet'
+ autoSelect: nil) model.!
Item was added:
+ ----- Method: MessageSetTest>>tearDown (in category 'as yet unclassified') -----
+ tearDown
+ ToolBuilder default close: browser topView.!
Item was added:
+ ----- Method: MessageSetTest>>testContents (in category 'as yet unclassified') -----
+ testContents
+ browser messageListIndex: 0.
+ self assert: browser contents = ''.
+
+ browser messageListIndex: 1.
+ self deny: browser contents = ''.
+ !
Item was added:
+ ----- Method: MessageSetTest>>testHasMessageSelected (in category 'as yet unclassified') -----
+ testHasMessageSelected
+ browser messageListIndex: 1.
+ self assert: browser hasMessageSelected.
+
+ browser messageListIndex: 0.
+ self deny: browser hasMessageSelected.
+
+ "And just to be sure:"
+ browser messageListIndex: 1.
+ self assert: browser hasMessageSelected.!
Item was added:
+ ----- Method: MessageSetTest>>testRemoveMessageFromBrowser (in category 'as yet unclassified') -----
+ testRemoveMessageFromBrowser
+ | count sel |
+ browser messageListIndex: 1.
+ sel := browser selection.
+
+ browser removeMessageFromBrowser.
+ self deny: (browser messageList includes: sel) description: 'Method not removed'.
+
+ browser messageListIndex: 0.
+ count := browser messageList size.
+ browser removeMessageFromBrowser.
+ self assert: count = browser messageList size description: 'Some method was removed'.!
Item was added:
+ ----- Method: MessageSetTest>>testSelectedClassOrMetaClass (in category 'as yet unclassified') -----
+ testSelectedClassOrMetaClass
+ | firstClass |
+ firstClass := browser messageList first actualClass.
+
+ browser messageListIndex: 1.
+ self assert: browser selectedClassOrMetaClass = firstClass.
+
+ browser messageListIndex: 0.
+ self assert: browser selectedClassOrMetaClass isNil.
+
+ "And just to be sure:"
+ browser messageListIndex: 1.
+ self assert: browser selectedClassOrMetaClass = firstClass.!
Item was added:
+ ----- Method: MessageSetTest>>testSelectedMessageCategoryName (in category 'as yet unclassified') -----
+ testSelectedMessageCategoryName
+ | firstCat methodRef |
+ methodRef := browser messageList first.
+ firstCat := methodRef actualClass organization categoryOfElement: methodRef selector.
+
+ browser messageListIndex: 1.
+ self assert: browser selectedMessageCategoryName = firstCat.
+
+ browser messageListIndex: 0.
+ self assert: browser selectedMessageCategoryName isNil.
+
+ "And just to be sure:"
+ browser messageListIndex: 1.
+ self assert: browser selectedMessageCategoryName = firstCat.!
Item was added:
+ ----- Method: MessageSetTest>>testSelectedMessageName (in category 'as yet unclassified') -----
+ testSelectedMessageName
+ | firstSel |
+ firstSel := browser messageList first selector.
+
+ browser messageListIndex: 1.
+ self assert: browser selectedMessageName = firstSel.
+
+ browser messageListIndex: 0.
+ self assert: browser selectedMessageName isNil.
+
+ "And just to be sure:"
+ browser messageListIndex: 1.
+ self assert: browser selectedMessageName = firstSel.!
Item was added:
+ ----- Method: MessageSetTest>>testSelection (in category 'as yet unclassified') -----
+ testSelection
+ | firstRef |
+ firstRef := browser messageList first.
+
+ browser messageListIndex: 1.
+ self assert: browser selection = firstRef.
+
+ browser messageListIndex: 0.
+ self assert: browser selection isNil.
+
+ "And just to be sure:"
+ browser messageListIndex: 1.
+ self assert: browser selection = firstRef.!
Item was added:
+ MessageSetTest subclass: #MessageTraceTest
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolsTests-Browser'!
Item was added:
+ ----- Method: MessageTraceTest>>setUp (in category 'as yet unclassified') -----
+ setUp
+ browser := (MessageTrace
+ openMessageList: (SystemNavigation default allImplementorsOf: #browseAllImplementorsOf:)
+ name: 'Test MessageSet'
+ autoSelect: nil) model.!
Item was added:
+ TestCase subclass: #PackagePaneBrowserTest
+ instanceVariableNames: 'browser'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolsTests-Browser'!
Item was added:
+ ----- Method: PackagePaneBrowserTest>>setUp (in category 'as yet unclassified') -----
+ setUp
+ browser := PackagePaneBrowser new.!
Item was added:
+ ----- Method: PackagePaneBrowserTest>>testClassList (in category 'as yet unclassified') -----
+ testClassList
+ browser selectSystemCategory: browser class category.
+ self assert: browser classList = (SystemOrganization listAtCategoryNamed: browser class category).
+
+ browser selectSystemCategory: nil.
+ self assert: browser classList isEmpty.!
Item was added:
+ ----- Method: PackagePaneBrowserTest>>testPackageListIndex (in category 'as yet unclassified') -----
+ testPackageListIndex
+ browser packageListIndex: 0.
+ self assert: browser selectedClass isNil.
+
+ browser selectCategoryForClass: browser class.
+
+ "Clicking the selected package unselects the selected class."
+ browser packageListIndex: browser packageListIndex.
+ self assert: browser selectedClass isNil.!
Item was added:
+ ----- Method: PackagePaneBrowserTest>>testSelectCategoryForClass (in category 'as yet unclassified') -----
+ testSelectCategoryForClass
+ | catName pkgName |
+ pkgName := browser class category copyUpTo: $-.
+ catName := browser class category allButFirst: pkgName size + 1.
+ browser selectCategoryForClass: browser class.
+ self assert: browser selectedSystemCategory = catName.
+ self assert: browser packageListIndex = (browser packageList indexOf: pkgName).
+ browser selectSystemCategory: nil.
+ self assert: browser classList isEmpty.!
More information about the Squeak-dev
mailing list
|