diff --git a/src/Calypso-SystemQueries/ClassDescription.extension.st b/src/Calypso-SystemQueries/ClassDescription.extension.st index cb7ca6785f4..fad59e83295 100644 --- a/src/Calypso-SystemQueries/ClassDescription.extension.st +++ b/src/Calypso-SystemQueries/ClassDescription.extension.st @@ -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 ] ] ] diff --git a/src/Calypso-SystemQueries/TraitedMetaclass.extension.st b/src/Calypso-SystemQueries/TraitedMetaclass.extension.st index de91e867d7e..90a20a08b70 100644 --- a/src/Calypso-SystemQueries/TraitedMetaclass.extension.st +++ b/src/Calypso-SystemQueries/TraitedMetaclass.extension.st @@ -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 ]. diff --git a/src/CodeExport/ClassDescription.extension.st b/src/CodeExport/ClassDescription.extension.st index 6dabf7127de..648024f2d83 100644 --- a/src/CodeExport/ClassDescription.extension.st +++ b/src/CodeExport/ClassDescription.extension.st @@ -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 ] ] @@ -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' } diff --git a/src/Kernel-Tests/ClassDescriptionProtocolsTest.class.st b/src/Kernel-Tests/ClassDescriptionProtocolsTest.class.st index bb5c6f616f6..783d6572aa6 100644 --- a/src/Kernel-Tests/ClassDescriptionProtocolsTest.class.st +++ b/src/Kernel-Tests/ClassDescriptionProtocolsTest.class.st @@ -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 [ diff --git a/src/Kernel/ClassDescription.class.st b/src/Kernel/ClassDescription.class.st index 67756449862..fa35baa0667 100644 --- a/src/Kernel/ClassDescription.class.st +++ b/src/Kernel/ClassDescription.class.st @@ -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. @@ -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 ] diff --git a/src/Monticello/MCClassDefinition.class.st b/src/Monticello/MCClassDefinition.class.st index f4a087bafe2..fec7e6c1575 100644 --- a/src/Monticello/MCClassDefinition.class.st +++ b/src/Monticello/MCClassDefinition.class.st @@ -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 diff --git a/src/RPackage-Core/RPackageOrganizer.class.st b/src/RPackage-Core/RPackageOrganizer.class.st index 891e0160961..9f1b4755c59 100644 --- a/src/RPackage-Core/RPackageOrganizer.class.st +++ b/src/RPackage-Core/RPackageOrganizer.class.st @@ -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) ] ] ] diff --git a/src/ReleaseTests/ProperMethodCategorizationTest.class.st b/src/ReleaseTests/ProperMethodCategorizationTest.class.st index 5f74e9e23d2..feca802dc0e 100644 --- a/src/ReleaseTests/ProperMethodCategorizationTest.class.st +++ b/src/ReleaseTests/ProperMethodCategorizationTest.class.st @@ -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 ] diff --git a/src/Ring-Definitions-Core/ClassDescription.extension.st b/src/Ring-Definitions-Core/ClassDescription.extension.st deleted file mode 100644 index 36b11fadee9..00000000000 --- a/src/Ring-Definitions-Core/ClassDescription.extension.st +++ /dev/null @@ -1,10 +0,0 @@ -Extension { #name : #ClassDescription } - -{ #category : #'*Ring-Definitions-Core' } -ClassDescription >> protocols [ - - self - deprecated: 'Use #protocolNames instead because I should return real protocols and not just names.' - transformWith: '`@rcv protocols' -> '`@rcv protocolNames'. - ^ self organization protocolNames copy -]