From 99db94d7ad7ff31ff63610a8e68c08bfb317860f Mon Sep 17 00:00:00 2001 From: CyrilFerlicot Date: Mon, 29 May 2023 12:24:11 +0200 Subject: [PATCH 1/4] Add #classify:under: on ClassDescription and migrate tests --- .../ClassDescriptionProtocolsTest.class.st | 94 ++++++++++++++++ .../ClassOrganizationTest.class.st | 104 ------------------ src/Kernel/ClassDescription.class.st | 16 +++ 3 files changed, 110 insertions(+), 104 deletions(-) diff --git a/src/Kernel-Tests/ClassDescriptionProtocolsTest.class.st b/src/Kernel-Tests/ClassDescriptionProtocolsTest.class.st index 146bdf602ae..3cacc1f86f6 100644 --- a/src/Kernel-Tests/ClassDescriptionProtocolsTest.class.st +++ b/src/Kernel-Tests/ClassDescriptionProtocolsTest.class.st @@ -33,6 +33,100 @@ ClassDescriptionProtocolsTest >> tearDown [ super tearDown ] +{ #category : #tests } +ClassDescriptionProtocolsTest >> testClassifyUnder [ + + "Lets create a new protocol via classification" + class classify: #edalyn under: #which. + class classify: #luz under: #which. + + self assertCollection: class protocolNames hasSameElements: #( #which ). + self assertCollection: (class selectorsInProtocol: #which) hasSameElements: #( #edalyn #luz ). + + "Move a method" + class classify: #luz under: #human. + self assertCollection: class protocolNames hasSameElements: #( #human #which ). + self assertCollection: (class selectorsInProtocol: #which) hasSameElements: #( #edalyn ). + self assertCollection: (class selectorsInProtocol: #human) hasSameElements: #( #luz ). + + "Move last method" + class classify: #edalyn under: #beast. + self assertCollection: class protocolNames hasSameElements: #( #human #beast ). + self assertCollection: (class selectorsInProtocol: #human) hasSameElements: #( #luz ). + self assertCollection: (class selectorsInProtocol: #beast) hasSameElements: #( #edalyn ). + + "Nothing should change if the new protocol is the same than the old one" + class classify: #edalyn under: #beast. + self assertCollection: class protocolNames hasSameElements: #( #human #beast ). + self assertCollection: (class selectorsInProtocol: #human) hasSameElements: #( #luz ). + self assertCollection: (class selectorsInProtocol: #beast) hasSameElements: #( #edalyn ) +] + +{ #category : #tests } +ClassDescriptionProtocolsTest >> testClassifyUnderUnclassified [ + "Ensure unclassified is acting as any other protocol because that was not the case in the past." + + "Lets create a new protocol via classification" + class classify: #king under: Protocol unclassified. + class classify: #luz under: Protocol unclassified. + + self assertCollection: class protocolNames hasSameElements: { Protocol unclassified }. + self assertCollection: class uncategorizedSelectors hasSameElements: #( #king #luz ). + + "This should do nothing." + class classify: #luz under: Protocol unclassified. + + self assertCollection: class protocolNames hasSameElements: { Protocol unclassified }. + self assertCollection: class uncategorizedSelectors hasSameElements: #( #king #luz ). + + "Now we move a method from unclassified to another protocol." + class classify: #luz under: #human. + + self assertCollection: class protocolNames hasSameElements: { #human. Protocol unclassified }. + self assertCollection: class uncategorizedSelectors hasSameElements: #( #king ). + + "Now we move back to unclassified." + class classify: #luz under: Protocol unclassified. + + self assertCollection: class protocolNames hasSameElements: { Protocol unclassified }. + self assertCollection: class uncategorizedSelectors hasSameElements: #( #king #luz ) +] + +{ #category : #tests } +ClassDescriptionProtocolsTest >> testClassifyUnderWithNil [ + "Set the base for the test" + | unclassified| + unclassified := Protocol unclassified. + + class classify: #king under: nil. + + self assertCollection: class protocolNames hasSameElements: { Protocol unclassified }. + self assertCollection: class uncategorizedSelectors hasSameElements: #( #king ). + + class classify: #luz under: #human. + + self assertCollection: class protocolNames hasSameElements: { Protocol unclassified . #human }. + self assertCollection: (class selectorsInProtocol: #human) hasSameElements: #( #luz ). + + "Now let's test the behavior if we already have a protocol. + The behavior should change to not change the protocol but this test will ensure that the change is intentional and not a regression." + class classify: #luz under: nil. + + self assertCollection: class protocolNames hasSameElements: { Protocol unclassified }. + self assertCollection: class uncategorizedSelectors hasSameElements: #( #king #luz ). +] + +{ #category : #tests } +ClassDescriptionProtocolsTest >> testClassifyUnderWithProtocol [ + + "Lets create a new protocol via classification" + class classify: #edalyn under: #which. + class classify: #luz under: (class protocolNamed: #which). + + self assertCollection: class protocolNames hasSameElements: #( #which ). + self assertCollection: (class selectorsInProtocol: #which) hasSameElements: #( #edalyn #luz ) +] + { #category : #tests } ClassDescriptionProtocolsTest >> testHasProtocol [ diff --git a/src/Kernel-Tests/ClassOrganizationTest.class.st b/src/Kernel-Tests/ClassOrganizationTest.class.st index a959bc388f1..9935949dfdc 100644 --- a/src/Kernel-Tests/ClassOrganizationTest.class.st +++ b/src/Kernel-Tests/ClassOrganizationTest.class.st @@ -31,110 +31,6 @@ ClassOrganizationTest >> testAddProtocol [ self assert: (class hasProtocol: 'test-protocol') ] -{ #category : #tests } -ClassOrganizationTest >> testClassifyUnder [ - "Set the base for the test" - - self assertCollection: class protocolNames hasSameElements: #( #empty #one ). - - "Lets create a new protocol via classification" - organization classify: #king under: #owl. - organization classify: #luz under: #owl. - - self assertCollection: class protocolNames hasSameElements: #( #empty #one #owl ). - self assertCollection: (class selectorsInProtocol: #owl) hasSameElements: #( #king #luz ). - - "Move a method" - organization classify: #luz under: #one. - self assertCollection: class protocolNames hasSameElements: #( #empty #one #owl ). - self assertCollection: (class selectorsInProtocol: #owl) hasSameElements: #( #king ). - self assertCollection: (class selectorsInProtocol: #one) hasSameElements: #( #one #luz ). - - "Move last method" - organization classify: #king under: #two. - self assertCollection: class protocolNames hasSameElements: #( #empty #one #two ). - self assertCollection: (class selectorsInProtocol: #one) hasSameElements: #( #one #luz ). - self assertCollection: (class selectorsInProtocol: #two) hasSameElements: #( #king ). - - "Nothing should change if the new protocol is the same than the old one" - organization classify: #king under: #two. - self assertCollection: class protocolNames hasSameElements: #( #empty #one #two ). - self assertCollection: (class selectorsInProtocol: #one) hasSameElements: #( #one #luz ). - self assertCollection: (class selectorsInProtocol: #two) hasSameElements: #( #king ) -] - -{ #category : #tests } -ClassOrganizationTest >> testClassifyUnderUnclassified [ - "Ensure unclassified is acting as any other protocol because that was not the case in the past." - - "Set the base for the test" - self assertCollection: class protocolNames hasSameElements: #( #empty #one ). - - "Lets create a new protocol via classification" - organization classify: #king under: Protocol unclassified. - organization classify: #luz under: Protocol unclassified. - - self assertCollection: class protocolNames hasSameElements: {#empty. #one. Protocol unclassified }. - self assertCollection: class uncategorizedSelectors hasSameElements: #( #king #luz ). - - "This should do nothing." - organization classify: #luz under: Protocol unclassified. - - self assertCollection: class protocolNames hasSameElements: {#empty. #one. Protocol unclassified }. - self assertCollection: class uncategorizedSelectors hasSameElements: #( #king #luz ). - - "Now we move a method from unclassified to another protocol." - organization classify: #luz under: #one. - - self assertCollection: class protocolNames hasSameElements: {#empty. #one. Protocol unclassified }. - self assertCollection: class uncategorizedSelectors hasSameElements: #( #king ). - - "Now we move back to unclassified." - organization classify: #luz under: Protocol unclassified. - - self assertCollection: class protocolNames hasSameElements: {#empty. #one. Protocol unclassified }. - self assertCollection: class uncategorizedSelectors hasSameElements: #( #king #luz ) -] - -{ #category : #tests } -ClassOrganizationTest >> testClassifyUnderWithNil [ - "Set the base for the test" - | unclassified| - unclassified := Protocol unclassified. - self assertCollection: class protocolNames hasSameElements: #( #empty #one ). - - organization classify: #king under: nil. - - self assertCollection: class protocolNames hasSameElements: { #empty. #one. unclassified }. - self assertCollection: (class selectorsInProtocol: unclassified) hasSameElements: #( #king ). - - organization classify: #luz under: #owl. - - self assertCollection: class protocolNames hasSameElements: { #empty. #one. unclassified . #owl }. - self assertCollection: (class selectorsInProtocol: #owl) hasSameElements: #( #luz ). - - "Now let's test the behavior if we already have a protocol. - The behavior should change to not change the protocol but this test will ensure that the change is intentional and not a regression." - organization classify: #luz under: nil. - - self assertCollection: class protocolNames hasSameElements: { #empty. #one. unclassified }. - self assertCollection: (class selectorsInProtocol: unclassified) hasSameElements: #( #king #luz ). -] - -{ #category : #tests } -ClassOrganizationTest >> testClassifyUnderWithProtocol [ - "Set the base for the test" - - self assertCollection: class protocolNames hasSameElements: #( #empty #one ). - - "Lets create a new protocol via classification" - organization classify: #king under: #owl. - organization classify: #luz under: (class protocolNamed: #owl). - - self assertCollection: class protocolNames hasSameElements: #( #empty #one #owl ). - self assertCollection: (class selectorsInProtocol: #owl) hasSameElements: #( #king #luz ) -] - { #category : #tests } ClassOrganizationTest >> testCopyFrom [ diff --git a/src/Kernel/ClassDescription.class.st b/src/Kernel/ClassDescription.class.st index b1e01c08ece..d74b30d9ced 100644 --- a/src/Kernel/ClassDescription.class.st +++ b/src/Kernel/ClassDescription.class.st @@ -256,6 +256,22 @@ ClassDescription >> classVariablesString [ ^ String streamContents: [ :stream | self classVariablesOn: stream ] ] +{ #category : #protocols } +ClassDescription >> classify: selector under: aProtocol [ + + | oldProtocol newProtocol | + (newProtocol := self ensureProtocol: aProtocol) = (oldProtocol := self protocolOfSelector: selector) ifTrue: [ ^ self ]. + + oldProtocol ifNotNil: [ + oldProtocol removeMethodSelector: selector. + self removeProtocolIfEmpty: oldProtocol ]. + + newProtocol addMethodSelector: selector. + + "During the first classification of a method we dont need to announce the classification because users can subscribe to the method added announcement." + oldProtocol ifNotNil: [ self notifyOfRecategorizedSelector: selector from: oldProtocol to: newProtocol ] +] + { #category : #compiling } ClassDescription >> compile: sourceCode classified: protocol [ "Compile the source code in the context of the receiver and install the result in the receiver's method dictionary under the given protocol (this can be a protocol or a protocol name). From 0eaadcf4d2aa119ce78f8fcb30b9f92c36afa770 Mon Sep 17 00:00:00 2001 From: CyrilFerlicot Date: Mon, 29 May 2023 12:38:22 +0200 Subject: [PATCH 2/4] Migrate senders --- .../FLExtensionWrapper.class.st | 12 +++--- .../FLPharo11Platform.class.st | 9 ++--- .../FLPharo12Platform.class.st | 9 ++--- ...tializePackagesCommandLineHandler.class.st | 18 ++++----- .../ClassOrganizationTest.class.st | 40 ++----------------- .../ProtocolAnnouncementsTest.class.st | 6 +-- src/Kernel/ClassDescription.class.st | 4 +- src/Kernel/ClassOrganization.class.st | 2 +- src/Kernel/CompiledMethod.class.st | 2 +- .../RPackageMCSynchronisationTest.class.st | 12 +++--- ...PackageMethodsSynchronisationTest.class.st | 26 ++++++------ src/Monticello/MethodAddition.class.st | 2 +- src/RPackage-Tests/RPackageTest.class.st | 2 +- .../T2TraitWithCategoriesTest.class.st | 14 +++---- .../TraitMethodDescriptionTest.class.st | 12 +++--- .../TraitPureBehaviorTest.class.st | 2 +- src/TraitsV2/TaAbstractComposition.class.st | 4 +- src/TraitsV2/TraitedClass.class.st | 2 +- src/TraitsV2/TraitedMetaclass.class.st | 2 +- 19 files changed, 69 insertions(+), 111 deletions(-) diff --git a/src/Fuel-Platform-Core/FLExtensionWrapper.class.st b/src/Fuel-Platform-Core/FLExtensionWrapper.class.st index 8ac53effbb9..ab5aae5b09d 100644 --- a/src/Fuel-Platform-Core/FLExtensionWrapper.class.st +++ b/src/Fuel-Platform-Core/FLExtensionWrapper.class.st @@ -20,14 +20,12 @@ FLExtensionWrapper class >> fromPragma: aPragma [ { #category : #private } FLExtensionWrapper >> compileInTarget [ + | source | - source := self method methodClass instanceSide - perform: self method selector - withArguments: (1 to: self method selector numArgs) asArray. - self targetClass compile: source. - self targetClass organization - classify: self selector - under: self extensionProtocolName + source := self method methodClass instanceSide perform: self method selector withArguments: (1 to: self method selector numArgs) asArray. + self targetClass + compile: source; + classify: self selector under: self extensionProtocolName ] { #category : #private } diff --git a/src/Fuel-Platform-Pharo-12/FLPharo11Platform.class.st b/src/Fuel-Platform-Pharo-12/FLPharo11Platform.class.st index 37d65e7e530..ec09d421bb0 100644 --- a/src/Fuel-Platform-Pharo-12/FLPharo11Platform.class.st +++ b/src/Fuel-Platform-Pharo-12/FLPharo11Platform.class.st @@ -86,12 +86,9 @@ FLPharo11Platform >> readStreamForFilePath: aString [ { #category : #'accessing-compiler' } FLPharo11Platform >> silentlyAddAndClassifySelector: aSymbol inClass: aClass withMethod: aCompiledMethod inProtocol: aString [ - aClass - addSelector: aSymbol - withMethod: aCompiledMethod. - aClass organization - classify: aSymbol - under: aString + + aClass addSelector: aSymbol withMethod: aCompiledMethod. + aClass classify: aSymbol under: aString ] { #category : #'accessing-kernel' } diff --git a/src/Fuel-Platform-Pharo-12/FLPharo12Platform.class.st b/src/Fuel-Platform-Pharo-12/FLPharo12Platform.class.st index 85b195bd8c2..0a6e20f1d93 100644 --- a/src/Fuel-Platform-Pharo-12/FLPharo12Platform.class.st +++ b/src/Fuel-Platform-Pharo-12/FLPharo12Platform.class.st @@ -86,12 +86,9 @@ FLPharo12Platform >> readStreamForFilePath: aString [ { #category : #'accessing-compiler' } FLPharo12Platform >> silentlyAddAndClassifySelector: aSymbol inClass: aClass withMethod: aCompiledMethod inProtocol: aString [ - aClass - addSelector: aSymbol - withMethod: aCompiledMethod. - aClass organization - classify: aSymbol - under: aString + + aClass addSelector: aSymbol withMethod: aCompiledMethod. + aClass classify: aSymbol under: aString ] { #category : #'accessing-kernel' } diff --git a/src/InitializePackagesCommandLineHandler/InitializePackagesCommandLineHandler.class.st b/src/InitializePackagesCommandLineHandler/InitializePackagesCommandLineHandler.class.st index dd7b2d31e1d..f1837399941 100644 --- a/src/InitializePackagesCommandLineHandler/InitializePackagesCommandLineHandler.class.st +++ b/src/InitializePackagesCommandLineHandler/InitializePackagesCommandLineHandler.class.st @@ -75,19 +75,19 @@ InitializePackagesCommandLineHandler >> initializePackagesFrom: aFileName [ { #category : #activation } InitializePackagesCommandLineHandler >> initializeProtocolsFrom: aFileName [ - (File named: aFileName) readStreamDo: [:binaryStream | | stream | + (File named: aFileName) readStreamDo: [ :binaryStream | + | stream | stream := ZnCharacterReadStream on: binaryStream encoding: 'utf8'. - [stream atEnd] whileFalse: [ | line items selector class | + [ stream atEnd ] whileFalse: [ + | line items selector class | line := stream upTo: Character cr. items := line findTokens: String tab. - class := (items second = 'true') - ifTrue: [(Smalltalk classOrTraitNamed: items first) classSide] - ifFalse: [Smalltalk classOrTraitNamed: items first]. + class := items second = 'true' + ifTrue: [ (Smalltalk classOrTraitNamed: items first) classSide ] + ifFalse: [ Smalltalk classOrTraitNamed: items first ]. selector := items third asSymbol. - class ifNil: [ - self error: ('Could not found class: ', items first printString , ' for selector: ', selector printString) ]. + class ifNil: [ self error: 'Could not found class: ' , items first printString , ' for selector: ' , selector printString ]. - (class selectors includes: selector) - ifTrue: [class organization classify: selector under: items fourth]]] + (class selectors includes: selector) ifTrue: [ class classify: selector under: items fourth ] ] ] ] diff --git a/src/Kernel-Tests/ClassOrganizationTest.class.st b/src/Kernel-Tests/ClassOrganizationTest.class.st index 9935949dfdc..1c862d59d3b 100644 --- a/src/Kernel-Tests/ClassOrganizationTest.class.st +++ b/src/Kernel-Tests/ClassOrganizationTest.class.st @@ -20,7 +20,7 @@ ClassOrganizationTest >> setUp [ organization addProtocol: 'empty'. organization addProtocol: 'one'. - organization classify: #one under: 'one' + class classify: #one under: 'one' ] { #category : #tests } @@ -31,40 +31,6 @@ ClassOrganizationTest >> testAddProtocol [ self assert: (class hasProtocol: 'test-protocol') ] -{ #category : #tests } -ClassOrganizationTest >> testCopyFrom [ - - | newOrganization | - "First lets check the current state of the org." - self assertCollection: class protocolNames hasSameElements: #( 'empty' 'one' ). - self assertCollection: (class selectorsInProtocol: #one) hasSameElements: #( 'one' ). - self assertEmpty: (class selectorsInProtocol: #empty). - - "Now lets check that the new org has the same" - newOrganization := ClassOrganization new - setSubject: organization organizedClass; - copyFrom: organization; - yourself. - - self assertCollection: newOrganization organizedClass protocolNames hasSameElements: #( 'empty' 'one' ). - self assertCollection: (newOrganization protocols detect: [ :protocol | protocol name = #one ]) methodSelectors hasSameElements: #( 'one' ). - self assertEmpty: (newOrganization protocols detect: [ :protocol | protocol name = #empty ]) methodSelectors. - - "And now lets check that updating one does not update the other." - organization addProtocol: 'two'. - newOrganization classify: 'new' under: 'init'. - - self assertCollection: class protocolNames hasSameElements: #( 'empty' 'one' 'two' ). - self assertCollection: (class selectorsInProtocol: #one) hasSameElements: #( 'one' ). - self assertEmpty: (class selectorsInProtocol: #empty). - self assertEmpty: (class selectorsInProtocol: #two). - - self assertCollection: (newOrganization protocols collect: #name) hasSameElements: #( 'empty' 'one' 'init' ). - self assertCollection: (newOrganization protocols detect: [ :protocol | protocol name = #one ]) methodSelectors hasSameElements: #( 'one' ). - self assertEmpty: (newOrganization protocols detect: [ :protocol | protocol name = #empty ]) methodSelectors. - self assertCollection: (newOrganization protocols detect: [ :protocol | protocol name = #init ]) methodSelectors hasSameElements: #( 'new' ) -] - { #category : #tests } ClassOrganizationTest >> testRenameProtocolAs [ @@ -81,7 +47,7 @@ ClassOrganizationTest >> testRenameProtocolAs [ { #category : #tests } ClassOrganizationTest >> testRenameProtocolAsWithExistingProtocol [ - organization classify: 'king' under: 'two'. + class classify: 'king' under: 'two'. self assert: (class hasProtocol: #one). self assert: (class hasProtocol: #two). @@ -98,7 +64,7 @@ ClassOrganizationTest >> testRenameProtocolAsWithExistingProtocol [ ClassOrganizationTest >> testRenameProtocolAsWithExistingProtocolWithProtocol [ | one two | - organization classify: 'king' under: 'two'. + class classify: 'king' under: 'two'. one := class protocolNamed: #one. two := class protocolNamed: #two. diff --git a/src/Kernel-Tests/ProtocolAnnouncementsTest.class.st b/src/Kernel-Tests/ProtocolAnnouncementsTest.class.st index 7b961afa12b..7707700cc16 100644 --- a/src/Kernel-Tests/ProtocolAnnouncementsTest.class.st +++ b/src/Kernel-Tests/ProtocolAnnouncementsTest.class.st @@ -59,7 +59,7 @@ ProtocolAnnouncementsTest >> testClassifyUnderAnnounceNewProtocol [ self when: ClassReorganized do: [ :ann | self assert: ann classReorganized name equals: self classNameForTests ]. - organization classify: #king under: #titan. + class classify: #king under: #titan. self assert: numberOfAnnouncements equals: 2 ] @@ -175,7 +175,7 @@ ProtocolAnnouncementsTest >> testRemoveProtocolIfEmptyWithNonExistingProtocolDoe ProtocolAnnouncementsTest >> testRenameProtocolAsAnnounceClassReorganizedOnce [ "This is a regerssion test because at some point the class reorganized announcement got duplicated." - organization classify: #king under: #demon. + class classify: #king under: #demon. self when: ClassReorganized do: [ :ann | self assert: ann classReorganized name equals: self classNameForTests ]. @@ -190,7 +190,7 @@ ProtocolAnnouncementsTest >> testRenameProtocolAsAnnounceNewProtocol [ self skip. "This hihglight the problem of https://github.com/pharo-project/pharo/pull/13494 But we still need to work on this to fix this test." - organization classify: #king under: #demon. + class classify: #king under: #demon. self when: ProtocolAdded do: [ :ann | self assert: ann protocol name equals: #titan. diff --git a/src/Kernel/ClassDescription.class.st b/src/Kernel/ClassDescription.class.st index d74b30d9ced..72cd3b67842 100644 --- a/src/Kernel/ClassDescription.class.st +++ b/src/Kernel/ClassDescription.class.st @@ -35,7 +35,7 @@ ClassDescription >> addAndClassifySelector: selector withMethod: compiledMethod oldProtocol := self protocolOfSelector: selector. SystemAnnouncer uniqueInstance suspendAllWhile: [ "The next part is really ugly with the double if.. BUT! I will fix that in a new PR soon... I want to remove the usage of `Protocol unclassified` as a way to say 'Do not upatde the protocol' because this is counter intuitive." - self organization classify: selector under: ((protocol isString + self classify: selector under: ((protocol isString ifTrue: [ protocol ] ifFalse: [ protocol name ]) = Protocol unclassified ifTrue: [ oldProtocol ] @@ -81,7 +81,7 @@ ClassDescription >> addSelector: selector withMethod: compiledMethod [ oldProtocol := self protocolOfSelector: selector. "If there is no old protocol, then we want to ensure the method is at least in Protocol unclassified to not have protocolless methods." - oldProtocol ifNil: [ SystemAnnouncer uniqueInstance suspendAllWhile: [ self organization classify: selector under: nil ] ]. + oldProtocol ifNil: [ SystemAnnouncer uniqueInstance suspendAllWhile: [ self classify: selector under: nil ] ]. self addSelectorSilently: selector withMethod: compiledMethod. priorMethodOrNil diff --git a/src/Kernel/ClassOrganization.class.st b/src/Kernel/ClassOrganization.class.st index 088c5918c38..586fb2711f5 100644 --- a/src/Kernel/ClassOrganization.class.st +++ b/src/Kernel/ClassOrganization.class.st @@ -106,7 +106,7 @@ ClassOrganization >> initializeClass: aClass [ self initialize. organizedClass := aClass. - organizedClass selectors do: [ :each | self classify: each under: Protocol unclassified ] + organizedClass selectors do: [ :each | self organizedClass classify: each under: Protocol unclassified ] ] { #category : #accessing } diff --git a/src/Kernel/CompiledMethod.class.st b/src/Kernel/CompiledMethod.class.st index 7e0d2aa1106..6e8d0025172 100644 --- a/src/Kernel/CompiledMethod.class.st +++ b/src/Kernel/CompiledMethod.class.st @@ -793,7 +793,7 @@ CompiledMethod >> protocol [ { #category : #accessing } CompiledMethod >> protocol: aProtocol [ - ^ self methodClass organization classify: self selector under: aProtocol + ^ self methodClass classify: self selector under: aProtocol ] { #category : #scanning } diff --git a/src/Monticello-Tests/RPackageMCSynchronisationTest.class.st b/src/Monticello-Tests/RPackageMCSynchronisationTest.class.st index 9b031be843c..beb61355299 100644 --- a/src/Monticello-Tests/RPackageMCSynchronisationTest.class.st +++ b/src/Monticello-Tests/RPackageMCSynchronisationTest.class.st @@ -247,7 +247,7 @@ RPackageMCSynchronisationTest >> testNotRepackagedAnnouncementWhenModifyMethodBy self assert: ann isNil. - class organization classify: #stubMethod under: '*yyyyy-suncategory'. + class classify: #stubMethod under: '*yyyyy-suncategory'. self assert: ann isNil ] @@ -269,7 +269,7 @@ RPackageMCSynchronisationTest >> testNotRepackagedAnnouncementWhenMovingClassicC self assert: ann isNil. - class organization classify: #stubMethod under: 'another classic one'. + class classify: #stubMethod under: 'another classic one'. self assert: ann isNil ] @@ -288,7 +288,7 @@ RPackageMCSynchronisationTest >> testRepackagedAnnouncementWhenModifyMethodByMov class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'. self createMethodNamed: 'stubMethod' inClass: class inCategory: 'classic category'. - class organization classify: #stubMethod under: '*yyyyy'. + class classify: #stubMethod under: '*yyyyy'. self assert: ann notNil. self assert: ann methodRepackaged selector equals: #stubMethod. @@ -296,7 +296,7 @@ RPackageMCSynchronisationTest >> testRepackagedAnnouncementWhenModifyMethodByMov self assert: ann newPackage equals: secondPackage. ann := nil. - class organization classify: #stubMethod under: '*yyyyy-suncategory'. + class classify: #stubMethod under: '*yyyyy-suncategory'. self assert: ann isNil ] @@ -317,7 +317,7 @@ RPackageMCSynchronisationTest >> testRepackagedAnnouncementWhenModifyMethodByMov class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'. self createMethodNamed: 'stubMethod' inClass: class inCategory: '*yyyyy'. - class organization classify: #stubMethod under: '*zzzzz'. + class classify: #stubMethod under: '*zzzzz'. self assert: ann notNil. self assert: ann methodRepackaged selector equals: #stubMethod. @@ -339,7 +339,7 @@ RPackageMCSynchronisationTest >> testRepackagedAnnouncementWhenModifyMethodByMov class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'. self createMethodNamed: 'stubMethod' inClass: class inCategory: '*yyyyy'. - class organization classify: #stubMethod under: 'classic one'. + class classify: #stubMethod under: 'classic one'. self assert: ann notNil. self assert: ann methodRepackaged selector equals: #stubMethod. diff --git a/src/Monticello-Tests/RPackageMethodsSynchronisationTest.class.st b/src/Monticello-Tests/RPackageMethodsSynchronisationTest.class.st index aae935ac12a..495a7eae32c 100644 --- a/src/Monticello-Tests/RPackageMethodsSynchronisationTest.class.st +++ b/src/Monticello-Tests/RPackageMethodsSynchronisationTest.class.st @@ -50,7 +50,7 @@ RPackageMethodsSynchronisationTest >> testModifyMethodByMovingFromClassicCategor self createMethodNamed: 'stubMethod' inClass: class inCategory: 'classic category'. "this we do" - class organization classify: #stubMethod under: 'new category'. + class classify: #stubMethod under: 'new category'. "this we check" self assert: (class >> #stubMethod) category equals: 'new category'. @@ -70,12 +70,12 @@ RPackageMethodsSynchronisationTest >> testModifyMethodByMovingFromClassicCategor class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'. self createMethodNamed: 'stubMethod' inClass: class inCategory: 'classic category'. - class organization classify: #stubMethod under: '*yyyyy'. + class classify: #stubMethod under: '*yyyyy'. self deny: (firstPackage includesDefinedSelector: #stubMethod ofClass: class). self assert: (secondPackage includesExtensionSelector: #stubMethod ofClass: class). self assert: (class >> #stubMethod packageFromOrganizer: self organizer) equals: secondPackage. - class organization classify: #stubMethod under: '*yyyyy-subcategory'. + class classify: #stubMethod under: '*yyyyy-subcategory'. self deny: (firstPackage includesDefinedSelector: #stubMethod ofClass: class). self assert: (secondPackage includesExtensionSelector: #stubMethod ofClass: class). self assert: (class >> #stubMethod packageFromOrganizer: self organizer) equals: secondPackage @@ -93,7 +93,7 @@ RPackageMethodsSynchronisationTest >> testModifyMethodByMovingFromExtensionCateg class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'. self createMethodNamed: 'stubMethod' inClass: class inCategory: '*yyyyy'. - class organization classify: #stubMethod under: 'classic category'. + class classify: #stubMethod under: 'classic category'. self assert: (firstPackage includesDefinedSelector: #stubMethod ofClass: class). self deny: (secondPackage includesExtensionSelector: #stubMethod ofClass: class). self assert: (class >> #stubMethod packageFromOrganizer: self organizer) equals: firstPackage @@ -103,19 +103,19 @@ RPackageMethodsSynchronisationTest >> testModifyMethodByMovingFromExtensionCateg RPackageMethodsSynchronisationTest >> testModifyMethodByMovingFromExtensionCategoryToExtensionCategoryMoveItFromExtendingPackageToSecondExtendingPackage [ "test that when we move a method from an extension category ( begining with *) to another extending package , the method is moved from the extending package to the other extending package" - | class XPackage YPackage ZPackage | + | class xPackage yPackage zPackage | self addXYZCategory. - XPackage := self organizer packageNamed: #XXXXX. - YPackage := self organizer packageNamed: #YYYYY. - ZPackage := self organizer packageNamed: #ZZZZZ. + xPackage := self organizer packageNamed: #XXXXX. + yPackage := self organizer packageNamed: #YYYYY. + zPackage := self organizer packageNamed: #ZZZZZ. class := self createNewClassNamed: 'NewClass' inCategory: 'XXXXX'. self createMethodNamed: #newMethod inClass: class inCategory: '*yyyyy'. - class organization classify: #newMethod under: '*zzzzz'. - self deny: (XPackage includesDefinedSelector: #newMethod ofClass: class). - self deny: (YPackage includesExtensionSelector: #newMethod ofClass: class). - self assert: (ZPackage includesExtensionSelector: #newMethod ofClass: class). - self assert: (class >> #newMethod packageFromOrganizer: self organizer) equals: ZPackage + class classify: #newMethod under: '*zzzzz'. + self deny: (xPackage includesDefinedSelector: #newMethod ofClass: class). + self deny: (yPackage includesExtensionSelector: #newMethod ofClass: class). + self assert: (zPackage includesExtensionSelector: #newMethod ofClass: class). + self assert: (class >> #newMethod packageFromOrganizer: self organizer) equals: zPackage ] { #category : #'tests - operations on methods' } diff --git a/src/Monticello/MethodAddition.class.st b/src/Monticello/MethodAddition.class.st index a54a9059f1d..2fa5a68f255 100644 --- a/src/Monticello/MethodAddition.class.st +++ b/src/Monticello/MethodAddition.class.st @@ -60,7 +60,7 @@ MethodAddition >> installMethod [ { #category : #notifying } MethodAddition >> notifyObservers [ SystemAnnouncer uniqueInstance - suspendAllWhile: [myClass organization classify: selector under: category]. + suspendAllWhile: [myClass classify: selector under: category]. priorMethodOrNil ifNil: [ SystemAnnouncer uniqueInstance methodAdded: compiledMethod diff --git a/src/RPackage-Tests/RPackageTest.class.st b/src/RPackage-Tests/RPackageTest.class.st index 0cc47dec5b0..d9325bf77c6 100644 --- a/src/RPackage-Tests/RPackageTest.class.st +++ b/src/RPackage-Tests/RPackageTest.class.st @@ -107,7 +107,7 @@ RPackageTest >> testAnonymousClassAndSelector [ ghost addSelector: #rpackagetest withMethod: method. self deny: (uPackage includesDefinedSelector: #rpackagetest ofClass: ghost). self deny: (self organizer packageOfClassNamed: ghost name) notNil. - ghost organization classify: #rpackagetest under: '*rpackagetest' + ghost classify: #rpackagetest under: '*rpackagetest' ] { #category : #tests } diff --git a/src/TraitsV2-Tests/T2TraitWithCategoriesTest.class.st b/src/TraitsV2-Tests/T2TraitWithCategoriesTest.class.st index 923650b7746..3dd2a72d7c0 100644 --- a/src/TraitsV2-Tests/T2TraitWithCategoriesTest.class.st +++ b/src/TraitsV2-Tests/T2TraitWithCategoriesTest.class.st @@ -49,17 +49,17 @@ T2TraitWithCategoriesTest >> testPackageOfMethodFromTraitsChanged [ { #category : #tests } T2TraitWithCategoriesTest >> testPackageOfMethodFromTraitsChangedWithoutCompile [ - | t1 t2 | + | trait1 trait2 | - t1 := self newTrait: #T1 with: #() uses: {}. - t1 compile: 'm1 ^42.' classified: 'aProtocol'. + trait1 := self newTrait: #T1 with: #() uses: {}. + trait1 compile: 'm1 ^42.' classified: 'aProtocol'. - t2 := self newTrait: #T2 with: #() uses: t1. + trait2 := self newTrait: #T2 with: #() uses: trait1. - t1 organization classify: #m1 under: 'anotherProtocol'. + trait1 classify: #m1 under: 'anotherProtocol'. - self assert: (t1 >> #m1) protocol equals: 'anotherProtocol'. - self assert: (t2 >> #m1) protocol equals: 'anotherProtocol' + self assert: (trait1 >> #m1) protocol equals: 'anotherProtocol'. + self assert: (trait2 >> #m1) protocol equals: 'anotherProtocol' ] { #category : #tests } diff --git a/src/TraitsV2-Tests/TraitMethodDescriptionTest.class.st b/src/TraitsV2-Tests/TraitMethodDescriptionTest.class.st index 58b5e0195ff..6028af923c1 100644 --- a/src/TraitsV2-Tests/TraitMethodDescriptionTest.class.st +++ b/src/TraitsV2-Tests/TraitMethodDescriptionTest.class.st @@ -70,7 +70,7 @@ TraitMethodDescriptionTest >> testConflictingProtocols [ self deny: (t7 hasProtocol: Protocol traitConflictName). self t1 compile: 'm11' classified: #cat1. t8 := self createTraitNamed: #T8 uses: self t1 + self t2. - t8 organization classify: #m11 under: #cat1. + t8 classify: #m11 under: #cat1. self t1 organization classify: #m11 under: #catZ. self assert: (self t4 protocolOfSelector: #m11) name equals: #catX. self assert: (self t5 protocolOfSelector: #m11) name equals: Protocol traitConflictName. @@ -86,16 +86,16 @@ TraitMethodDescriptionTest >> testProtocols [ self assert: (self t4 protocolOfSelector: #m12) name equals: #cat2. self assert: (self t4 protocolOfSelector: #m13) name equals: #cat3. self assert: (self t6 protocolOfSelector: #m22Alias) name equals: #cat2. - self t2 organization classify: #m22 under: #catX. + self t2 classify: #m22 under: #catX. self assert: (self t4 protocolOfSelector: #m22) name equals: #catX. self assert: (self t6 protocolOfSelector: #m22Alias) name equals: #catX. - self t6 organization classify: #m22 under: #catY. - self t6 organization classify: #m22Alias under: #catY. - self t2 organization classify: #m22 under: #catZ. + self t6 classify: #m22 under: #catY. + self t6 classify: #m22Alias under: #catY. + self t2 classify: #m22 under: #catZ. self assert: (self t6 protocolOfSelector: #m22) name equals: #catY. self assert: (self t6 protocolOfSelector: #m22Alias) name equals: #catY. self t1 compile: 'mA' classified: #catA. self assert: (self t4 protocolOfSelector: #mA) name equals: #catA. - self t1 organization classify: #mA under: #cat1. + self t1 classify: #mA under: #cat1. self assert: (self t4 hasProtocol: #catA) not ] diff --git a/src/TraitsV2-Tests/TraitPureBehaviorTest.class.st b/src/TraitsV2-Tests/TraitPureBehaviorTest.class.st index 4145d2d717a..0391771d414 100644 --- a/src/TraitsV2-Tests/TraitPureBehaviorTest.class.st +++ b/src/TraitsV2-Tests/TraitPureBehaviorTest.class.st @@ -161,7 +161,7 @@ TraitPureBehaviorTest >> testMethodProtocolUpdate [ self t1 compile: 'm1' classified: 'category1'. self assert: (self t5 protocolOfSelector: #m1) name equals: #category1. self assert: (self c2 protocolOfSelector: #m1) name equals: #category1. - self t1 organization classify: #m1 under: #category2. + self t1 classify: #m1 under: #category2. self assert: (self t5 protocolOfSelector: #m1) name equals: #category2. self assert: (self c2 protocolOfSelector: #m1) name equals: #category2 ] diff --git a/src/TraitsV2/TaAbstractComposition.class.st b/src/TraitsV2/TaAbstractComposition.class.st index ab7a1daac1d..1c9325460d5 100644 --- a/src/TraitsV2/TaAbstractComposition.class.st +++ b/src/TraitsV2/TaAbstractComposition.class.st @@ -146,7 +146,7 @@ TaAbstractComposition >> compile: selector into: aClass [ ifTrue: [ self saveSourceCode: sourceCode ofMethod: newMethod ] ifFalse: [ newMethod setSourcePointer: method sourcePointer ]. - aClass organization classify: selector under: (self protocolForMethod: method). + aClass classify: selector under: (self protocolForMethod: method). aClass addSelectorSilently: selector withMethod: newMethod. @@ -204,7 +204,7 @@ TaAbstractComposition >> copyMethod: aSelector into: aClass replacing: replacing newMethod setSourcePointer: aCompiledMethod sourcePointer. - aClass organization classify: aSelector under: aCompiledMethod protocol. + aClass classify: aSelector under: aCompiledMethod protocol. aClass addSelectorSilently: aSelector withMethod: newMethod. diff --git a/src/TraitsV2/TraitedClass.class.st b/src/TraitsV2/TraitedClass.class.st index f0364652680..f508166d3d6 100644 --- a/src/TraitsV2/TraitedClass.class.st +++ b/src/TraitsV2/TraitedClass.class.st @@ -255,7 +255,7 @@ TraitedClass >> recategorizeSelector: selector from: oldProtocol to: newProtocol newProtocol ifNil: [ ^ self ]. originalProtocol := (self protocolOfSelector: selector) ifNil: [ ^ self ]. - originalProtocol name = oldProtocol name ifTrue: [ self organization classify: selector under: newProtocol name ]. + originalProtocol name = oldProtocol name ifTrue: [ self classify: selector under: newProtocol name ]. (self traitComposition reverseAlias: selector) do: [ :selectorAlias | self recategorizeSelector: selectorAlias from: oldProtocol to: newProtocol. diff --git a/src/TraitsV2/TraitedMetaclass.class.st b/src/TraitsV2/TraitedMetaclass.class.st index e4918ba50b0..e78569aa367 100644 --- a/src/TraitsV2/TraitedMetaclass.class.st +++ b/src/TraitsV2/TraitedMetaclass.class.st @@ -277,7 +277,7 @@ TraitedMetaclass >> recategorizeSelector: selector from: oldProtocol to: newProt newProtocol ifNil: [ ^ self ]. originalProtocol := (self protocolOfSelector: selector) ifNil: [ ^ self ]. - originalProtocol name = oldProtocol name ifTrue: [ self organization classify: selector under: newProtocol name ]. + originalProtocol name = oldProtocol name ifTrue: [ self classify: selector under: newProtocol name ]. (self traitComposition reverseAlias: selector) do: [ :selectorAlias | self recategorizeSelector: selectorAlias from: oldProtocol to: newProtocol. From 4fa060a74142787700871b78eeb63e296fb795ae Mon Sep 17 00:00:00 2001 From: CyrilFerlicot Date: Mon, 29 May 2023 12:39:41 +0200 Subject: [PATCH 3/4] Remove old version --- src/Kernel/ClassOrganization.class.st | 16 ---------------- 1 file changed, 16 deletions(-) diff --git a/src/Kernel/ClassOrganization.class.st b/src/Kernel/ClassOrganization.class.st index 586fb2711f5..ac77b17adba 100644 --- a/src/Kernel/ClassOrganization.class.st +++ b/src/Kernel/ClassOrganization.class.st @@ -44,22 +44,6 @@ ClassOrganization >> allMethodSelectors [ ^ self organizedClass selectors ] -{ #category : #classification } -ClassOrganization >> classify: selector under: aProtocol [ - - | oldProtocol newProtocol | - (newProtocol := self ensureProtocol: aProtocol) = (oldProtocol := self protocolOfSelector: selector) ifTrue: [ ^ self ]. - - oldProtocol ifNotNil: [ - oldProtocol removeMethodSelector: selector. - self removeProtocolIfEmpty: oldProtocol ]. - - newProtocol addMethodSelector: selector. - - "During the first classification of a method we dont need to announce the classification because users can subscribe to the method added announcement." - oldProtocol ifNotNil: [ self organizedClass notifyOfRecategorizedSelector: selector from: oldProtocol to: newProtocol ] -] - { #category : #copying } ClassOrganization >> copyFrom: otherOrganization [ From 504b837dfc0ccd291161c3ca58bb8f1d924221cf Mon Sep 17 00:00:00 2001 From: CyrilFerlicot Date: Mon, 29 May 2023 14:59:34 +0200 Subject: [PATCH 4/4] Fix tests --- src/Kernel-Tests/ClassDescriptionProtocolsTest.class.st | 4 ++-- src/TraitsV2-Tests/TraitMethodDescriptionTest.class.st | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Kernel-Tests/ClassDescriptionProtocolsTest.class.st b/src/Kernel-Tests/ClassDescriptionProtocolsTest.class.st index 62996e4f988..4b2cbc8e4d6 100644 --- a/src/Kernel-Tests/ClassDescriptionProtocolsTest.class.st +++ b/src/Kernel-Tests/ClassDescriptionProtocolsTest.class.st @@ -219,8 +219,8 @@ ClassDescriptionProtocolsTest >> testProtocolOfSelector [ { #category : #tests } ClassDescriptionProtocolsTest >> testRemoveFromProtocols [ - class organization classify: #amity under: #witch. - class organization classify: #edalyn under: #witch. + class classify: #amity under: #witch. + class classify: #edalyn under: #witch. self assert: (class hasProtocol: #witch). self assertCollection: (class selectorsInProtocol: #witch) hasSameElements: #( #amity #edalyn ). diff --git a/src/TraitsV2-Tests/TraitMethodDescriptionTest.class.st b/src/TraitsV2-Tests/TraitMethodDescriptionTest.class.st index 6028af923c1..226d47d2fb9 100644 --- a/src/TraitsV2-Tests/TraitMethodDescriptionTest.class.st +++ b/src/TraitsV2-Tests/TraitMethodDescriptionTest.class.st @@ -71,7 +71,7 @@ TraitMethodDescriptionTest >> testConflictingProtocols [ self t1 compile: 'm11' classified: #cat1. t8 := self createTraitNamed: #T8 uses: self t1 + self t2. t8 classify: #m11 under: #cat1. - self t1 organization classify: #m11 under: #catZ. + self t1 classify: #m11 under: #catZ. self assert: (self t4 protocolOfSelector: #m11) name equals: #catX. self assert: (self t5 protocolOfSelector: #m11) name equals: Protocol traitConflictName. self assert: (t8 protocolOfSelector: #m11) name equals: #catZ