Merge 494fcbe into f00fe78

src/BaselineOfChanel/BaselineOfChanel.class.st

@@ -12,8 +12,10 @@ BaselineOfChanel >> baseline: spec [
 	<baseline>
 	spec
 		for: #common
-		do: [ spec
-				package: 'Chanel';
+		do: [ self iterators: spec.
+
+			spec
+				package: 'Chanel' with: [ spec requires: #('Iterators') ];
 				package: 'Chanel-Tests' with: [ spec requires: #('Chanel') ].
 
 			spec
@@ -27,6 +29,15 @@ BaselineOfChanel >> baseline: spec [
 				package: 'Chanel-Tests' with: [ spec requires: 'Chanel-Pharo7' ] ]
 ]
 
+{ #category : #dependencies }
+BaselineOfChanel >> iterators: spec [
+	spec
+		baseline: 'Iterators'
+		with: [ spec
+				loads: #('core' 'collections' 'shell-dsl' 'inspector-extensions');
+				repository: 'github://juliendelplanque/Iterators:v1.x.x/src' ]
+]
+
 { #category : #dependencies }
 BaselineOfChanel >> pharoBackwardCompatibility: spec [
 	spec baseline: 'PharoBackwardCompatibility' with: [ spec repository: 'github://jecisc/PharoBackwardCompatibility:v1.x.x/src' ]

src/Chanel-Tests/ChanelProtocolsCleanerTest.class.st

@@ -13,7 +13,7 @@ ChanelProtocolsCleanerTest >> setUp [
 	class := self createClassNamed: #ChanelProtocolsFake
 ]
 
-{ #category : #running }
+{ #category : #tests }
 ChanelProtocolsCleanerTest >> testDoesNotUpdateCloseProtocolIfAlreadyRight [
 	class compile: 'method' classified: 'instance creation'.
 
@@ -22,7 +22,7 @@ ChanelProtocolsCleanerTest >> testDoesNotUpdateCloseProtocolIfAlreadyRight [
 	self assert: (class >> #method) protocol equals: 'instance creation'
 ]
 
-{ #category : #running }
+{ #category : #tests }
 ChanelProtocolsCleanerTest >> testMethodInSpecificProtocol [
 	class compile: 'initialize' classified: 'random'.
 
@@ -31,7 +31,7 @@ ChanelProtocolsCleanerTest >> testMethodInSpecificProtocol [
 	self assert: (class >> #initialize) protocol equals: 'initialization'
 ]
 
-{ #category : #running }
+{ #category : #tests }
 ChanelProtocolsCleanerTest >> testMethodInSpecificProtocolNotUpdateIfExtension [
 	class compile: 'initialize' classified: self extensionProtocol.
 
@@ -40,7 +40,7 @@ ChanelProtocolsCleanerTest >> testMethodInSpecificProtocolNotUpdateIfExtension [
 	self assert: (class >> #initialize) protocol equals: self extensionProtocol
 ]
 
-{ #category : #running }
+{ #category : #tests }
 ChanelProtocolsCleanerTest >> testMethodInSpecificProtocolNotUpdateIfNotInTheList [
 	class compile: 'initialize2' classified: 'random'.
 
@@ -49,7 +49,7 @@ ChanelProtocolsCleanerTest >> testMethodInSpecificProtocolNotUpdateIfNotInTheLis
 	self assert: (class >> #initialize2) protocol equals: 'random'
 ]
 
-{ #category : #running }
+{ #category : #tests }
 ChanelProtocolsCleanerTest >> testTestMethodInSpecificProtocol [
 	class := self createTestCaseNamed: #ChanelProtocolsFake.
 	class compile: 'setUp' classified: 'random'.
@@ -59,7 +59,7 @@ ChanelProtocolsCleanerTest >> testTestMethodInSpecificProtocol [
 	self assert: (class >> #setUp) protocol equals: 'running'
 ]
 
-{ #category : #running }
+{ #category : #tests }
 ChanelProtocolsCleanerTest >> testTestMethodInSpecificProtocolNotUpdatedIfExtension [
 	class := self createTestCaseNamed: #ChanelProtocolsFake.
 	class compile: 'setUp' classified: self extensionProtocol.
@@ -69,7 +69,7 @@ ChanelProtocolsCleanerTest >> testTestMethodInSpecificProtocolNotUpdatedIfExtens
 	self assert: (class >> #setUp) protocol equals: self extensionProtocol
 ]
 
-{ #category : #running }
+{ #category : #tests }
 ChanelProtocolsCleanerTest >> testTestMethodInSpecificProtocolNotUpdatedIfNotInTestCase [
 	class compile: 'setUp' classified: 'random'.
 
@@ -78,7 +78,7 @@ ChanelProtocolsCleanerTest >> testTestMethodInSpecificProtocolNotUpdatedIfNotInT
 	self assert: (class >> #setUp) protocol equals: 'random'
 ]
 
-{ #category : #running }
+{ #category : #tests }
 ChanelProtocolsCleanerTest >> testTestMethodInSpecificProtocolNotUpdatedIfNotInTheList [
 	class := self createTestCaseNamed: #ChanelProtocolsFake.
 	class compile: 'toto' classified: 'random'.
@@ -88,7 +88,7 @@ ChanelProtocolsCleanerTest >> testTestMethodInSpecificProtocolNotUpdatedIfNotInT
 	self assert: (class >> #toto) protocol equals: 'random'
 ]
 
-{ #category : #running }
+{ #category : #tests }
 ChanelProtocolsCleanerTest >> testTestMethodsAreInRightProtocol [
 	class := self createTestCaseNamed: #ChanelProtocolsFake.
 	class compile: 'testMethod' classified: 'not a test'.
@@ -98,7 +98,7 @@ ChanelProtocolsCleanerTest >> testTestMethodsAreInRightProtocol [
 	self assert: (class >> #testMethod) protocol equals: 'tests'
 ]
 
-{ #category : #running }
+{ #category : #tests }
 ChanelProtocolsCleanerTest >> testTestMethodsProtocolAreNotUpdateIfExtension [
 	class := self createTestCaseNamed: #ChanelProtocolsFake.
 	class compile: 'testMethod' classified: self extensionProtocol.
@@ -108,7 +108,7 @@ ChanelProtocolsCleanerTest >> testTestMethodsProtocolAreNotUpdateIfExtension [
 	self assert: (class >> #testMethod) protocol equals: self extensionProtocol
 ]
 
-{ #category : #running }
+{ #category : #tests }
 ChanelProtocolsCleanerTest >> testTestMethodsProtocolAreNotUpdateIfNotInTestCase [
 	class compile: 'testMethod' classified: 'not a test'.
 
@@ -117,7 +117,7 @@ ChanelProtocolsCleanerTest >> testTestMethodsProtocolAreNotUpdateIfNotInTestCase
 	self assert: (class >> #testMethod) protocol equals: 'not a test'
 ]
 
-{ #category : #running }
+{ #category : #tests }
 ChanelProtocolsCleanerTest >> testTestMethodsProtocolAreNotUpdateIfStartingByTest [
 	class := self createTestCaseNamed: #ChanelProtocolsFake.
 	class compile: 'testMethod' classified: 'test - protocols'.
@@ -127,7 +127,7 @@ ChanelProtocolsCleanerTest >> testTestMethodsProtocolAreNotUpdateIfStartingByTes
 	self assert: (class >> #testMethod) protocol equals: 'test - protocols'
 ]
 
-{ #category : #running }
+{ #category : #tests }
 ChanelProtocolsCleanerTest >> testUpdateCloseProtocol [
 	class compile: 'method' classified: 'instance-creation'.
 

src/Chanel/ChanelDuplicatedMethodFromTraitCleaner.class.st

@@ -17,10 +17,9 @@ ChanelDuplicatedMethodFromTraitCleaner class >> priority [
 
 { #category : #cleaning }
 ChanelDuplicatedMethodFromTraitCleaner >> clean [
-	self configuration definedClasses
-		select: [ :class | class isTrait not and: [ class hasTraitComposition ] ]
-		thenDo: [ :class | 
-			class localMethods
-				do:
-					[ :method | (class traitComposition compiledMethodAt: method selector ifAbsent: [ nil ]) ifNotNil: [ :m | m ast = method ast ifTrue: [ method removeFromSystem ] ] ] ]
+	self configuration definedClasses iterator
+		| #isTrait rejectIt
+		| #hasTraitComposition selectIt
+		| #removeDuplicatedMethodsFromTrait doIt
+		> Execute
 ]

src/Chanel/ChanelEnsureSuperIsCalledCleaner.class.st

@@ -31,50 +31,47 @@ ChanelEnsureSuperIsCalledCleaner >> clean [
 
 { #category : #cleaning }
 ChanelEnsureSuperIsCalledCleaner >> ensureSuperInitializeForMethods: methods [
-	methods
-		select: [ :method | 
-			method methodClass isInstanceSide
-				and: [ method selector = #initialize
-						and: [ method sendNodes
-								ifNotEmpty: [ :nodes | nodes noneSatisfy: [ :node | node isSuperSendTo: #initialize ] ]
-								ifEmpty: [ false ] ] ] ]
-		thenDo: [ :method | 
+	methods iterator
+		| #isInstanceSide selectIt
+		| [ :method | method selector = #initialize ] selectIt
+		| #hasMessages selectIt
+		| [ :method | method sendNodes noneSatisfy: [ :node | node isSuperSendTo: #initialize ] ] selectIt
+		| [ :method | 
 			| ast |
 			ast := method ast.
 			ast body addNodeFirst: (RBMessageNode superSendTo: #initialize).
-			ast install ]
+			ast install ] doIt
+		> Execute
 ]
 
 { #category : #cleaning }
 ChanelEnsureSuperIsCalledCleaner >> ensureSuperSetUpForMethods: methods [
-	methods
-		select: [ :method | 
-			method methodClass isTestCase
-				and: [ method selector = #setUp
-						and: [ method sendNodes
-								ifNotEmpty: [ :nodes | (nodes first isSuperSendTo: #setUp) not ]
-								ifEmpty: [ false ] ] ] ]
-		thenDo: [ :method | 
+	methods iterator
+		| [ :method | method methodClass isTestCase ] selectIt
+		| [ :method | method selector = #setUp ] selectIt
+		| #hasMessages selectIt
+		| [ :method | method sendNodes first isSuperSendTo: #setUp ] rejectIt
+		| [ :method | 
 			| ast |
 			ast := method ast.
 			ast sendNodes select: [ :each | each isSuperSendTo: #setUp ] thenDo: #removeFromTree.
 			ast body addNodeFirst: (RBMessageNode superSendTo: #setUp).
-			ast install ]
+			ast install ] doIt
+		> Execute
 ]
 
 { #category : #cleaning }
 ChanelEnsureSuperIsCalledCleaner >> ensureSuperTearDownForMethods: methods [
-	methods
-		select: [ :method | 
-			method methodClass isTestCase
-				and: [ method selector = #tearDown
-						and: [ method sendNodes
-								ifNotEmpty: [ :nodes | (nodes last isSuperSendTo: #tearDown) not ]
-								ifEmpty: [ false ] ] ] ]
-		thenDo: [ :method | 
+	methods iterator
+		| [ :method | method methodClass isTestCase ] selectIt
+		| [ :method | method selector = #tearDown ] selectIt
+		| #hasMessages selectIt
+		| [ :method | method sendNodes last isSuperSendTo: #tearDown ] rejectIt
+		| [ :method | 
 			| ast |
 			ast := method ast.
 			ast sendNodes select: [ :each | each isSuperSendTo: #tearDown ] thenDo: #removeFromTree.
 			ast body addNodeLast: (RBMessageNode superSendTo: #tearDown).
-			ast install ]
+			ast install ] doIt
+		> Execute
 ]

src/Chanel/ChanelMethodsOnlyCallingSuperCleaner.class.st

@@ -19,7 +19,9 @@ ChanelMethodsOnlyCallingSuperCleaner class >> priority [
 ChanelMethodsOnlyCallingSuperCleaner >> clean [
 	| matcher |
 	matcher := RBParseTreeSearcher justSendsSuper.
-	self configuration localMethods
-		select: [ :method | method pragmas isEmpty and: [ matcher executeMethod: method ast initialAnswer: false ] ]
-		thenDo: #removeFromSystem
+	self configuration localMethods iterator
+		| #hasPragma rejectIt
+		| [ :method | matcher executeMethod: method ast initialAnswer: false ] selectIt
+		| #removeFromSystem doIt
+		> Execute
 ]

src/Chanel/ChanelNilAssignationInInitializeCleaner.class.st

@@ -18,13 +18,10 @@ ChanelNilAssignationInInitializeCleaner class >> priority [
 
 { #category : #cleaning }
 ChanelNilAssignationInInitializeCleaner >> clean [
-	self configuration localMethods
-		select: [ :method | method selector = #initialize ]
-		thenDo: [ :method | 
-			| ast |
-			ast := method ast.
-			(ast assignmentNodes select: [ :assignment | assignment value value isNil ])
-				ifNotEmpty: [ :nilAssignmentNode | 
-					nilAssignmentNode do: #removeFromTree.
-					ast install ] ]
+	self configuration localMethods iterator
+		| [ :method | method selector = #initialize ] selectIt
+		| [ :method | method ast nilAssignmentNodes isNotEmpty ] selectIt
+		| [ :method | method ast nilAssignmentNodes do: #removeFromTree ] doIt
+		| [ :method | method ast install ] doIt
+		> Execute
 ]

src/Chanel/ChanelProtocolsCleaner.class.st

@@ -99,9 +99,11 @@ ChanelProtocolsCleaner >> cleanCloseProtocolsOf: methods [
 
 { #category : #cleaning }
 ChanelProtocolsCleaner >> ensureTestMethodsAreInRightProtocol: methods [
-	methods
-		select: [ :method | method isTestMethod and: [ (method protocol beginsWith: 'test') not ] ]
-		thenDo: [ :method | method ensureProtocol: #tests ]
+	methods iterator
+		| #isTestMethod selectIt
+		| [ :method | method protocol beginsWith: 'test' ] rejectIt
+		| [ :method | method ensureProtocol: #tests ] doIt
+		> Execute
 ]
 
 { #category : #accessing }

src/Chanel/ClassDescription.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : #ClassDescription }
+
+{ #category : #'*Chanel' }
+ClassDescription >> removeDuplicatedMethodsFromTrait [
+	self localMethods
+		do: [ :method | self traitComposition compiledMethodAt: method selector ifPresent: [ :m | m ast = method ast ifTrue: [ method removeFromSystem ] ] ]
+]

src/Chanel/CompiledMethod.extension.st

@@ -6,3 +6,18 @@ CompiledMethod >> ensureProtocol: aSymbol [
 
 	self protocol: aSymbol
 ]
+
+{ #category : #'*Chanel' }
+CompiledMethod >> hasMessages [
+	^ self ast hasMessages
+]
+
+{ #category : #'*Chanel' }
+CompiledMethod >> hasPragma [
+	^ self pragmas isNotEmpty
+]
+
+{ #category : #'*Chanel' }
+CompiledMethod >> isInstanceSide [
+	^ self methodClass isInstanceSide
+]

src/Chanel/Execute.class.st

@@ -0,0 +1,8 @@
+"
+Just syntaxic suggar for Iterator.
+"
+Class {
+	#name : #Execute,
+	#superclass : #NullAddableObject,
+	#category : #Chanel
+}

src/Chanel/RBProgramNode.extension.st

@@ -1,6 +1,16 @@
 Extension { #name : #RBProgramNode }
 
+{ #category : #'*Chanel' }
+RBProgramNode >> hasMessages [
+	^ self sendNodes isNotEmpty
+]
+
 { #category : #'*Chanel' }
 RBProgramNode >> isTempNamed: aSymbol [
 	^ false
 ]
+
+{ #category : #'*Chanel' }
+RBProgramNode >> nilAssignmentNodes [
+	^ self assignmentNodes select: [ :assignment | assignment value value isNil ]
+]

src/Chanel/TaAbstractComposition.extension.st

@@ -0,0 +1,6 @@
+Extension { #name : #TaAbstractComposition }
+
+{ #category : #'*Chanel' }
+TaAbstractComposition >> compiledMethodAt: aSelector ifPresent: aValuable [
+	^ aValuable value: (self compiledMethodAt: aSelector ifAbsent: [ ^ self ])
+]