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.

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

ClassDescription>>protocols should return protocols #13674

Merged
Merged
2 changes: 1 addition & 1 deletion src/Calypso-SystemQueries/ClassDescription.extension.st
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ ClassDescription >> tagsForAllMethods [
"I act as #tagsForMethods but I also takes into account methods comming from traits"

| allProtocols |
allProtocols := self organization protocols reject: [ :each | each isUnclassifiedProtocol | each isExtensionProtocol ].
allProtocols := self protocols reject: [ :each | each isUnclassifiedProtocol | each isExtensionProtocol ].

^ allProtocols
select: [ :protocol | protocol methodSelectors ifEmpty: [ true ] ifNotEmpty: [ :methods | methods anySatisfy: [ :method | self selectors includes: method ] ] ]
Expand Down
2 changes: 1 addition & 1 deletion src/Calypso-SystemQueries/TraitedMetaclass.extension.st
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ TraitedMetaclass >> tagsForAllMethods [
"I act as #tagsForMethods but I also takes into account methods comming from traits"

| allProtocols selectors |
allProtocols := self organization protocols reject: [ :each | each isUnclassifiedProtocol | each isExtensionProtocol ].
allProtocols := self protocols reject: [ :each | each isUnclassifiedProtocol | each isExtensionProtocol ].

selectors := self visibleMethods collect: [ :each | each selector ].

Expand Down
4 changes: 2 additions & 2 deletions src/CodeExport/ClassDescription.extension.st
Original file line number Diff line number Diff line change
Expand Up @@ -5,7 +5,7 @@ ClassDescription >> fileOutChangedMessages: aSet on: aFileStream [
"File a description of the messages of this class that have been
changed (i.e., are entered into the argument, aSet) onto aFileStream."

self organization protocols do: [ :protocol |
self protocols do: [ :protocol |
protocol methodSelectors
select: [ :selector | aSet includes: selector ]
thenDo: [ :selector | self printMethodChunk: selector on: aFileStream ] ]
Expand Down Expand Up @@ -49,7 +49,7 @@ ClassDescription >> fileOutOn: aFileStream [

aFileStream nextChunkPut: self oldPharoDefinition.
self putCommentOnFile: aFileStream.
self organization protocols do: [ :protocol | self fileOutLocalMethodsInProtocol: protocol on: aFileStream ]
self protocols do: [ :protocol | self fileOutLocalMethodsInProtocol: protocol on: aFileStream ]
]

{ #category : #'*CodeExport' }
Expand Down
14 changes: 14 additions & 0 deletions src/Kernel-Tests/ClassDescriptionProtocolsTest.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -222,6 +222,20 @@ ClassDescriptionProtocolsTest >> testProtocolNames [
self assertCollection: class protocolNames hasSameElements: #( #human #witch )
]

{ #category : #tests }
ClassDescriptionProtocolsTest >> testProtocols [

class organization addProtocol: #titan.
class organization addProtocol: #human.
class organization addProtocol: #witch.

self assertCollection: class protocols hasSameElements: (#( #titan #human #witch ) collect: [ :protocolName | class protocolNamed: protocolName ]).

class organization removeProtocolIfEmpty: #titan.

self assertCollection: class protocols hasSameElements: (#( #human #witch ) collect: [ :protocolName | class protocolNamed: protocolName ])
]

{ #category : #tests }
ClassDescriptionProtocolsTest >> testProtocolOfSelector [

Expand Down
11 changes: 10 additions & 1 deletion src/Kernel/ClassDescription.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -815,6 +815,15 @@ ClassDescription >> protocolNames [
^ self organization protocols collect: [ :protocol | protocol name ]
]

{ #category : #protocols }
ClassDescription >> protocols [
"I return all the protocols contained in me.
In the past I was returning the protocol names but now I am returning the instances directly. If you want to deal with the names you can use #protocolNames."

^ self organization protocols
]


{ #category : #protocols }
ClassDescription >> protocolOfSelector: aSelector [
"Return the protocol including the method of the same name as the selector.
Expand Down Expand Up @@ -1097,7 +1106,7 @@ ClassDescription >> tagsForMethods [
which is opposite to current Protocol implementation.
And extension protocol is not treated as tag"
| allProtocols |
allProtocols := self organization protocols reject: [ :each | each isUnclassifiedProtocol | each isExtensionProtocol ].
allProtocols := self protocols reject: [ :each | each isUnclassifiedProtocol | each isExtensionProtocol ].

^ allProtocols select: [ :each | self isLocalMethodsProtocol: each ] thenCollect: #name
]
Expand Down
1 change: 1 addition & 0 deletions src/Monticello/MCClassDefinition.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -171,6 +171,7 @@ MCClassDefinition >> createClass [
ifTrue: [ Context comment = comment
ifFalse: [ Context comment: comment stamp: commentStamp ].
^ self ].

superClass := superclassName = #nil
ifFalse: [ Smalltalk globals at: superclassName ].
^ [ Smalltalk classInstaller
Expand Down
8 changes: 4 additions & 4 deletions src/RPackage-Core/RPackageOrganizer.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -576,13 +576,13 @@ RPackageOrganizer >> initializeFor: aBehavior [

{ #category : #'initialization - data' }
RPackageOrganizer >> initializeMethodsFor: aBehavior [
| package |

| package |
package := aBehavior package.
(aBehavior organization protocols
(aBehavior protocols
reject: [ :each | each isExtensionProtocol ])
do: [ :eachProtocol |
(eachProtocol methodSelectors
do: [ :protocol |
(protocol methodSelectors
select: [ :eachSelector | (aBehavior >> eachSelector) origin = aBehavior ])
do: [ :eachSelector | package addMethod: (aBehavior >> eachSelector) ] ]
]
Expand Down
3 changes: 1 addition & 2 deletions src/ReleaseTests/ProperMethodCategorizationTest.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -139,8 +139,7 @@ ProperMethodCategorizationTest >> testNoEmptyProtocols [
| violations |
violations := Dictionary new.
ProtoObject withAllSubclasses do: [ :cls |
(cls organization protocols select: [ :protocol | protocol isEmpty ])
ifNotEmpty: [ :emptyProtocols | violations at: cls put: emptyProtocols ] ].
(cls protocols select: [ :protocol | protocol isEmpty ]) ifNotEmpty: [ :emptyProtocols | violations at: cls put: emptyProtocols ] ].

self assertEmpty: violations
]
Expand Down
10 changes: 0 additions & 10 deletions src/Ring-Definitions-Core/ClassDescription.extension.st

This file was deleted.