Port to pharo13 bugfix issue 16702: Trait class side methods sometimes not installed on user classes.

src/Traits-Tests/TraitedClassTest.class.st

@@ -0,0 +1,96 @@
+Class {
+	#name : 'TraitedClassTest',
+	#superclass : 'TraitAbstractTest',
+	#instVars : [
+		'postFix',
+		'selector',
+		'parentBehavior',
+		'rootTrait',
+		'userTrait',
+		'userClass'
+	],
+	#category : 'Traits-Tests',
+	#package : 'Traits-Tests'
+}
+
+{ #category : 'running' }
+TraitedClassTest >> addFlagMethodTo: aBehavior answering: aBoolean [
+
+	aBehavior compile:
+		selector , String crlf , '^ '
+		, aBoolean asString
+]
+
+{ #category : 'running' }
+TraitedClassTest >> assertClassSideTraitMethod [
+
+	self assert: (userClass perform: selector).
+	userClass class
+		compiledMethodAt: selector
+		ifAbsent: [ self fail: 'Method from trait is missing!' ].
+	self deny: (userClass class isRejectedMethod: selector)
+]
+
+{ #category : 'running' }
+TraitedClassTest >> createRootTrait [
+
+	rootTrait := self newTrait: #TRoot , postFix with: #(  ).
+
+]
+
+{ #category : 'running' }
+TraitedClassTest >> createUserClass [
+
+	userClass := self
+		             newClass: #User , postFix
+		             with: #(  )
+		             traits: { userTrait }
+]
+
+{ #category : 'running' }
+TraitedClassTest >> createUserTrait [
+
+	userTrait := self
+		             newTrait: #TUser , postFix
+		             with: #(  )
+		             traits: { rootTrait }.
+
+]
+
+{ #category : 'running' }
+TraitedClassTest >> setUp [
+
+	super setUp.
+	postFix := 'GeneratedBy' , self className.
+	selector := ('flag' , postFix) asSymbol.
+	parentBehavior := Object.
+	self addFlagMethodTo: parentBehavior answering: false
+]
+
+{ #category : 'running' }
+TraitedClassTest >> tearDown [
+
+	parentBehavior removeSelector: selector.
+	super tearDown.
+
+]
+
+{ #category : 'running' }
+TraitedClassTest >> testClassMethodAddedAfterCreatingClass [
+
+	self createRootTrait.
+	self createUserTrait.
+	self createUserClass.
+	self addFlagMethodTo: rootTrait classTrait answering: true.
+	self assertClassSideTraitMethod
+]
+
+{ #category : 'running' }
+TraitedClassTest >> testClassMethodAddedBeforeCreatingClass [
+
+	self createRootTrait.
+	self addFlagMethodTo: rootTrait classTrait answering: true.
+	self createUserTrait.
+	self createUserClass.
+	self assertClassSideTraitMethod
+]

src/Traits/MetaclassForTraits.class.st

@@ -98,6 +98,16 @@ MetaclassForTraits >> name [
 	^ thisClass ifNil: [ 'a MetaclassForTraits' ] ifNotNil: [ thisClass name asString , ' classTrait' ]
 ]
 
+{ #category : 'accessing' }
+MetaclassForTraits >> nonTraitedClassMethods [
+	^self methods reject: [ : cm | cm methodClass == TraitedClass ]
+]
+
+{ #category : 'accessing' }
+MetaclassForTraits >> nonTraitedClassSelectors [
+	^self nonTraitedClassMethods collect: [ : each | each selector ]
+]
+
 { #category : 'organization updating' }
 MetaclassForTraits >> notifyOfRecategorizedSelector: selector from: oldProtocol to: newProtocol [
 	"When there is a recategorization of a selector, I propagate the changes to my users"

src/Traits/TraitedMetaclass.class.st

@@ -196,20 +196,19 @@ TraitedMetaclass >> isLocalSelector: aSelector [
 TraitedMetaclass >> isRejectedMethod: aSelector [
 	"Determine if the method is not to be installed in method dictionary"
 
-	| isFromClass isFromTraitedClass isTheTraitIUseDefinesTheSelector isMySuperclassTraitedClass |
+	| isFromClass isFromTraitedClass  isMySuperclassTraitedClass |
 
 	"the selector is one of the local methods"
 	(self isLocalSelector: aSelector)
 		ifTrue: [ ^ true ].
 
 	"If a trait I used define the selector, we do not reject"
-	isTheTraitIUseDefinesTheSelector := self traitComposition traits anySatisfy: [:inTrait |
-		inTrait localMethods anySatisfy: [ :meth | meth selector = aSelector ]].
-	isTheTraitIUseDefinesTheSelector ifTrue:[ ^false ].
+	 ((self traitComposition traits) copyWithout: TraitedClass) do: [:inTrait |
+		(inTrait nonTraitedClassSelectors includes: aSelector) ifTrue:[ ^false ]].
 
 
 	isFromClass := Class canUnderstand: aSelector.
-	isFromTraitedClass := TraitedClass methodDict includesKey: aSelector.
+	isFromTraitedClass := TraitedClass includesSelector: aSelector.
 	isMySuperclassTraitedClass := (superclass isKindOf: TraitedMetaclass) and: [
 	superclass isObsolete not].