[prev in list] [next in list] [prev in thread] [next in thread]
List: squeak-dev
Subject: [squeak-dev] The Trunk: ToolsTests-pre.85.mcz
From: commits () source ! squeak ! org
Date: 2018-09-26 15:35:20
Message-ID: E1g5BqT-0003xV-RI () andreas
[Download RAW message or body]
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.!
[prev in list] [next in list] [prev in thread] [next in thread]
Configure |
About |
News |
Add a list |
Sponsored by KoreLogic