The Trunk: ToolsTests-ar.2.mcz

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

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

Name: ToolsTests-ar.2
Author: ar
Time: 4 January 2010, 4:26:20 am
UUID: e70bc3ec-3685-f44e-af3b-33f6d08dac9d
Ancestors: ToolsTests-nice.1

Making Tests unloadable: Move tests from Tools package into ToolsTests.

=============== Diff against ToolsTests-nice.1 ===============

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: FileListTest>>setUp (in category 'initialize') -----
+ setUp
+
+ DummyToolWorkingWithFileList initialize.!

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

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

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

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

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

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

Item was added:
+ ----- 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 added:
+ ----- Method: DummyToolWorkingWithFileList class>>services (in category 'class initialization') -----
+ services
+
+ ^ Array with: self serviceLoadAFilForDummyTool
+
+ !

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

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: BrowseTest>>currentBrowsers (in category 'private') -----
+ currentBrowsers
+ ^ (ActiveWorld submorphs
+ select: [:each | (each isKindOf: SystemWindow)
+ and: [each model isKindOf: Browser]]) asSet!

Item was added:
+ ClassTestCase subclass: #MethodReferenceTest
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolsTests-Browser'!

Item was added:
+ ----- 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 added:
+ TestCase subclass: #BrowseTest
+ instanceVariableNames: 'originalBrowserClass originalHierarchyBrowserClass'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolsTests-Browser'!

Item was added:
+ ----- 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 added:
+ SystemOrganization addCategory: #'ToolsTests-Browser'!
+ SystemOrganization addCategory: #'ToolsTests-Debugger'!
+ SystemOrganization addCategory: #'ToolsTests-FileList'!
+ SystemOrganization addCategory: #'ToolsTests-Inspector'!

Item was added:
+ ----- 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 added:
+ ----- Method: DummyToolWorkingWithFileList class>>fileReaderServicesForFile:suffix: (in category 'class initialization') -----
+ fileReaderServicesForFile: fullName suffix: suffix
+
+ ^ (suffix = 'kkk')
+ ifTrue: [ self services]
+ ifFalse: [#()] !

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

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

Item was added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: FileListTest>>checkIsServiceIsFromDummyTool: (in category 'private') -----
+ checkIsServiceIsFromDummyTool: service
+
+ ^ (service instVarNamed: #provider) = DummyToolWorkingWithFileList
+ & service label = 'menu label'
+ & (service instVarNamed: #selector) = #loadAFileForTheDummyTool:!

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

Item was added:
+ ClassTestCase subclass: #FileListTest
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolsTests-FileList'!

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

Item was added:
+ ----- 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 added:
+ TestCase subclass: #DebuggerUnwindBug
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolsTests-Debugger'!

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

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

Item was added:
+ Object subclass: #DummyToolWorkingWithFileList
+ instanceVariableNames: ''
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'ToolsTests-FileList'!
+
+ !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 added:
+ ----- 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 added:
+ ----- 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 added:
+ ----- Method: BrowseTest>>isMorphic (in category 'private') -----
+ isMorphic
+ ^Smalltalk isMorphic!

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

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: 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 added:
+ ----- 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 added:
+ ----- 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 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: DummyToolWorkingWithFileList class>>initialize (in category 'class initialization') -----
+ initialize
+ "self initialize"
+
+ FileList registerFileReader: self
+
+ !

Item was added:
+ ----- 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 added:
+ ----- 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
+
+
+ !

Item was added:
+ ----- 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:
- SystemOrganization addCategory: #'ToolsTests-Inspector'!