Merge pull request #14360 from jecisc/clean-method-removal

Clean method removal of RPackage
pharo-project · Jul 26, 2023 · b6fa1ab · b6fa1ab
2 parents 3909e55 + b09f27d
commit b6fa1ab
Show file tree

Hide file tree

Showing 3 changed files with 41 additions and 109 deletions.
diff --git a/src/RPackage-Core/RPackage.class.st b/src/RPackage-Core/RPackage.class.st
@@ -216,36 +216,20 @@ RPackage >> addClassTag: aSymbol [
 { #category : #'add method - compiled method' }
 RPackage >> addMethod: aCompiledMethod [
 	"Add the method to the receiver as a defined method if the class is  defined in it, else as an extension."
-	| methodClass |
 
+	| methodClass |
 	methodClass := aCompiledMethod methodClass.
-	(self includesClass: methodClass )
+	(self includesClass: methodClass)
 		ifTrue: [
 			methodClass isMeta
-				ifTrue: [
-					(metaclassDefinedSelectors
-						at: methodClass instanceSide name
-						ifAbsentPut: [ Set new ])
-						add: aCompiledMethod selector]
-				ifFalse: [
-					(classDefinedSelectors
-						at: methodClass name
-						ifAbsentPut: [ Set new ])
-						add: aCompiledMethod selector ] ]
-		ifFalse:  [
+				ifTrue: [ (metaclassDefinedSelectors at: methodClass instanceSide name ifAbsentPut: [ Set new ]) add: aCompiledMethod selector ]
+				ifFalse: [ (classDefinedSelectors at: methodClass name ifAbsentPut: [ Set new ]) add: aCompiledMethod selector ] ]
+		ifFalse: [
 			methodClass isMeta
-				ifTrue: [
-					(metaclassExtensionSelectors
-						at: methodClass instanceSide name
-						ifAbsentPut: [ Set new ])
-						add: aCompiledMethod selector.]
-				ifFalse: [
-					(classExtensionSelectors
-						at: methodClass name
-						ifAbsentPut: [ Set new ])
-						add: aCompiledMethod selector].
-				"we added a method extension so the receiver is an extending package of the class"
-				self organizer registerExtendingPackage: self forClass: methodClass ].
+				ifTrue: [ (metaclassExtensionSelectors at: methodClass instanceSide name ifAbsentPut: [ Set new ]) add: aCompiledMethod selector ]
+				ifFalse: [ (classExtensionSelectors at: methodClass name ifAbsentPut: [ Set new ]) add: aCompiledMethod selector ].
+			"we added a method extension so the receiver is an extending package of the class"
+			self organizer registerExtendingPackage: self forClass: methodClass ].
 
 	^ aCompiledMethod
 ]
@@ -287,31 +271,6 @@ RPackage >> basicImportClass: aClass [
 		thenDo: [ :protocol | self importProtocol: protocol forClass: aClass ]
 ]
 
-{ #category : #'add method - selector' }
-RPackage >> basicRemoveSelector: aSelector ofClassName: aClassName [
-	"Remove the method in the package but does not propagate to the class itself.  Note that this method does not remove the method from the class, it just records in the package that the method is not in the package anymore."
-
-	| selectors |
-
-	selectors := ( self includesClassNamed: aClassName)
-		ifFalse: [(classExtensionSelectors  at: aClassName ifAbsent: [ ^ Set new])]
-		ifTrue: [(classDefinedSelectors  at: aClassName ifAbsent: [ ^ Set new])].
-
-	selectors remove: aSelector ifAbsent: [ ]
-]
-
-{ #category : #'add method - selector' }
-RPackage >> basicRemoveSelector: aSelector ofMetaclassName: aClassName [
-	"Remove the method in the package. Note that this method does not remove the method from the class, it just records in the package that the method is not in the package anymore. aClassName is the sole instance class name and not its metaclass one: i.e. adding Point class>>new is done as removeSelector: #new ofMetaclassName: #Point"
-
-	| selectors |
-	selectors := ( self includesClassNamed: aClassName)
-		ifFalse: [(metaclassExtensionSelectors  at: aClassName ifAbsent: [ ^ Set new])]
-		ifTrue: [(metaclassDefinedSelectors  at: aClassName ifAbsent: [ ^ Set new])].
-
-	selectors remove: aSelector ifAbsent: [  ]
-]
-
 { #category : #'class tags' }
 RPackage >> basicRemoveTag: tag [
 
@@ -1120,18 +1079,34 @@ RPackage >> removeFromSystem [
 { #category : #'add method - compiled method' }
 RPackage >> removeMethod: aCompiledMethod [
 	"Remove the method to the receiver as a defined method."
-	|  methodClass |
 
+	| methodClass |
 	methodClass := aCompiledMethod methodClass.
-	methodClass isMeta
+	(self includesClass: methodClass)
 		ifTrue: [
-			self
-				removeSelector: aCompiledMethod selector
-				ofMetaclassName: methodClass instanceSide originalName ]
+			methodClass isMeta
+				ifTrue: [
+					metaclassDefinedSelectors at: methodClass instanceSide originalName ifPresent: [ :methods |
+						methods remove: aCompiledMethod selector ifAbsent: [  ].
+						methods ifEmpty: [ metaclassDefinedSelectors removeKey: methodClass instanceSide originalName ] ] ]
+				ifFalse: [
+					classDefinedSelectors at: methodClass originalName ifPresent: [ :methods |
+						methods remove: aCompiledMethod selector ifAbsent: [  ].
+						methods ifEmpty: [ classDefinedSelectors removeKey: methodClass originalName ] ] ] ]
 		ifFalse: [
-			self
-				removeSelector: aCompiledMethod selector
-				ofClassName: methodClass originalName ].
+			methodClass isMeta
+				ifTrue: [
+					metaclassExtensionSelectors at: methodClass instanceSide originalName ifPresent: [ :methods |
+						methods remove: aCompiledMethod selector ifAbsent: [  ].
+						methods ifEmpty: [ metaclassExtensionSelectors removeKey: methodClass instanceSide originalName ] ] ]
+				ifFalse: [
+					classExtensionSelectors at: methodClass originalName ifPresent: [ :methods |
+						methods remove: aCompiledMethod selector ifAbsent: [  ].
+						methods ifEmpty: [ classExtensionSelectors removeKey: methodClass originalName ] ] ] ].
+
+	((metaclassExtensionSelectors at: methodClass instanceSide originalName ifAbsent: [ #(  ) ]) isEmpty and: [
+		 (classExtensionSelectors at: methodClass instanceSide originalName ifAbsent: [ #(  ) ]) isEmpty ]) ifTrue: [
+		self organizer unregisterExtendingPackage: self forClassName: methodClass instanceSide originalName ].
 
 	^ aCompiledMethod
 ]
@@ -1165,42 +1140,6 @@ RPackage >> removeProperty: propName ifAbsent: aBlock [
 	^ property
 ]
 
-{ #category : #'add method - selector' }
-RPackage >> removeSelector: aSelector ofClassName: aClassName [
-	"Remove the method in the package but does not propagate to the class itself.  Note that this method does not remove the method from the class, it just records in the package that the method is not in the package anymore."
-
-	self basicRemoveSelector: aSelector ofClassName: aClassName.
-	(classExtensionSelectors at: aClassName ifAbsent: [ #() ]) ifEmpty: [
-		classExtensionSelectors removeKey: aClassName ifAbsent: [].
-	].
-	(classDefinedSelectors at: aClassName ifAbsent: [ #() ]) ifEmpty: [
-		classDefinedSelectors removeKey: aClassName ifAbsent: [].
-	].
-
-	((metaclassExtensionSelectors at: aClassName ifAbsent: [#()]) isEmpty and: [(classExtensionSelectors at: aClassName ifAbsent: [#()]) isEmpty])
-		ifTrue: [
-				self organizer unregisterExtendingPackage: self forClassName: aClassName
-	]
-]
-
-{ #category : #'add method - selector' }
-RPackage >> removeSelector: aSelector ofMetaclassName: aClassName [
-	"Remove the method in the package. Note that this method does not remove the method from the class, it just records in the package that the method is not in the package anymore. aClassName is the sole instance class name and not its metaclass one: i.e. adding Point class>>new is done as removeSelector: #new ofMetaclassName: #Point"
-
-	self basicRemoveSelector: aSelector ofMetaclassName: aClassName.
-	(metaclassExtensionSelectors at: aClassName ifAbsent: [ #() ]) ifEmpty: [
-		metaclassExtensionSelectors removeKey: aClassName ifAbsent: [].
-	].
-	(metaclassDefinedSelectors at: aClassName ifAbsent: [ #() ]) ifEmpty: [
-		metaclassDefinedSelectors removeKey: aClassName ifAbsent: [].
-	].
-
-	((metaclassExtensionSelectors at: aClassName ifAbsent: [#()]) isEmpty and: [(classExtensionSelectors at: aClassName ifAbsent: [#()]) isEmpty])
-		ifTrue: [
-				self organizer unregisterExtendingPackage: self forClassName: aClassName
-	]
-]
-
 { #category : #private }
 RPackage >> renameExtensionsPrefixedWith: oldName to: newName [
 

diff --git a/src/RPackage-Core/RPackageOrganizer.class.st b/src/RPackage-Core/RPackageOrganizer.class.st
@@ -1089,19 +1089,11 @@ RPackageOrganizer >> systemMethodRecategorizedActionFrom: ann [
 
 { #category : #'system integration' }
 RPackageOrganizer >> systemMethodRemovedActionFrom: ann [
-
-	| method |
-	method := ann method.
 	"If the method is provided by a trait, we do not care about it"
+
 	ann isProvidedByATrait ifTrue: [ ^ self ].
 
-	ann methodClass isMeta
-		ifFalse: [
-			(self packageDefiningOrExtendingSelector: ann selector inClassNamed: ann methodClass instanceSide originalName) ifNotNil: [ :methodPackage |
-				methodPackage removeSelector: ann selector ofClassName: ann methodClass instanceSide originalName ] ]
-		ifTrue: [
-			(self packageDefiningOrExtendingSelector: ann selector inMetaclassNamed: ann methodClass instanceSide originalName) ifNotNil: [ :methodPackage |
-				methodPackage removeSelector: ann selector ofMetaclassName: ann methodClass instanceSide originalName ] ]
+	ann method package ifNotNil: [ :package | package removeMethod: ann method ]
 ]
 
 { #category : #accessing }

diff --git a/src/RPackage-Tests/RPackageIncrementalTest.class.st b/src/RPackage-Tests/RPackageIncrementalTest.class.st
@@ -199,18 +199,19 @@ RPackageIncrementalTest >> testAddRemoveSelector [
 	self assert: (p1 includesExtensionSelector: #methodDefinedInP1 ofClassName: a2Name).
 	self deny: (p3 includesDefinedSelector: #methodDefinedInP1 ofClassName: a2Name).
 
-	p2 removeSelector: #methodDefinedInP2 ofClassName: a2Name.
+	p2 removeMethod: a2 >> #methodDefinedInP2.
 	self deny: (p2 includesDefinedSelector: #methodDefinedInP2 ofClassName: a2Name).
 	self deny: (p2 includesExtensionSelector: #methodDefinedInP2 ofClassName: a2Name).
 
-	p1 removeSelector: #methodDefinedInP1 ofClassName: a2Name.
+	p1 removeMethod: a2 >> #methodDefinedInP1.
 	self deny: (p1 includesDefinedSelector: #methodDefinedInP3 ofClassName: a2Name).
 	self deny: (p1 includesExtensionSelector: #methodDefinedInP3 ofClassName: a2Name)
 ]
 
 { #category : #'tests - method addition removal' }
 RPackageIncrementalTest >> testAddRemoveSelectorOfMetaclass [
-	| p1 p2 p3 a2   a2Name a2class |
+
+	| p1 p2 p3 a2 a2Name a2class |
 	a2Name := #A2InPackageP2.
 	p1 := self createNewPackageNamed: 'P1'.
 	p2 := self createNewPackageNamed: 'P2'.
@@ -231,11 +232,11 @@ RPackageIncrementalTest >> testAddRemoveSelectorOfMetaclass [
 	self assert: (p1 includesExtensionSelector: #methodDefinedInP1 ofMetaclassName: a2Name).
 	self deny: (p3 includesDefinedSelector: #methodDefinedInP1 ofMetaclassName: a2Name).
 
-	p2 removeSelector: #methodDefinedInP2 ofMetaclassName:  a2Name.
+	p2 removeMethod: a2 class >> #methodDefinedInP2.
 	self deny: (p2 includesDefinedSelector: #methodDefinedInP2 ofMetaclassName: a2Name).
 	self deny: (p2 includesExtensionSelector: #methodDefinedInP2 ofMetaclassName: a2Name).
 
-	p1 removeSelector: #methodDefinedInP1 ofMetaclassName:  a2Name.
+	p1 removeMethod: a2 class >> #methodDefinedInP1.
 	self deny: (p1 includesDefinedSelector: #methodDefinedInP3 ofMetaclassName: a2Name).
 	self deny: (p1 includesExtensionSelector: #methodDefinedInP3 ofMetaclassName: a2Name)
 ]