[squeak-dev] The Trunk: Tools-ar.119.mcz

Andreas Raab uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-ar.119.mcz

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

Name: Tools-ar.119
Author: ar
Time: 25 August 2009, 8:27:33 am
UUID: 192ec68d-b450-a04a-bc6c-91459b08dacc
Ancestors: Tools-ar.118, Tools-rkrk.113

Merged Tools-rkrk.113:

Adding tests for optional hierarchical class ordering in Browser introduced in Tools-rkrk.111.

=============== Diff against Tools-ar.118 ===============

Item was added:
+ ----- Method: BrowserHierarchicalListTest>>nameToClass: (in category 'helper') -----
+ nameToClass: classNameWithIndent
+
+ ^ Smalltalk classNamed: classNameWithIndent withoutLeadingBlanks asSymbol!

Item was added:
+ ----- Method: BrowserHierarchicalListTest>>testListClassesHierarchicallyIndent (in category 'tests') -----
+ testListClassesHierarchicallyIndent
+
+ | result dict indent |
+ result := self hierarchicalClassListForCategory: 'Tools-Browser'.
+ "Create class->indent mapping"
+ dict := result inject: Dictionary new into: [:classIndentMapping :className |
+ indent := className count: [:char | char = Character space or: [char = Character tab]].
+ classIndentMapping at: (self nameToClass: className) put: indent.
+ classIndentMapping].
+ "assert that indent of class is larger than indent of superclass"
+ dict keysAndValuesDo: [:class :myIndent |
+ dict at: class superclass ifPresent: [:superIndent |
+ self assert: myIndent > superIndent]].!

Item was added:
+ TestCase subclass: #BrowserHierarchicalListTest
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Tools-Browser-Tests'!
+
+ !BrowserHierarchicalListTest commentStamp: 'rkrk 8/24/2009 05:11' prior: 0!
+ Tests the optional hierarchical class ordering of Browser.!

Item was added:
+ ----- Method: BrowserHierarchicalListTest>>testListClassesHierarchically2 (in category 'tests') -----
+ testListClassesHierarchically2
+
+ | result classes category |
+ category := 'Tools-Browser'.
+ result := self hierarchicalClassListForCategory: category.
+ self assert: (SystemOrganization listAtCategoryNamed: category) size equals: result size.
+ classes := result collect: [:ea | self nameToClass: ea].
+ classes withIndexDo: [:ea : i |
+ classes
+ from: 1 to: i
+ do: [:other | self assertCorrectOrderOf: other followedBy: ea in: classes]].!

Item was added:
+ ----- Method: BrowserHierarchicalListTest>>hierarchicalClassListForCategory: (in category 'helper') -----
+ hierarchicalClassListForCategory: category
+
+ | b index |
+ b := Browser new.
+ index := b systemCategoryList indexOf: category.
+ b systemCategoryListIndex: index.
+ ^ b hierarchicalClassList.
+ !

Item was added:
+ ----- Method: BrowserHierarchicalListTest>>testListClassesHierarchically1 (in category 'tests') -----
+ testListClassesHierarchically1
+
+ | result classes category |
+ category := 'Collections-Abstract'.
+ result := self hierarchicalClassListForCategory: category.
+ self assert: (SystemOrganization listAtCategoryNamed: category) size equals: result size.
+ classes := result collect: [:ea | self nameToClass: ea].
+ classes withIndexDo: [:ea : i |
+ classes
+ from: 1 to: i
+ do: [:other | self assertCorrectOrderOf: other followedBy: ea in: classes]].!

Item was added:
+ ----- Method: BrowserHierarchicalListTest>>assertCorrectOrderOf:followedBy:in: (in category 'assertion') -----
+ assertCorrectOrderOf: classB followedBy: classA in: classCollection
+
+ "classB comes before classA. Assert that classB is a superclass of classB or that
+ a common superclass is in front of both"
+ | commonSuperclasses commonSuperclass classAIndex classBIndex superIndex |
+ classA == classB ifTrue: [^ self].
+ (classA inheritsFrom: classB) ifTrue: [^ self].
+ commonSuperclasses := classA withAllSuperclasses intersection: classB withAllSuperclasses.
+ commonSuperclass := commonSuperclasses first.
+ (classCollection includes: commonSuperclass) ifFalse: [^ self].
+ classAIndex := classCollection indexOf: classA.
+ classBIndex := classCollection indexOf: classB.
+ superIndex := classCollection indexOf: commonSuperclass.
+ (superIndex < classAIndex and: [superIndex < classBIndex]) ifTrue: [^self].
+ self fail.!