Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

Clean method removal of RPackage #14360

Merged
merged 2 commits into from
Jul 26, 2023
Merged

Clean method removal of RPackage #14360

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
99b3d21
Clean method removal of RPackage
jecisc Jul 24, 2023
b09f27d
The package of an obsolete class can be nil
jecisc Jul 25, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
127 changes: 33 additions & 94 deletions src/RPackage-Core/RPackage.class.st
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
]
Expand Down Expand Up @@ -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 [

Expand Down Expand Up @@ -1229,18 +1188,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 ] ] ] ]
Comment on lines +1197 to +1204
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

On add is used name as key, but here is using originalName. What's the difference?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

The difference happens with ObsoleteClasses. #name will return the obsolete name while #originalName will return the name of the class when it was not obsolete.

In the end I would like to have real classes instead of class names in the caches so that we do not have to care about that (and so that we do not have to cast them each time we want a class)

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 ] ] ] ].
Comment on lines +1206 to +1214
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Should be nice to hide and reuse the use of the cache in both methods.

Maybe delegating to methods

self cacheFor: methodClass ifPresent: [ .. ]
self cacheFor: methodClass ifAbsent: [ .. ]

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I'm planning to kill some of those caches. For now I'm trying to make the code simpler so that I can do my changes.

I also want to merge the class and metaclass caches because it's a bother to always check the #isMeta to call two different methods. Once this is done, I'll see if we can improve further the use of the extension selectors :)
This beast is pretty huge and I'm trying to simplify little by little because each change has a lot of impacts ahah


((metaclassExtensionSelectors at: methodClass instanceSide originalName ifAbsent: [ #( ) ]) isEmpty and: [
(classExtensionSelectors at: methodClass instanceSide originalName ifAbsent: [ #( ) ]) isEmpty ]) ifTrue: [
Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

classExtensionSelectors is using methodClass originalName (or name) as key.

Copy-paste issue?

Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

There is no issue because here we are in the #ifFalse: of methodClass isMeta so we know we already have the instance side.

But as I said in another comment, I would like to remove the meta/non meta management to use one unified way.

self organizer unregisterExtendingPackage: self forClassName: methodClass instanceSide originalName ].

^ aCompiledMethod
]
Expand Down Expand Up @@ -1274,42 +1249,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 [

Expand Down
12 changes: 2 additions & 10 deletions src/RPackage-Core/RPackageOrganizer.class.st
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1104,19 +1104,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 }
Expand Down
11 changes: 6 additions & 5 deletions src/RPackage-Tests/RPackageIncrementalTest.class.st
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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'.
Expand All @@ -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)
]
Expand Down