The Trunk: Tools-ar.161.mcz

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

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

Name: Tools-ar.161
Author: ar
Time: 4 January 2010, 5:08:32 am
UUID: 7a97b7b4-2e60-ec4b-b31a-0ddeefd8358b
Ancestors: Tools-ar.160

Making tests unloadable: Move tests from Tools to ToolsTests.

=============== Diff against Tools-ar.160 ===============

Item was changed:
  SystemOrganization addCategory: #'Tools-ArchiveViewer'!
  SystemOrganization addCategory: #'Tools-Base'!
  SystemOrganization addCategory: #'Tools-Browser'!
- SystemOrganization addCategory: #'Tools-Browser-Tests'!
  SystemOrganization addCategory: #'Tools-Changes'!
  SystemOrganization addCategory: #'Tools-Debugger'!
- SystemOrganization addCategory: #'Tools-Debugger-Tests'!
  SystemOrganization addCategory: #'Tools-Explorer'!
  SystemOrganization addCategory: #'Tools-File Contents Browser'!
  SystemOrganization addCategory: #'Tools-FileList'!
- SystemOrganization addCategory: #'Tools-FileList-Tests'!
  SystemOrganization addCategory: #'Tools-Inspector'!
  SystemOrganization addCategory: #'Tools-Process Browser'!

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

