[squeak-dev] The Trunk: ToolsTests-ar.2.mczcommits at source.squeak.org commits at source.squeak.orgMon Jan 4 15:26:25 UTC 2010
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 at 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'!
More information about the Squeak-dev mailing list |