diff --git a/src/Shift-ClassBuilder/ShDefaultBuilderEnhancer.class.st b/src/Shift-ClassBuilder/ShDefaultBuilderEnhancer.class.st index 5ac26636bf..d65730421c 100644 --- a/src/Shift-ClassBuilder/ShDefaultBuilderEnhancer.class.st +++ b/src/Shift-ClassBuilder/ShDefaultBuilderEnhancer.class.st @@ -82,8 +82,10 @@ ShDefaultBuilderEnhancer >> initializeBuilder: aBuilder [ aBuilder addChangeComparer: ShMetaclassChangeDetector ] -{ #category : 'events' } -ShDefaultBuilderEnhancer >> metaclassCreated: builder [ +{ #category : 'accessing' } +ShDefaultBuilderEnhancer >> metaclassClassFor: aBuilder [ + + ^ Metaclass ] { #category : 'events' } @@ -98,11 +100,6 @@ ShDefaultBuilderEnhancer >> migrateToClass: aClass installer: aShiftClassInstall aShiftClassInstaller migrateClassTo: aClass ] -{ #category : 'class modifications' } -ShDefaultBuilderEnhancer >> newMetaclass: builder [ - ^ builder metaclassClass new -] - { #category : 'class modifications' } ShDefaultBuilderEnhancer >> on: newClass declareClassVariables: sharedVariables sharing: sharedPoolNames [ newClass diff --git a/src/Shift-ClassBuilder/ShiftClassBuilder.class.st b/src/Shift-ClassBuilder/ShiftClassBuilder.class.st index 330a4de394..a934c59d2e 100644 --- a/src/Shift-ClassBuilder/ShiftClassBuilder.class.st +++ b/src/Shift-ClassBuilder/ShiftClassBuilder.class.st @@ -250,15 +250,13 @@ ShiftClassBuilder >> createClass [ { #category : 'building' } ShiftClassBuilder >> createMetaclass [ - newMetaclass := self builderEnhancer newMetaclass: self. + newMetaclass := self metaclassClass new. self builderEnhancer configureMetaclass: newMetaclass superclass: self metaSuperclass withLayoutType: FixedLayout - slots: (self withAdditionalSlots: self classSlots). - - self builderEnhancer metaclassCreated: self + slots: (self withAdditionalSlots: self classSlots) ] { #category : 'building' } @@ -317,9 +315,7 @@ ShiftClassBuilder >> fillClassSideFromEnvironment: anEnvironment [ | old | old := anEnvironment at: name ifAbsent: [ ^ self ]. - self metaclassClass: old class class. - self classSlots: old class slots. - self classTraits: old class traitComposition + self classSlots: old class slots ] { #category : 'initialization' } @@ -482,12 +478,9 @@ ShiftClassBuilder >> metaSuperclass: aClass [ { #category : 'accessing' } ShiftClassBuilder >> metaclassClass [ - ^ metaclassClass ifNil: [ Metaclass ] -] + "The metaclass class is determined by the builder enhancer. In case you want to play with your own metaclass class, you can implement a subclass of the buildre enhancer and use this one overriding the method #metaclassClassFor:." -{ #category : 'accessing' } -ShiftClassBuilder >> metaclassClass: anObject [ - metaclassClass := anObject + ^ self builderEnhancer metaclassClassFor: self ] { #category : 'accessing' } diff --git a/src/Traits-Tests/ShTraitBuilderTest.class.st b/src/Traits-Tests/ShTraitBuilderTest.class.st new file mode 100644 index 0000000000..b222301846 --- /dev/null +++ b/src/Traits-Tests/ShTraitBuilderTest.class.st @@ -0,0 +1,24 @@ +Class { + #name : 'ShTraitBuilderTest', + #superclass : 'ShiftClassBuilderTest', + #category : 'Traits-Tests-ShiftClassInstaller', + #package : 'Traits-Tests', + #tag : 'ShiftClassInstaller' +} + +{ #category : 'tests' } +ShTraitBuilderTest >> testRemovingTraitCompositionOfAClassShouldUpdateItsMetaclass [ + + | t1 newClass | + t1 := (Trait << #TShCITestClass package: self packageNameForTest) install. + + newClass := ((Object << #ShCITestClass) + traits: t1; + package: self packageNameForTest) install. + + self assert: newClass class class equals: TraitedMetaclass. + + newClass := (Object << #ShCITestClass package: self packageNameForTest) install. + + self assert: newClass class class equals: Metaclass +] diff --git a/src/Traits/ShiftClassBuilder.extension.st b/src/Traits/ShiftClassBuilder.extension.st index a8ce30807e..34e02ac915 100644 --- a/src/Traits/ShiftClassBuilder.extension.st +++ b/src/Traits/ShiftClassBuilder.extension.st @@ -5,8 +5,7 @@ ShiftClassBuilder >> beTrait [ self superclass: nil; - metaSuperclass: Trait; - metaclassClass: MetaclassForTraits + metaSuperclass: Trait ] { #category : '*Traits' } @@ -53,9 +52,7 @@ ShiftClassBuilder >> traitComposition [ ShiftClassBuilder >> traitComposition: aValue [ self classTraitComposition: aValue asTraitComposition classComposition. - "Cyril: The next line is for the case where we update a class that had a trait and we remove the used traits. The metaclass should be updated also. - But, IMO we could do better. Instead of having a state for the metaclassClass we should resolve it via the enhancer during the building. And someone could set its own using its own enhancer." - (aValue isEmpty and: [ metaclassClass = TraitedMetaclass ]) ifTrue: [ metaclassClass := Metaclass ]. + ^ self privateTraitComposition: aValue ] diff --git a/src/Traits/TraitBuilderEnhancer.class.st b/src/Traits/TraitBuilderEnhancer.class.st index 752b9b6656..f39b2872e1 100644 --- a/src/Traits/TraitBuilderEnhancer.class.st +++ b/src/Traits/TraitBuilderEnhancer.class.st @@ -172,13 +172,10 @@ TraitBuilderEnhancer >> eliminateDuplicates: aSlotCollection withSuperclassSlots { #category : 'initialization' } TraitBuilderEnhancer >> fillBuilder: aBuilder from: aClass [ - (aBuilder superclass isNil and: [ aClass superclass isNil ]) ifTrue: [ - aBuilder metaSuperclass: aClass class superclass ]. + (aBuilder superclass isNil and: [ aClass superclass isNil ]) ifTrue: [ aBuilder metaSuperclass: aClass class superclass ]. aBuilder traitComposition: aClass traitComposition. - aBuilder classTraitComposition: aClass class basicTraitComposition. - - aBuilder metaclassClass: aClass class class + aBuilder classTraitComposition: aClass class basicTraitComposition ] { #category : 'initialization' } @@ -196,6 +193,17 @@ TraitBuilderEnhancer >> isTraitedMetaclass: aBuilder [ ^ aBuilder metaclassClass includesBehavior: TraitedMetaclass ] +{ #category : 'class modifications' } +TraitBuilderEnhancer >> metaclassClassFor: aBuilder [ + + aBuilder metaSuperclass = Trait ifTrue: [ ^ MetaclassForTraits ]. + + (aBuilder traitComposition asTraitComposition isNotEmpty or: [ + aBuilder classTraitComposition asTraitComposition isNotEmpty or: [ aBuilder superclass class class = TraitedMetaclass ] ]) ifTrue: [ ^ TraitedMetaclass ]. + + ^ super metaclassClassFor: aBuilder +] + { #category : 'events' } TraitBuilderEnhancer >> migrateInstancesTo: aClass installer: aShiftClassInstaller [ @@ -206,18 +214,6 @@ TraitBuilderEnhancer >> migrateInstancesTo: aClass installer: aShiftClassInstall super migrateInstancesTo: aClass installer: aShiftClassInstaller ] -{ #category : 'class modifications' } -TraitBuilderEnhancer >> newMetaclass: aBuilder [ - - (aBuilder traitComposition asTraitComposition isNotEmpty or: [ aBuilder classTraitComposition asTraitComposition isNotEmpty or: [ aBuilder superclass class class = TraitedMetaclass]]) - ifTrue: [ aBuilder metaclassClass: TraitedMetaclass ]. - - aBuilder metaSuperclass = Trait - ifTrue: [ aBuilder metaclassClass: MetaclassForTraits ]. - - ^ super newMetaclass: aBuilder -] - { #category : 'class modifications' } TraitBuilderEnhancer >> propagateChangesToRelatedClasses: newClass builder: aBuilder [