'From Squeak3.6beta of ''4 July 2003'' [latest update: #5419] on 18 September 2003 at 5:57:31 pm'! "Change Set: KCP-103-GeneralizeTheUseOfTheNewInitializePattern Date: 16 September 2003 Author: Noury Bouraqadi Partially replaces KCP-102 since it introduces the pattern new-initialize and does not alter variable objects creation (i.e. definition of #new: remains unchanged). Also, delete all obsolete definitions of new and initialize. This latter task is performed using classes provided by classes of the ObsoleteMethodTest hierarchy, that are removed afterwards (see the postscript)."! TestCase subclass: #ObsoleteMethodTest instanceVariableNames: 'targetClass ' classVariableNames: '' poolDictionaries: '' category: 'Tests-Compatibility'! !ObsoleteMethodTest commentStamp: 'Noury Bouraqadi 9/16/2003 17:49' prior: 0! Fails if the target class (iv targeClass) holds an obsolete method. Patterns of obsolete methods should be provided by subclasses as methods which selector begins with 'obsolete'. Selector of obsolete method should be given by the #obsoleteMethodSelector class method (to override in subclasses). ! ObsoleteMethodTest subclass: #EmptyInitializeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tests-Compatibility'! !EmptyInitializeTest commentStamp: 'Noury Bouraqadi 9/16/2003 17:47' prior: 0! This is a test which is run on all classes in the system (except Object) to detect obsolete or otherwise considered invalid implementations of #initialize. It provides a set of patterns against which all implementations of #initialize are run. To add a new pattern provide a method beginning with #obsolete such as #obsoleteStrangeInitializeTest.! ObsoleteMethodTest subclass: #NewInitializeTest instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Tests-Compatibility'! !NewInitializeTest commentStamp: 'Noury Bouraqadi 9/16/2003 17:47' prior: 0! NewInitializeTest is a test which is run on all classes in the system to detect obsolete or otherwise considered invalid implementations of #new. It provides a set of patterns against which all implementations of #new are run. To add a new pattern provide a method beginning with #obsolete such as #obsoleteStrangeNewTest.! !Object methodsFor: 'initialize-release' stamp: 'Noury Bouraqadi 8/23/2003 14:51'! initialize "Subclasses should redefine this method to perform initializations on instance creation"! ! !Behavior methodsFor: 'instance creation'! new "Answer a new initialized instance of the receiver (which is a class) with no indexable variables. Fail if the class is indexable." ^ self basicNew initialize ! ! !ObsoleteMethodTest methodsFor: 'printing'! printOn: aStream aStream nextPutAll: self class printString; nextPutAll: '>>#'; nextPutAll: testSelector. self targetClass ifNotNil: [aStream nextPutAll: ' for '; nextPutAll: self targetClass name]! ! !ObsoleteMethodTest methodsFor: 'private'! copySuperedMethod: aMethod "Create a copy of a potentially supered method" | copy nLits lastLit | copy := aMethod copyWithTrailerBytes: #(0 0 0 0). "regular" nLits := aMethod numLiterals. nLits > 0 ifTrue: [lastLit := copy literalAt: nLits. (lastLit isVariableBinding and: [lastLit value == self class]) ifTrue: [copy literalAt: nLits put: nil -> self targetClass class]]. ^copy! ! !ObsoleteMethodTest methodsFor: 'private' stamp: 'Noury Bouraqadi 9/16/2003 12:48'! patterns "Answer all the methods implementing one of the obsolete #new methods" | list | list := IdentityDictionary new. self class selectorsAndMethodsDo:[:sel :meth| (sel beginsWith: 'obsolete') ifTrue:[ list at: sel put: (self copySuperedMethod: meth)]]. ^list! ! !ObsoleteMethodTest methodsFor: 'tests'! testObsoleteMethod "Test if the implementation of obsoleteMethod matches any of the patterns defined in this test" | aMethod | aMethod := self targetClass compiledMethodAt: self class obsoleteMethodSelector ifAbsent: [^self]. "allow the test to succeed if (for example) the method was removed" self patterns keysAndValuesDo: [:obsoleteSelector :obsoleteMethod | self deny: aMethod = obsoleteMethod]! ! !ObsoleteMethodTest methodsFor: 'accessing' stamp: 'Noury Bouraqadi 9/16/2003 15:48'! targetClass ^targetClass! ! !ObsoleteMethodTest methodsFor: 'accessing' stamp: 'Noury Bouraqadi 9/16/2003 15:48'! targetClass: aClass targetClass := aClass! ! !EmptyInitializeTest methodsFor: 'patterns' stamp: 'Noury Bouraqadi 9/16/2003 13:01'! obsoleteAnsweringSuperInitialize ^super initialize ! ! !EmptyInitializeTest methodsFor: 'patterns' stamp: 'Noury Bouraqadi 9/16/2003 12:59'! obsoleteEmptyInitialize "Should be implemented only by Object"! ! !EmptyInitializeTest methodsFor: 'patterns' stamp: 'Noury Bouraqadi 9/16/2003 13:00'! obsoleteSuperInitialize super initialize ! ! !NewInitializeTest methodsFor: 'patterns' stamp: 'ar 9/16/2003 00:16'! obsoleteSelfBasicNewInitialize "This pattern is obsoleted by Object class>>new" ^self basicNew initialize! ! !NewInitializeTest methodsFor: 'patterns' stamp: 'ar 9/16/2003 00:23'! obsoleteSuperBasicNewInitialize "This pattern is obsoleted by Object class>>new" ^super basicNew initialize! ! !NewInitializeTest methodsFor: 'patterns' stamp: 'ar 9/16/2003 00:22'! obsoleteSuperNew "This is pointless unless specifically documented" ^super new! ! !NewInitializeTest methodsFor: 'patterns' stamp: 'ar 9/16/2003 00:16'! obsoleteSuperNewInitialize "This pattern is obsoleted by Object class>>new" ^super new initialize! ! !NewInitializeTest methodsFor: 'patterns' stamp: 'ar 9/16/2003 00:19'! obsoleteSuperNewInitializeWithTemp "This pattern is obsoleted by Object class>>new" | temp | temp := super new. temp initialize. ^temp! ! !NewInitializeTest methodsFor: 'patterns' stamp: 'ar 9/16/2003 00:20'! obsoleteSuperNewInitializeWithTempDirectly "This pattern is obsoleted by Object class>>new" | temp | temp := super new initialize. ^temp! ! !NewInitializeTest methodsFor: 'patterns' stamp: 'ar 9/16/2003 00:17'! obsoleteSuperNewInitializeYourself "This pattern is obsoleted by Object class>>new" ^(super new) initialize; yourself! ! !ObsoleteMethodTest class methodsFor: 'Instance Creation'! selector: aSelector targetClass: aClass ^(self new) setTestSelector: aSelector; targetClass: aClass; yourself! ! !ObsoleteMethodTest class methodsFor: 'Building Suites'! buildSuite "Construct this test suite from all classes implementing the obsoleteMethod" | suite | suite := self suiteClass named: self name asString. self classesToTest do:[:aClass| (aClass includesSelector: self obsoleteMethodSelector) ifTrue:[ suite addTest: (self selector: self testMethodSelector targetClass: aClass). ]. ]. ^suite! ! !ObsoleteMethodTest class methodsFor: 'Building Suites' stamp: 'Noury Bouraqadi 9/16/2003 12:58'! classesToTest ^Smalltalk allClasses asArray sort:[:cls1 :cls2| cls1 name <= cls2 name]! ! !ObsoleteMethodTest class methodsFor: 'Building Suites' stamp: 'Noury Bouraqadi 9/16/2003 12:53'! obsoleteMethodSelector self subclassResponsibility! ! !ObsoleteMethodTest class methodsFor: 'Building Suites'! testMethodSelector ^#testObsoleteMethod! ! !EmptyInitializeTest class methodsFor: 'Building Suites' stamp: 'Noury Bouraqadi 9/16/2003 13:16'! classesToTest "Its Ok if Object has a method #initialize" ^super classesToTest copyWithout: Object! ! !EmptyInitializeTest class methodsFor: 'Building Suites' stamp: 'Noury Bouraqadi 9/16/2003 12:56'! obsoleteMethodSelector ^#initialize! ! !NewInitializeTest class methodsFor: 'Building Suites' stamp: 'Noury Bouraqadi 9/16/2003 15:07'! classesToTest ^super classesToTest collect: [:aClass| aClass class]! ! !NewInitializeTest class methodsFor: 'Building Suites' stamp: 'Noury Bouraqadi 9/16/2003 12:53'! obsoleteMethodSelector ^#new! ! NewInitializeTest class removeSelector: #buildSuite! NewInitializeTest class removeSelector: #obsoleteMethodselector! NewInitializeTest class removeSelector: #selector:targetClass:! NewInitializeTest class removeSelector: #testMethodSelector! NewInitializeTest class removeSelector: #testMethodselector! EmptyInitializeTest class removeSelector: #testMethodSelector! ObsoleteMethodTest class removeSelector: #obsoleteMethodselector! ObsoleteMethodTest class removeSelector: #testMethodselector! NewInitializeTest removeSelector: #copySuperedMethod:! NewInitializeTest removeSelector: #patterns! NewInitializeTest removeSelector: #printOn:! NewInitializeTest removeSelector: #setTargetClass:! NewInitializeTest removeSelector: #testObsoleteNew! ObsoleteMethodTest removeSelector: #setTargetClass:! ObsoleteMethodTest removeSelector: #testObsoleteNew! !ObsoleteMethodTest reorganize! ('printing' printOn:) ('private' copySuperedMethod: patterns) ('tests' testObsoleteMethod) ('accessing' targetClass targetClass:) ! "Postscript: Noury Bouraqadi 9/16/2003 16:51. Delete obsolete definitions of new and initialize. This task is performed using classes of the ObsoleteMethodTest hierarchy. These classes are be deleted once the task is performed" |classesToRemove categoriesToRemove| {NewInitializeTest. EmptyInitializeTest} do: [:testClass| |suite testsFailed| suite _ testClass buildSuite. testsFailed _ suite run failures. testsFailed do: [:test| test targetClass removeSelector: test class obsoleteMethodSelector]]. classesToRemove _ {NewInitializeTest. EmptyInitializeTest. ObsoleteMethodTest}. categoriesToRemove _ classesToRemove asSet collect: [:class| class category]. classesToRemove do: [:classToRemove| classToRemove removeFromChanges; removeFromSystemUnlogged]. categoriesToRemove do: [:category| (SystemOrganization listAtCategoryNamed: category) isEmpty ifTrue: [ SystemOrganization removeCategory: category]]!