'From Squeak3.6beta of ''4 July 2003'' [latest update: #5419] on 10 September 2003 at 6:58:41 pm'! "Change Set: KCP-103-t-GeneralizeTheUseOfTheNewInitializePattern Date: 10 September 2003 Author: Noury Bouraqadi Replaces KCP-102-t-GeneralizeTheUseOfTheNewInitializePattern Tests that the pattern new-initialize (#new and #new: send initialize to every new instance) is correctly installed. There should be only one method #new which code is 'new ^self basicNew initialize'. Same, there should be only one methode #new: which code is 'new: size ^(self basicNew: size) initialize'. There should be no method #new (respectively #new:) initializing an instance created by a message 'super new' (respectively 'super new:')"! TestCase subclass: #SelfBasicNewInitializePatternTest instanceVariableNames: 'navigator desiredNewMethod desiredVariableNewMethod unwantedNewMethod unwantedVariableNewMethod ' classVariableNames: '' poolDictionaries: '' category: 'Test self basicNew initialize Pattern'! !SelfBasicNewInitializePatternTest methodsFor: 'Running' stamp: 'Noury Bouraqadi 9/10/2003 17:18'! buildCompiledMethodFromSource: aString ^self buildCompiledMethodInContext: Behavior fromSource: aString ! ! !SelfBasicNewInitializePatternTest methodsFor: 'Running' stamp: 'Noury Bouraqadi 9/10/2003 17:17'! buildCompiledMethodInContext: class fromSource: aString | parseTree | parseTree _ class parserClass new parse: aString class: class. ^parseTree generate: #(0 0 0 0). ! ! !SelfBasicNewInitializePatternTest methodsFor: 'Running'! copiesOfMethod: referenceMethod named: selector | methReferences | methReferences _ navigator allImplementorsOf: selector. ^methReferences select: [:methRef| |meth| meth := methRef actualClass compiledMethodAt: selector. meth = referenceMethod]! ! !SelfBasicNewInitializePatternTest methodsFor: 'Running' stamp: 'Noury Bouraqadi 9/10/2003 17:25'! copiesOfParseTreeOfMethod: referenceMethod named: selector | methReferences | methReferences _ navigator allImplementorsOf: selector. ^methReferences select: [:methRef| |source meth| source := methRef actualClass sourceCodeAt: selector. meth := self buildCompiledMethodFromSource: source. meth = referenceMethod]! ! !SelfBasicNewInitializePatternTest methodsFor: 'Running'! setUp navigator _ SystemNavigation new. desiredNewMethod _ self buildCompiledMethodFromSource: 'new ^self basicNew initialize'. desiredVariableNewMethod _ self buildCompiledMethodFromSource: 'new: size ^(self basicNew: size) initialize'. unwantedNewMethod _ self buildCompiledMethodFromSource: 'new ^super new initialize'. unwantedVariableNewMethod _ self buildCompiledMethodFromSource: 'new: size ^(super new: size) initialize'! ! !SelfBasicNewInitializePatternTest methodsFor: 'Running'! testNewDoInitialize | currentNewMethod | currentNewMethod _ Behavior compiledMethodAt: #new. self assert: currentNewMethod = desiredNewMethod! ! !SelfBasicNewInitializePatternTest methodsFor: 'Running'! testNoNewDoSuperInitialize | copies | copies _ self copiesOfParseTreeOfMethod: unwantedNewMethod named: #new. self assert: copies size = 0! ! !SelfBasicNewInitializePatternTest methodsFor: 'Running'! testNoVariableNewDoSuperInitialize | copies | copies _ self copiesOfParseTreeOfMethod: unwantedVariableNewMethod named: #new:. self assert: copies size = 0! ! !SelfBasicNewInitializePatternTest methodsFor: 'Running' stamp: 'Noury Bouraqadi 8/24/2003 21:07'! testUnicityOfNewDoingInitialize | copies | copies _ self copiesOfMethod: desiredNewMethod named: #new. self assert: copies size = 1; assert: (copies first actualClass == Behavior)! ! !SelfBasicNewInitializePatternTest methodsFor: 'Running'! testUnicityOfVariableNewDoingInitialize | copies | copies _ self copiesOfMethod: desiredVariableNewMethod named: #new:. self assert: copies size = 1; assert: (copies first actualClass == Behavior)! ! !SelfBasicNewInitializePatternTest methodsFor: 'Running' stamp: 'Noury Bouraqadi 8/24/2003 21:02'! testVariableNewDoInitialize | currentVariableNewMethod | currentVariableNewMethod _ Behavior compiledMethodAt: #new:. self assert: currentVariableNewMethod = desiredVariableNewMethod! !