'From Pharo3.0 of 18 March 2013 [Latest update: #30258] on 9 July 2013 at 6:44:47 pm'! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 18:44'! removeSelector: aSelector "Assuming that the argument, selector (a Symbol), is a message selector in my method dictionary, remove it and its method. If the method to remove will be replaced by a method from my trait composition, the current method does not have to be removed because we mark it as non-local. If it is not identical to the actual method from the trait it will be replaced automatically by #noteChangedSelectors:. This is useful to avoid bootstrapping problems when moving methods to a trait (e.g., from TBehavior to TMethodDictionaryBehavior). Manual moving (implementing the method in the trait and then remove it from the class) does not work if the methods themselves are used for this process (such as compiledMethodAt:, includesLocalSelector: or addTraitSelector:withMethod:)" | changeFromLocalToTraitMethod | changeFromLocalToTraitMethod := (self includesLocalSelector: aSelector) and: [self hasTraitComposition and: [self traitComposition includesMethod: aSelector]]. changeFromLocalToTraitMethod ifFalse: [self basicRemoveSelector: aSelector] ifTrue: [self ensureLocalSelectors]. self deregisterLocalSelector: aSelector. self noteChangedSelectors: (Array with: aSelector) ! ! !TBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 18:44'! removeSelector: aSelector "Assuming that the argument, selector (a Symbol), is a message selector in my method dictionary, remove it and its method. If the method to remove will be replaced by a method from my trait composition, the current method does not have to be removed because we mark it as non-local. If it is not identical to the actual method from the trait it will be replaced automatically by #noteChangedSelectors:. This is useful to avoid bootstrapping problems when moving methods to a trait (e.g., from TBehavior to TMethodDictionaryBehavior). Manual moving (implementing the method in the trait and then remove it from the class) does not work if the methods themselves are used for this process (such as compiledMethodAt:, includesLocalSelector: or addTraitSelector:withMethod:)" | changeFromLocalToTraitMethod | changeFromLocalToTraitMethod := (self includesLocalSelector: aSelector) and: [self hasTraitComposition and: [self traitComposition includesMethod: aSelector]]. changeFromLocalToTraitMethod ifFalse: [self basicRemoveSelector: aSelector] ifTrue: [self ensureLocalSelectors]. self deregisterLocalSelector: aSelector. self noteChangedSelectors: (Array with: aSelector) ! ! !OpenToolTest methodsFor: 'test inspect' stamp: 'SebastianTleye 7/9/2013 18:43'! testInspectTraitClass | inspector | inspector := TBehavior inspector. inspector changed. inspector close.! ! !OpenToolTest methodsFor: 'test browse' stamp: 'SebastianTleye 7/9/2013 18:43'! testOpenBrowseOnTraitMethod | browser | browser := (TBehavior>>#localSelectors) browse. browser changed. browser close.! ! !OpenToolTest methodsFor: 'test inspect' stamp: 'SebastianTleye 7/9/2013 18:43'! testInspectTraitClass | inspector | inspector := TBehavior inspector. inspector changed. inspector close.! ! !OpenToolTest methodsFor: 'test browse' stamp: 'SebastianTleye 7/9/2013 18:43'! testOpenBrowseOnTraitMethod | browser | browser := (TBehavior>>#localSelectors) browse. browser changed. browser close.! ! !TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 18:44'! pureRemoveSelector: aSelector "Assuming that the argument, selector (a Symbol), is a message selector in my method dictionary, remove it and its method. If the method to remove will be replaced by a method from my trait composition, the current method does not have to be removed because we mark it as non-local. If it is not identical to the actual method from the trait it will be replaced automatically by #noteChangedSelectors:. This is useful to avoid bootstrapping problems when moving methods to a trait (e.g., from TBehavior to TMethodDictionaryBehavior). Manual moving (implementing the method in the trait and then remove it from the class) does not work if the methods themselves are used for this process (such as compiledMethodAt:, includesLocalSelector: or addTraitSelector:withMethod:)" | changeFromLocalToTraitMethod | changeFromLocalToTraitMethod := (self includesLocalSelector: aSelector) and: [self hasTraitComposition and: [self traitComposition includesMethod: aSelector]]. changeFromLocalToTraitMethod ifFalse: [self basicRemoveSelector: aSelector] ifTrue: [self ensureLocalSelectors]. self deregisterLocalSelector: aSelector. self noteChangedSelectors: (Array with: aSelector) ! ! !TraitBehavior methodsFor: 'adding/removing methods' stamp: 'SebastianTleye 7/9/2013 18:44'! pureRemoveSelector: aSelector "Assuming that the argument, selector (a Symbol), is a message selector in my method dictionary, remove it and its method. If the method to remove will be replaced by a method from my trait composition, the current method does not have to be removed because we mark it as non-local. If it is not identical to the actual method from the trait it will be replaced automatically by #noteChangedSelectors:. This is useful to avoid bootstrapping problems when moving methods to a trait (e.g., from TBehavior to TMethodDictionaryBehavior). Manual moving (implementing the method in the trait and then remove it from the class) does not work if the methods themselves are used for this process (such as compiledMethodAt:, includesLocalSelector: or addTraitSelector:withMethod:)" | changeFromLocalToTraitMethod | changeFromLocalToTraitMethod := (self includesLocalSelector: aSelector) and: [self hasTraitComposition and: [self traitComposition includesMethod: aSelector]]. changeFromLocalToTraitMethod ifFalse: [self basicRemoveSelector: aSelector] ifTrue: [self ensureLocalSelectors]. self deregisterLocalSelector: aSelector. self noteChangedSelectors: (Array with: aSelector) ! ! !MCClassDefinitionTest methodsFor: 'tests' stamp: 'SebastianTleye 7/9/2013 18:42'! testValidTraitComposition2 "Related to http://code.google.com/p/pharo/issues/detail?id=2148" | d className cls | className := 'MCMockClassC'. d := MCClassDefinition name: className superclassName: 'Object' traitComposition: 'TBehavior' classTraitComposition: '{}' category: self mockCategoryName instVarNames: #() classVarNames: #() poolDictionaryNames: #() classInstVarNames: #() type: #normal comment: (self commentForClass: className) commentStamp: (self commentStampForClass: className). self shouldnt: [d load] raise: Error. self assert: (Smalltalk hasClassNamed: 'MCMockClassC'). cls := Smalltalk at: #MCMockClassC. self assert: (cls includesSelector: #>>). self assert: ((Smalltalk at: #MCMockClassC) traitComposition allTraits includes: TBehavior).! ! !MCClassDefinitionTest methodsFor: 'tests' stamp: 'SebastianTleye 7/9/2013 18:43'! testValidTraitComposition3 "Related to http://code.google.com/p/pharo/issues/detail?id=2148" | d className cls | className := 'MCMockClassC'. d := MCClassDefinition name: className superclassName: 'Object' traitComposition: 'TBehavior + TClassDescription' classTraitComposition: '{}' category: self mockCategoryName instVarNames: #() classVarNames: #() poolDictionaryNames: #() classInstVarNames: #() type: #normal comment: (self commentForClass: className) commentStamp: (self commentStampForClass: className). self shouldnt: [d load] raise: Error. self assert: (Smalltalk hasClassNamed: 'MCMockClassC'). cls := Smalltalk at: #MCMockClassC. self assert: (cls includesSelector: #>>). self assert: (cls includesSelector: #comment). self assert: ((Smalltalk at: #MCMockClassC) traitComposition allTraits includes: TBehavior). self assert: ((Smalltalk at: #MCMockClassC) traitComposition allTraits includes: TClassDescription).! ! !MCClassDefinitionTest methodsFor: 'tests' stamp: 'SebastianTleye 7/9/2013 18:43'! testValidTraitComposition4 "Related to http://code.google.com/p/pharo/issues/detail?id=2598" | d className cls | className := 'MCMockClassC'. d := MCClassDefinition name: className superclassName: 'Object' traitComposition: 'TBehavior - {#>> . #withAllSubclassesDo:}' classTraitComposition: '{}' category: self mockCategoryName instVarNames: #() classVarNames: #() poolDictionaryNames: #() classInstVarNames: #() type: #normal comment: (self commentForClass: className) commentStamp: (self commentStampForClass: className). self shouldnt: [d load] raise: Error. self assert: (Smalltalk hasClassNamed: 'MCMockClassC'). cls := Smalltalk at: #MCMockClassC. self assert: (cls selectors includesAllOf: {#withAllSuperclasses . #traits}). self deny: (cls selectors includesAnyOf: {#>> . #withAllSubclassesDo:}).! ! !MCClassDefinitionTest methodsFor: 'tests' stamp: 'SebastianTleye 7/9/2013 18:42'! testValidTraitComposition "Related to http://code.google.com/p/pharo/issues/detail?id=2148" | d className cls | className := 'MCMockClassC'. d := MCClassDefinition name: className superclassName: 'Object' traitComposition: '{TBehavior}' classTraitComposition: '{}' category: self mockCategoryName instVarNames: #() classVarNames: #() poolDictionaryNames: #() classInstVarNames: #() type: #normal comment: (self commentForClass: className) commentStamp: (self commentStampForClass: className). self shouldnt: [d load] raise: Error. self assert: (Smalltalk hasClassNamed: 'MCMockClassC'). cls := Smalltalk at: #MCMockClassC. self assert: (cls includesSelector: #>>). self assert: ((Smalltalk at: #MCMockClassC) traitComposition allTraits includes: TBehavior).! ! !MCClassDefinitionTest methodsFor: 'tests' stamp: 'SebastianTleye 7/9/2013 18:42'! testValidTraitComposition2 "Related to http://code.google.com/p/pharo/issues/detail?id=2148" | d className cls | className := 'MCMockClassC'. d := MCClassDefinition name: className superclassName: 'Object' traitComposition: 'TBehavior' classTraitComposition: '{}' category: self mockCategoryName instVarNames: #() classVarNames: #() poolDictionaryNames: #() classInstVarNames: #() type: #normal comment: (self commentForClass: className) commentStamp: (self commentStampForClass: className). self shouldnt: [d load] raise: Error. self assert: (Smalltalk hasClassNamed: 'MCMockClassC'). cls := Smalltalk at: #MCMockClassC. self assert: (cls includesSelector: #>>). self assert: ((Smalltalk at: #MCMockClassC) traitComposition allTraits includes: TBehavior).! ! !MCClassDefinitionTest methodsFor: 'tests' stamp: 'SebastianTleye 7/9/2013 18:43'! testValidTraitComposition3 "Related to http://code.google.com/p/pharo/issues/detail?id=2148" | d className cls | className := 'MCMockClassC'. d := MCClassDefinition name: className superclassName: 'Object' traitComposition: 'TBehavior + TClassDescription' classTraitComposition: '{}' category: self mockCategoryName instVarNames: #() classVarNames: #() poolDictionaryNames: #() classInstVarNames: #() type: #normal comment: (self commentForClass: className) commentStamp: (self commentStampForClass: className). self shouldnt: [d load] raise: Error. self assert: (Smalltalk hasClassNamed: 'MCMockClassC'). cls := Smalltalk at: #MCMockClassC. self assert: (cls includesSelector: #>>). self assert: (cls includesSelector: #comment). self assert: ((Smalltalk at: #MCMockClassC) traitComposition allTraits includes: TBehavior). self assert: ((Smalltalk at: #MCMockClassC) traitComposition allTraits includes: TClassDescription).! ! !MCClassDefinitionTest methodsFor: 'tests' stamp: 'SebastianTleye 7/9/2013 18:43'! testValidTraitComposition4 "Related to http://code.google.com/p/pharo/issues/detail?id=2598" | d className cls | className := 'MCMockClassC'. d := MCClassDefinition name: className superclassName: 'Object' traitComposition: 'TBehavior - {#>> . #withAllSubclassesDo:}' classTraitComposition: '{}' category: self mockCategoryName instVarNames: #() classVarNames: #() poolDictionaryNames: #() classInstVarNames: #() type: #normal comment: (self commentForClass: className) commentStamp: (self commentStampForClass: className). self shouldnt: [d load] raise: Error. self assert: (Smalltalk hasClassNamed: 'MCMockClassC'). cls := Smalltalk at: #MCMockClassC. self assert: (cls selectors includesAllOf: {#withAllSuperclasses . #traits}). self deny: (cls selectors includesAnyOf: {#>> . #withAllSubclassesDo:}).! ! !MCClassDefinitionTest methodsFor: 'tests' stamp: 'SebastianTleye 7/9/2013 18:42'! testValidTraitComposition "Related to http://code.google.com/p/pharo/issues/detail?id=2148" | d className cls | className := 'MCMockClassC'. d := MCClassDefinition name: className superclassName: 'Object' traitComposition: '{TBehavior}' classTraitComposition: '{}' category: self mockCategoryName instVarNames: #() classVarNames: #() poolDictionaryNames: #() classInstVarNames: #() type: #normal comment: (self commentForClass: className) commentStamp: (self commentStampForClass: className). self shouldnt: [d load] raise: Error. self assert: (Smalltalk hasClassNamed: 'MCMockClassC'). cls := Smalltalk at: #MCMockClassC. self assert: (cls includesSelector: #>>). self assert: ((Smalltalk at: #MCMockClassC) traitComposition allTraits includes: TBehavior).! ! !RGTraitDefinitionTest methodsFor: '*Ring-Tests-Monticello' stamp: 'SebastianTleye 7/9/2013 18:43'! testAsFullTraitDefinition "self debug: #testAsFullTraitDefinition" | rgClass | rgClass := TBehavior asRingDefinition. self assert: rgClass methods isEmpty. self assert: rgClass superclass isNil. self assert: rgClass subclasses isEmpty. self assert: rgClass package isNil. rgClass := TBehavior asFullRingDefinition. self assert: rgClass methods notEmpty. self assert: (rgClass methodNamed: #allSelectors) package notNil. self assert: rgClass superclass notNil. self assert: rgClass superclass name = #Trait. self assert: rgClass subclasses isEmpty. self assert: rgClass package notNil. self assert: rgClass package = rgClass theNonMetaClass package. self assert: rgClass package name = #Traits. self assert: rgClass category = #'Traits-Kernel-Traits'. self assert: rgClass superclass superclass isNil. self assert: rgClass superclass package isNil. rgClass := TBehavior theMetaClass asFullRingDefinition. self assert: rgClass package = rgClass theNonMetaClass package.! ! !RGTraitDefinitionTest methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 18:43'! testAsTraitDefinition | newTrait | newTrait:= TBehavior asRingDefinition. self assert: (newTrait isRingObject). self assert: (newTrait isTrait). self assert: (newTrait name == #TBehavior). self assert: (newTrait category notNil). self assert: (newTrait superclassName notNil). self assert: (newTrait theMetaClass isRingObject). self assert: (newTrait theMetaClass isTrait). self assert: (newTrait theMetaClass traitCompositionSource = '{}').! ! !RGTraitDefinitionTest methodsFor: '*Ring-Tests-Monticello' stamp: 'SebastianTleye 7/9/2013 18:43'! testAsFullTraitDefinition "self debug: #testAsFullTraitDefinition" | rgClass | rgClass := TBehavior asRingDefinition. self assert: rgClass methods isEmpty. self assert: rgClass superclass isNil. self assert: rgClass subclasses isEmpty. self assert: rgClass package isNil. rgClass := TBehavior asFullRingDefinition. self assert: rgClass methods notEmpty. self assert: (rgClass methodNamed: #allSelectors) package notNil. self assert: rgClass superclass notNil. self assert: rgClass superclass name = #Trait. self assert: rgClass subclasses isEmpty. self assert: rgClass package notNil. self assert: rgClass package = rgClass theNonMetaClass package. self assert: rgClass package name = #Traits. self assert: rgClass category = #'Traits-Kernel-Traits'. self assert: rgClass superclass superclass isNil. self assert: rgClass superclass package isNil. rgClass := TBehavior theMetaClass asFullRingDefinition. self assert: rgClass package = rgClass theNonMetaClass package.! ! !RGTraitDefinitionTest methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 18:43'! testAsTraitDefinition | newTrait | newTrait:= TBehavior asRingDefinition. self assert: (newTrait isRingObject). self assert: (newTrait isTrait). self assert: (newTrait name == #TBehavior). self assert: (newTrait category notNil). self assert: (newTrait superclassName notNil). self assert: (newTrait theMetaClass isRingObject). self assert: (newTrait theMetaClass isTrait). self assert: (newTrait theMetaClass traitCompositionSource = '{}').! ! !RGMonticelloTest methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 18:43'! testConvertingMCTraitDefinition | mcClass ringClass | mcClass := TSortable asClassDefinition. ringClass := mcClass asRingDefinition. self assert: (ringClass isTrait). self assert: (ringClass theMetaClass realClass = TSortable theMetaClass). self assert: (ringClass isSameRevisionAs: TSortable asRingDefinition). self deny: (ringClass isSameRevisionAs: TBehavior asRingDefinition)! ! !RGMonticelloTest methodsFor: 'testing' stamp: 'SebastianTleye 7/9/2013 18:43'! testConvertingMCTraitDefinition | mcClass ringClass | mcClass := TSortable asClassDefinition. ringClass := mcClass asRingDefinition. self assert: (ringClass isTrait). self assert: (ringClass theMetaClass realClass = TSortable theMetaClass). self assert: (ringClass isSameRevisionAs: TSortable asRingDefinition). self deny: (ringClass isSameRevisionAs: TBehavior asRingDefinition)! ! TBehavior classTrait removeSelector: #canZapMethodDictionary! TBehavior classTrait removeSelector: #cleanUp!