Frank Shearar uploaded a new version of Tests to project The Trunk:
http://source.squeak.org/trunk/Tests-fbs.215.mcz ==================== Summary ==================== Name: Tests-fbs.215 Author: fbs Time: 21 May 2013, 9:52:02.152 am UUID: f5e29e62-1a29-4996-a567-3d548fad4642 Ancestors: Tests-fbs.214 Tests for the Environment-friendly SystemNavigation. =============== Diff against Tests-fbs.214 =============== Item was added: + TestCase subclass: #SystemNavigationTest + instanceVariableNames: 'sysNav env' + classVariableNames: '' + poolDictionaries: '' + category: 'Tests-System-Support'! Item was added: + ----- Method: SystemNavigationTest>>createClass: (in category 'as yet unclassified') ----- + createClass: aSymbol + | builder | + builder := ClassBuilder new. + ^ builder + name: aSymbol + inEnvironment: env + subclassOf: Object + type: #normal + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'Test'.! Item was added: + ----- Method: SystemNavigationTest>>createTrait: (in category 'as yet unclassified') ----- + createTrait: aSymbol + ^ Trait + named: aSymbol + uses: #() + category: 'Traits' + env: env.! Item was added: + ----- Method: SystemNavigationTest>>setUp (in category 'as yet unclassified') ----- + setUp + | g p t | + env := Environment named: 'test'. + g := self createClass: #Griffle. + p := self createClass: #Plonk. + g compile: 'foo ^ 1'. + g compile: 'bar ^ 1'. + p compile: 'foo ^ 2'. + t := self createTrait: #TGriffle. + t compile: 'baz ^ Griffle new foo + Plonk new bar'. + self createClass: #Unused. + sysNav := SystemNavigation for: env.! Item was added: + ----- Method: SystemNavigationTest>>testAllClassesDoShouldIterateOverClassesInAnEnvironment (in category 'as yet unclassified') ----- + testAllClassesDoShouldIterateOverClassesInAnEnvironment + | classes | + classes := OrderedCollection new. + sysNav allClassesDo: [:cls | + classes add: cls]. + self assert: env allClasses equals: classes asArray.! Item was added: + ----- Method: SystemNavigationTest>>testAllClassesShouldReturnEnvironmentsClasses (in category 'as yet unclassified') ----- + testAllClassesShouldReturnEnvironmentsClasses + self assert: env allClasses equals: sysNav allClasses.! Item was added: + ----- Method: SystemNavigationTest>>testAllImplementedMessagesWithout (in category 'as yet unclassified') ----- + testAllImplementedMessagesWithout + self assert: #(bar baz) asSet + equals: (sysNav allImplementedMessagesWithout: {{env at: #Griffle}. {#foo}}).! Item was added: + ----- Method: SystemNavigationTest>>testAllImplementorsOf (in category 'as yet unclassified') ----- + testAllImplementorsOf + self assert: (OrderedCollection + with: (MethodReference class: (env at: #Griffle) selector: #foo) + with: (MethodReference class: (env at: #Plonk) selector: #foo)) + equals: (sysNav allImplementorsOf: #foo).! Item was added: + ----- Method: SystemNavigationTest>>testAllSentMessagesWithout (in category 'as yet unclassified') ----- + testAllSentMessagesWithout + self assert: #(foo bar) asSet , Smalltalk presumedSentMessages , Smalltalk specialSelectors + equals: (sysNav allSentMessagesWithout: {{env at: #Griffle}. {#+}}).! Item was added: + ----- Method: SystemNavigationTest>>testAllUnusedClassesWithout (in category 'as yet unclassified') ----- + testAllUnusedClassesWithout + self assert: (IdentitySet with: #Unused) equals: ((SystemNavigation for: env) allUnusedClassesWithout: {{}. {}}). + "The classes passed to #allUnusedClassesWithout: are not filtered from the list. They're classes whose methods are not examined for global references." + self deny: ((SystemNavigation for: env) allUnusedClassesWithout: {{#Unused}. {}}) isEmpty description: 'Where did Unused go?'.! Item was added: + ----- Method: SystemNavigationTest>>testDefaultAllClassesAndTraitsShouldReturnTopEnvironmentClassesAndTraits (in category 'as yet unclassified') ----- + testDefaultAllClassesAndTraitsShouldReturnTopEnvironmentClassesAndTraits + self assert: Smalltalk allClassesAndTraits equals: SystemNavigation default allClassesAndTraits.! Item was added: + ----- Method: SystemNavigationTest>>testDefaultAllClassesShouldReturnTopEnvironmentClasses (in category 'as yet unclassified') ----- + testDefaultAllClassesShouldReturnTopEnvironmentClasses + self assert: Smalltalk allClasses equals: SystemNavigation default allClasses.! |
Free forum by Nabble | Edit this page |