Eliot Miranda uploaded a new version of SUnit to project The Trunk: http://source.squeak.org/trunk/SUnit-eem.93.mcz
==================== Summary ====================
Name: SUnit-eem.93 Author: eem Time: 27 March 2013, 12:34:18.106 pm UUID: daa99dec-920c-4091-978e-600a5d57deb3 Ancestors: SUnit-cmm.92
Move ClassTestCase to SUnit-Extensions from Tests.
=============== Diff against SUnit-cmm.92 ===============
Item was added: + TestCase subclass: #ClassTestCase + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'SUnit-Extensions'! + + !ClassTestCase commentStamp: 'brp 7/26/2003 16:57' prior: 0! + This class is intended for unit tests of individual classes and their metaclasses. + + It provides methods to determine the coverage of the unit tests. + + Subclasses are expected to re-implement #classesToBeTested and #selectorsToBeIgnored. + + They should also implement to confirm that all methods have been tested. + + #testCoverage + + super testCoverage. + + !
Item was added: + ----- Method: ClassTestCase class>>isAbstract (in category 'Testing') ----- + isAbstract + "Override to true if a TestCase subclass is Abstract and should not have + TestCase instances built from it" + + ^self name = #ClassTestCase + !
Item was added: + ----- Method: ClassTestCase class>>mustTestCoverage (in category 'Testing') ----- + mustTestCoverage + + ^ false!
Item was added: + ----- Method: ClassTestCase>>categoriesForClass: (in category 'private') ----- + categoriesForClass: aClass + + ^ aClass organization allMethodSelectors collect: + [:each | aClass organization categoryOfElement: each]. + !
Item was added: + ----- Method: ClassTestCase>>classToBeTested (in category 'coverage') ----- + classToBeTested + + self subclassResponsibility!
Item was added: + ----- Method: ClassTestCase>>selectorsNotTested (in category 'coverage') ----- + selectorsNotTested + + ^ self selectorsToBeTested difference: self selectorsTested. + !
Item was added: + ----- Method: ClassTestCase>>selectorsTested (in category 'Coverage') ----- + selectorsTested + | literals | + literals := Set new. + self class + selectorsAndMethodsDo: [ :s :m | (s beginsWith: 'test') + ifTrue: [ literals addAll: (m messages)] ]. + ^ literals asSortedArray!
Item was added: + ----- Method: ClassTestCase>>selectorsToBeIgnored (in category 'coverage') ----- + selectorsToBeIgnored + ^ #(#DoIt #DoItIn:)!
Item was added: + ----- Method: ClassTestCase>>selectorsToBeTested (in category 'coverage') ----- + selectorsToBeTested + + ^ ( { self classToBeTested. self classToBeTested class } gather: [:c | c selectors]) + difference: self selectorsToBeIgnored!
Item was added: + ----- Method: ClassTestCase>>targetClass (in category 'private') ----- + targetClass + |className| + + className := self class name asText copyFrom: 0 to: self class name size - 4. + ^ Smalltalk at: (className asString asSymbol). + !
Item was added: + ----- Method: ClassTestCase>>testClassComment (in category 'tests') ----- + testClassComment + self shouldnt: [self targetClass organization hasNoComment].!
Item was added: + ----- Method: ClassTestCase>>testCoverage (in category 'tests') ----- + testCoverage + + | untested | + self class mustTestCoverage ifTrue: + [ untested := self selectorsNotTested. + self assert: untested isEmpty + description: untested size asString, ' selectors are not covered' ]!
Item was added: + ----- Method: ClassTestCase>>testNew (in category 'tests') ----- + testNew + self shouldnt: [self targetClass new] raise: Error.!
Item was added: + ----- Method: ClassTestCase>>testUnCategorizedMethods (in category 'tests') ----- + testUnCategorizedMethods + | categories slips | + categories := self categoriesForClass: self targetClass. + slips := categories select: [:each | each = #'as yet unclassified']. + self should: [slips isEmpty]. !