Item was removed:
- ----- Method: DummyToolWorkingWithFileList class>>fileReaderServicesForFile:suffix: (in category 'class initialization') -----
- fileReaderServicesForFile: fullName suffix: suffix
-
- ^ (suffix = 'kkk')
- ifTrue: [ self services]
- ifFalse: [#()] !

Item was removed:
- ----- Method: BrowseTest>>testBrowseInstance (in category 'testing') -----
- testBrowseInstance
- "self debug: #testBrowseInstance"
- | browsersBefore browsersAfter opened |
- self ensureMorphic.
-
- browsersBefore := self currentBrowsers.
- 1 browse.
- browsersAfter := self currentBrowsers.
-
- self assert:  (browsersAfter size  = (browsersBefore size + 1)).
- opened := browsersAfter removeAll: browsersBefore; yourself.
- self assert:  (opened size = 1).
- opened := opened asArray first.
- self assert: (opened model selectedClass == SmallInteger).
-
- opened delete
-
-
- !

Item was removed:
- ----- Method: DebuggerUnwindBug>>testUnwindBlock (in category 'as yet unclassified') -----
- testUnwindBlock
- "test if unwind blocks work properly"
- | sema process |
- sema := Semaphore forMutualExclusion.
- self assert: sema isSignaled.
- "deadlock on the semaphore"
- process := [sema critical:[sema wait]] forkAt: Processor userInterruptPriority.
- self deny: sema isSignaled.
- "terminate process"
- process terminate.
- self assert: sema isSignaled.
- !

Item was removed:
- ----- Method: BrowseTest>>testBrowseMetaclass (in category 'testing') -----
- testBrowseMetaclass
- "self debug: #testBrowseMetaclass"
- | browsersBefore browsersAfter opened |
- self ensureMorphic.
-
- browsersBefore := self currentBrowsers.
- 1 class class browse.
- browsersAfter := self currentBrowsers.
-
- self assert:  (browsersAfter size  = (browsersBefore size + 1)).
- opened := browsersAfter removeAll: browsersBefore; yourself.
- self assert:  (opened size = 1).
- opened := opened asArray first.
- self assert: (opened model selectedClass == Metaclass).
-
- opened delete
-
-
- !

Item was removed:
- ----- Method: FileListTest>>testToolRegistered (in category 'test') -----
- testToolRegistered
- "(self selector: #testToolRegistered) debug"
-
- self assert: (FileList registeredFileReaderClasses includes: DummyToolWorkingWithFileList)!

Item was removed:
- ----- Method: FileList2ModalDialogsTest>>testModalFileSelectorForSuffixes (in category 'running') -----
- testModalFileSelectorForSuffixes
- | window fileList2 |
- window := FileList2 morphicViewFileSelectorForSuffixes: nil.
- window openCenteredInWorld.
- fileList2 := window valueOfProperty: #fileListModel.
- fileList2 fileListIndex: 1.
- window delete.
- self assert: fileList2 getSelectedFile isNil.
- fileList2 okHit.
- self deny: fileList2 getSelectedFile isNil
- !

Item was removed:
- ----- Method: FileListTest>>checkIsServiceIsFromDummyTool: (in category 'private') -----
- checkIsServiceIsFromDummyTool: service
-
- ^ (service instVarNamed: #provider) = DummyToolWorkingWithFileList
- & service label = 'menu label'
- & (service instVarNamed: #selector) = #loadAFileForTheDummyTool:!

Item was removed:
- ----- Method: FileListTest>>testToolRegisteredUsingInterface (in category 'test') -----
- testToolRegisteredUsingInterface
- "(self selector: #testToolRegisteredUsingInterface) debug"
-
- self assert: (FileList isReaderNamedRegistered: #DummyToolWorkingWithFileList)!

Item was removed:
- ----- Method: DummyToolWorkingWithFileList class>>initialize (in category 'class initialization') -----
- initialize
- "self initialize"
-
- FileList registerFileReader: self
-
- !

Item was removed:
- ----- Method: MethodReferenceTest>>testEquals (in category 'Running') -----
- testEquals
- | aMethodReference anotherMethodReference |
- aMethodReference := MethodReference new.
- anotherMethodReference := MethodReference new.
- "
- two fresh instances should be equals between them"
- self
- should: [aMethodReference = anotherMethodReference].
- self
- should: [aMethodReference hash = anotherMethodReference hash].
- "
- two instances representing the same method (same class and  
- same selector) should be equals"
- aMethodReference setStandardClass: String methodSymbol: #foo.
- anotherMethodReference setStandardClass: String methodSymbol: #foo.
- self
- should: [aMethodReference = anotherMethodReference].
- self
- should: [aMethodReference hash = anotherMethodReference hash] !

Item was removed:
- ----- Method: BrowseTest>>ensureMorphic (in category 'private') -----
- ensureMorphic
- self isMorphic ifFalse: [self error: 'This test should be run in Morphic'].!

Item was removed:
- ----- Method: BrowserHierarchicalListTest>>testListClassesHierarchicallyIndent (in category 'tests') -----
- testListClassesHierarchicallyIndent
-
- | result dict  |
- result := self hierarchicalClassListForCategory: 'Tools-Browser'.
- "Create class->indent mapping"
- dict := result inject: Dictionary new into: [:classIndentMapping :className |
- | indent |
- 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 removed:
- ----- Method: FileListTest>>testServicesForFileEnding (in category 'test') -----
- testServicesForFileEnding
- "(self selector: #testServicesForFileEnding) debug"
-
- self assert: (((FileList new directory: FileDirectory default; yourself) itemsForFile: 'aaa.kkk') anySatisfy: [ :ea | self checkIsServiceIsFromDummyTool: ea ]).
- !

Item was removed:
- ----- Method: BrowseTest>>testBrowseHierarchyClass (in category 'testing') -----
- testBrowseHierarchyClass
- "self debug: #testBrowseHierarchyClass"
- | browsersBefore browsersAfter opened |
- self ensureMorphic.
-
- browsersBefore := self currentHierarchyBrowsers.
- 1 class browseHierarchy.
- browsersAfter := self currentHierarchyBrowsers.
-
- self assert:  (browsersAfter size  = (browsersBefore size + 1)).
- opened := browsersAfter removeAll: browsersBefore; yourself.
- self assert:  (opened size = 1).
- opened := opened asArray first.
- self assert: (opened model selectedClass == SmallInteger).
-
- opened delete
-
-
- !

Item was removed:
- ----- Method: DebuggerUnwindBug>>testUnwindDebugger (in category 'as yet unclassified') -----
- testUnwindDebugger
- "test if unwind blocks work properly when a debugger is closed"
- | sema process debugger top |
- sema := Semaphore forMutualExclusion.
- self assert: sema isSignaled.
- process := [sema critical:[sema wait]] forkAt: Processor userInterruptPriority.
- self deny: sema isSignaled.
-
- "everything set up here - open a debug notifier"
- debugger := Debugger openInterrupt: 'test' onProcess: process.
- "get into the debugger"
- debugger debug.
- top := debugger topView.
- "set top context"
- debugger toggleContextStackIndex: 1.
- "close debugger"
- top delete.
-
- "and see if unwind protection worked"
- self assert: sema isSignaled.!

Item was removed:
- ----- Method: BrowseTest>>currentBrowsers (in category 'private') -----
- currentBrowsers
- ^ (ActiveWorld submorphs
- select: [:each | (each isKindOf: SystemWindow)
- and: [each model isKindOf: Browser]]) asSet!

Item was removed:
- ----- Method: FileList2ModalDialogsTest>>testModalFolderSelectorForProjectLoad (in category 'running') -----
- testModalFolderSelectorForProjectLoad
- | window fileList2 w |
- window := FileList2
- morphicViewProjectLoader2InWorld: self currentWorld
- reallyLoad: false.
- fileList2 := window valueOfProperty: #FileList.
- w := self currentWorld.
- window position: w topLeft + (w extent - window extent // 2).
- window openInWorld: w.
- window delete.
- self assert: fileList2 getSelectedDirectory withoutListWrapper isNil.
- fileList2 okHit.
- self deny: fileList2 getSelectedDirectory withoutListWrapper isNil
- !

Item was removed:
- Object subclass: #DummyToolWorkingWithFileList
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Tools-FileList-Tests'!
-
- !DummyToolWorkingWithFileList commentStamp: '<historical>' prior: 0!
- I'm a dummy class for testing that the registration of the tool to the FileList of actually happens.
- In the future the tests should cover that the class register when loaded in memory and unregister when unloaded.!

Item was removed:
- 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 removed:
- TestCase subclass: #FileList2ModalDialogsTest
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Tools-FileList-Tests'!
-
- !FileList2ModalDialogsTest commentStamp: '<historical>' prior: 0!
- TestRunner open!

Item was removed:
- ----- Method: FileListTest>>testService (in category 'test') -----
- testService
- "a stupid test to check that the class returns a service"
- "(self selector: #testService) debug"
-
- | service |
- service := (DummyToolWorkingWithFileList fileReaderServicesForFile: 'abab.kkk' suffix: 'kkk') first.
- self assert: (self checkIsServiceIsFromDummyTool: service).
- service := (DummyToolWorkingWithFileList fileReaderServicesForFile: 'zkk.gz' suffix: 'gz').
- self assert: service isEmpty!

Item was removed:
- ----- 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 removed:
- ----- Method: BrowseTest>>tearDown (in category 'running') -----
- tearDown
- | systemNavigation |
- systemNavigation := SystemNavigation default.
- systemNavigation browserClass: originalBrowserClass.
- systemNavigation hierarchyBrowserClass: originalHierarchyBrowserClass.!

Item was removed:
- ----- Method: MethodReferenceTest>>testNotEquals (in category 'Running') -----
- testNotEquals
- | aMethodReference anotherMethodReference |
- aMethodReference := MethodReference new.
- anotherMethodReference := MethodReference new.
- ""
- aMethodReference setStandardClass: String methodSymbol: #foo.
- anotherMethodReference setStandardClass: String class methodSymbol: #foo.
- "
- differente classes, same selector -> no more equals"
- self
- shouldnt: [aMethodReference = anotherMethodReference].
- "
- same classes, diferente selector -> no more equals"
- anotherMethodReference setStandardClass: String methodSymbol: #bar.
- self
- shouldnt: [aMethodReference = anotherMethodReference] !

Item was removed:
- ----- Method: BrowseTest>>isMorphic (in category 'private') -----
- isMorphic
- ^Smalltalk isMorphic!

Item was removed:
- ----- 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 removed:
- ClassTestCase subclass: #MethodReferenceTest
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Tools-Browser-Tests'!

Item was removed:
- TestCase subclass: #DebuggerUnwindBug
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Tools-Debugger-Tests'!

Item was removed:
- ----- Method: BrowseTest>>currentHierarchyBrowsers (in category 'private') -----
- currentHierarchyBrowsers
- ^ (ActiveWorld submorphs
- select: [:each | (each isKindOf: SystemWindow)
- and: [each model isKindOf: HierarchyBrowser]]) asSet!

Item was removed:
- ----- 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 removed:
- ----- Method: FileListTest>>testMenuReturned (in category 'test') -----
- testMenuReturned
- "(self selector: #testToolRegistered) debug"
-
- self assert: (FileList registeredFileReaderClasses includes: DummyToolWorkingWithFileList)!

Item was removed:
- ----- Method: FileListTest>>tearDown (in category 'initialize') -----
- tearDown
-
- DummyToolWorkingWithFileList unregister.!

Item was removed:
- ----- 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.!

Item was removed:
- ----- Method: DummyToolWorkingWithFileList class>>serviceLoadAFilForDummyTool (in category 'class initialization') -----
- serviceLoadAFilForDummyTool
- "Answer a service for opening the Dummy tool"
-
- ^ SimpleServiceEntry
- provider: self
- label: 'menu label'
- selector: #loadAFileForTheDummyTool:
- description: 'Menu label for dummy tool'
- buttonLabel: 'test'!

Item was removed:
- ----- Method: DummyToolWorkingWithFileList class>>unregister (in category 'class initialization') -----
- unregister
-
- FileList unregisterFileReader: self.
- !

Item was removed:
- ----- Method: FileListTest>>testAllRegisteredServices (in category 'test') -----
- testAllRegisteredServices
- "(self selector: #testAllRegisteredServices) debug"
-
- self shouldnt: [FileList allRegisteredServices] raise: Error!

Item was removed:
- ----- Method: BrowseTest>>setUp (in category 'running') -----
- setUp
- | systemNavigation |
- systemNavigation := SystemNavigation default.
- originalBrowserClass := systemNavigation browserClass.
- originalHierarchyBrowserClass := systemNavigation hierarchyBrowserClass.
-
- systemNavigation browserClass: nil.
- systemNavigation hierarchyBrowserClass: nil.
-
- !

Item was removed:
- ----- Method: DummyToolWorkingWithFileList class>>services (in category 'class initialization') -----
- services
-
- ^ Array with: self serviceLoadAFilForDummyTool
-
- !

Item was removed:
- ----- Method: DummyToolWorkingWithFileList class>>loadAFileForTheDummyTool: (in category 'class initialization') -----
- loadAFileForTheDummyTool: aFileListOrAPath
-
- "attention. if the file list selects a file the argument will be a fullpath of the selected file else it will pass the filelist itself"!

Item was removed:
- ----- Method: BrowseTest>>testBrowseClass (in category 'testing') -----
- testBrowseClass
- "self debug: #testBrowseClass"
- | browsersBefore browsersAfter opened |
- self ensureMorphic.
-
- browsersBefore := self currentBrowsers.
- 1 class browse.
- browsersAfter := self currentBrowsers.
-
- self assert:  (browsersAfter size  = (browsersBefore size + 1)).
- opened := browsersAfter removeAll: browsersBefore; yourself.
- self assert:  (opened size = 1).
- opened := opened asArray first.
- self assert: (opened model selectedClass == SmallInteger).
-
- opened delete
-
-
- !

Item was removed:
- ClassTestCase subclass: #FileListTest
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Tools-FileList-Tests'!

Item was removed:
- ----- Method: DummyToolWorkingWithFileList class>>unload (in category 'class initialization') -----
- unload
-
- FileList unregisterFileReader: self !

Item was removed:
- ----- Method: FileList2ModalDialogsTest>>testModalFolderSelector (in category 'running') -----
- testModalFolderSelector
- | window fileList2 |
- window := FileList2 morphicViewFolderSelector.
- fileList2 := window model.
- window openInWorld: self currentWorld extent: 300@400.
- fileList2 fileListIndex: 1.
- window delete.
- self assert: fileList2 getSelectedDirectory withoutListWrapper isNil.
- fileList2 okHit.
- self deny: fileList2 getSelectedDirectory withoutListWrapper isNil
-
- !

Item was removed:
- TestCase subclass: #BrowseTest
- instanceVariableNames: 'originalBrowserClass originalHierarchyBrowserClass'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'Tools-Browser-Tests'!

Item was removed:
- ----- Method: FileListTest>>setUp (in category 'initialize') -----
- setUp
-
- DummyToolWorkingWithFileList initialize.!

Item was removed:
- ----- Method: BrowseTest>>testBrowseHierarchyInstance (in category 'testing') -----
- testBrowseHierarchyInstance
- "self debug: #testBrowseHierarchyInstance"
- | browsersBefore browsersAfter opened |
- self ensureMorphic.
-
- browsersBefore := self currentHierarchyBrowsers.
- 1 browseHierarchy.
- browsersAfter := self currentHierarchyBrowsers.
-
- self assert:  (browsersAfter size  = (browsersBefore size + 1)).
- opened := browsersAfter removeAll: browsersBefore; yourself.
- self assert:  (opened size = 1).
- opened := opened asArray first.
- self assert: (opened model selectedClass == SmallInteger).
-
- opened delete
-
-
- !

Item was removed:
- ----- Method: DebuggerUnwindBug>>testUnwindDebuggerWithStep (in category 'as yet unclassified') -----
- testUnwindDebuggerWithStep
- "test if unwind blocks work properly when a debugger is closed"
- | sema process debugger top |
- sema := Semaphore forMutualExclusion.
- self assert: sema isSignaled.
- process := [sema critical:[sema wait]] forkAt: Processor userInterruptPriority.
- self deny: sema isSignaled.
-
- "everything set up here - open a debug notifier"
- debugger := Debugger openInterrupt: 'test' onProcess: process.
- "get into the debugger"
- debugger debug.
- top := debugger topView.
- "set top context"
- debugger toggleContextStackIndex: 1.
- "do single step"
- debugger doStep.
- "close debugger"
- top delete.
-
- "and see if unwind protection worked"
- self assert: sema isSignaled.!

Item was removed:
- ----- Method: FileList2ModalDialogsTest>>testModalFileSelector (in category 'running') -----
- testModalFileSelector
- | window fileList2 |
- window := FileList2 morphicViewFileSelector.
- window openCenteredInWorld.
- fileList2 := window valueOfProperty: #fileListModel.
- fileList2 fileListIndex: 1.
- window delete.
- self assert: fileList2 getSelectedFile isNil.
- fileList2 okHit.
- self deny: fileList2 getSelectedFile isNil
-
-
- !

Item was removed:
- ----- Method: BrowseTest>>testBrowseHierarchyMataclass (in category 'testing') -----
- testBrowseHierarchyMataclass
- "self debug: #testBrowseHierarchyMataclass"
- | browsersBefore browsersAfter opened |
- self ensureMorphic.
-
- browsersBefore := self currentHierarchyBrowsers.
- 1 class class browseHierarchy.
- browsersAfter := self currentHierarchyBrowsers.
-
- self assert:  (browsersAfter size  = (browsersBefore size + 1)).
- opened := browsersAfter removeAll: browsersBefore; yourself.
- self assert:  (opened size = 1).
- opened := opened asArray first.
- self assert: (opened model selectedClass == Metaclass).
-
- opened delete
-
-
- !