From 9f43347ff92e4596841be01ec568f5e36b8cf50c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phaneDucasse?= Date: Wed, 9 Nov 2022 17:04:43 +0100 Subject: [PATCH 1/2] fix #11877 --- .../SycReplaceMessageCommand.extension.st | 11 +++ .../RBConjunctiveCondition.class.st | 26 +++++- ...ReplaceMessageSendTransformation.class.st} | 93 ++++++++++--------- .../RBConditionTest.class.st | 81 ++++++++++++++++ ...laceSendersMethodParametrizedTest.class.st | 2 +- .../SycReplaceMessageCommand.class.st | 47 +++++++--- 6 files changed, 199 insertions(+), 61 deletions(-) rename src/Refactoring-Core/{RBReplaceMethodRefactoring.class.st => RBReplaceMessageSendTransformation.class.st} (51%) diff --git a/src/Calypso-SystemTools-Core/SycReplaceMessageCommand.extension.st b/src/Calypso-SystemTools-Core/SycReplaceMessageCommand.extension.st index 54301692e59..c8df6edfdc8 100644 --- a/src/Calypso-SystemTools-Core/SycReplaceMessageCommand.extension.st +++ b/src/Calypso-SystemTools-Core/SycReplaceMessageCommand.extension.st @@ -1,5 +1,16 @@ Extension { #name : #SycReplaceMessageCommand } +{ #category : #'*Calypso-SystemTools-Core' } +SycReplaceMessageCommand class >> canBeExecutedInContext: aToolContext [ + + self flag: #Enh. + "The following commented piece controls the fact that the replace can be invoked from without the code pane. + Now the asRefactoring method should have access to the class from such context and we did not find how. + For now we removed the menu item from the list. Less working is better than more not working" + ^ "aToolContext isMessageSelected |" + aToolContext isMethodSelected +] + { #category : #'*Calypso-SystemTools-Core' } SycReplaceMessageCommand class >> methodContextMenuActivation [ diff --git a/src/Refactoring-Core/RBConjunctiveCondition.class.st b/src/Refactoring-Core/RBConjunctiveCondition.class.st index 61f752ce3ea..9d9b18d17b8 100644 --- a/src/Refactoring-Core/RBConjunctiveCondition.class.st +++ b/src/Refactoring-Core/RBConjunctiveCondition.class.st @@ -3,7 +3,23 @@ I am a refactoring condition combining two other conditions by a boolean AND. I am created by sending the binary message #& to another condition (left) with another condition (right) as its argument. -Checking this conditions holds true, if my left and my right condition is true. +Checking this condition holds true, if my left and my right condition is true. +Note that the first failing condition stops the condition evaluation. See testCheckFailEarlyAndDoesNotCoverEveryConditions + +### Implementation + +The following method is key as it shows that as soon as a check fails the second one is not checked. +``` +check + + left check ifFalse: [ + failed := #leftFailed. + ^ false ]. + right check ifFalse: [ + failed := #rightFailed. + ^ false ]. + ^ true +``` " Class { #name : #RBConjunctiveCondition, @@ -44,10 +60,10 @@ RBConjunctiveCondition >> errorMacro [ ] { #category : #private } -RBConjunctiveCondition >> errorStringFor: aBoolean [ - ^aBoolean - ifTrue: [self neitherFailed] - ifFalse: [self perform: failed] +RBConjunctiveCondition >> errorStringFor: aBoolean [ + ^ aBoolean + ifTrue: [ self neitherFailed ] + ifFalse: [ self perform: failed ] ] { #category : #initialization } diff --git a/src/Refactoring-Core/RBReplaceMethodRefactoring.class.st b/src/Refactoring-Core/RBReplaceMessageSendTransformation.class.st similarity index 51% rename from src/Refactoring-Core/RBReplaceMethodRefactoring.class.st rename to src/Refactoring-Core/RBReplaceMessageSendTransformation.class.st index 33b0ce143d5..5ca71c4d88f 100644 --- a/src/Refactoring-Core/RBReplaceMethodRefactoring.class.st +++ b/src/Refactoring-Core/RBReplaceMessageSendTransformation.class.st @@ -1,15 +1,16 @@ " -I'm a refactoring operation for replace one method call by another one. +I'm a transformation replaces one message send by another one. +As such I cannot garantee anything about behavior preservation. -The new method's name can have a different number of arguments than the original method, if it has more arguments a list of initializers will be needed for them. +The new method's name can have a different number of arguments than the original method, +if it has more arguments a list of initializers will be needed for them. All senders of this method are changed by the other. -Example -------- -Script: +### Example + ``` -(RBReplaceMethodRefactoring +(RBReplaceMessageSendTransformation model: model replaceMethod: #anInstVar: in: RBBasicLintRuleTestData @@ -19,7 +20,7 @@ Script: ``` " Class { - #name : #RBReplaceMethodRefactoring, + #name : #RBReplaceMessageSendTransformation, #superclass : #RBChangeMethodNameRefactoring, #instVars : [ 'replaceInAllClasses', @@ -28,8 +29,14 @@ Class { #category : #'Refactoring-Core-Refactorings' } +{ #category : #accessing } +RBReplaceMessageSendTransformation class >> kind [ + + ^ 'Transformation' +] + { #category : #'instance creation' } -RBReplaceMethodRefactoring class >> model: aRBSmalltalk replaceMethod: aSelector in: aClass to: newSelector permutation: aMap [ +RBReplaceMessageSendTransformation class >> model: aRBSmalltalk replaceMethod: aSelector in: aClass to: newSelector permutation: aMap [ ^ self new model: aRBSmalltalk; replaceCallMethod: aSelector @@ -40,7 +47,7 @@ RBReplaceMethodRefactoring class >> model: aRBSmalltalk replaceMethod: aSelector ] { #category : #'instance creation' } -RBReplaceMethodRefactoring class >> model: aRBSmalltalk replaceMethod: aSelector in: aClass to: newSelector permutation: aMap inAllClasses: aBoolean [ +RBReplaceMessageSendTransformation class >> model: aRBSmalltalk replaceMethod: aSelector in: aClass to: newSelector permutation: aMap inAllClasses: aBoolean [ ^ self new model: aRBSmalltalk; replaceCallMethod: aSelector @@ -52,7 +59,7 @@ RBReplaceMethodRefactoring class >> model: aRBSmalltalk replaceMethod: aSelector ] { #category : #'instance creation' } -RBReplaceMethodRefactoring class >> replaceCallMethod: aSelector in: aClass to: newSelector permutation: aMap [ +RBReplaceMessageSendTransformation class >> replaceCallMethod: aSelector in: aClass to: newSelector permutation: aMap [ ^self new replaceCallMethod: aSelector in: aClass @@ -61,7 +68,7 @@ RBReplaceMethodRefactoring class >> replaceCallMethod: aSelector in: aClass to: ] { #category : #'instance creation' } -RBReplaceMethodRefactoring class >> replaceCallMethod: aSelector in: aClass to: newSelector permutation: aMap inAllClasses: aBoolean [ +RBReplaceMessageSendTransformation class >> replaceCallMethod: aSelector in: aClass to: newSelector permutation: aMap inAllClasses: aBoolean [ ^self new replaceCallMethod: aSelector in: aClass @@ -71,19 +78,20 @@ RBReplaceMethodRefactoring class >> replaceCallMethod: aSelector in: aClass to: ] { #category : #accessing } -RBReplaceMethodRefactoring >> initializers [ +RBReplaceMessageSendTransformation >> initializers [ ^ initializers ifNil: [ initializers := { } ] ] { #category : #accessing } -RBReplaceMethodRefactoring >> initializers: anObject [ +RBReplaceMessageSendTransformation >> initializers: anObject [ initializers := anObject ] { #category : #private } -RBReplaceMethodRefactoring >> newSelectorString [ +RBReplaceMessageSendTransformation >> newSelectorString [ + | stream keywords | stream := WriteStream on: String new. permutation ifEmpty: [ stream nextPutAll: newSelector ]. @@ -107,40 +115,39 @@ RBReplaceMethodRefactoring >> newSelectorString [ ] { #category : #transforming } -RBReplaceMethodRefactoring >> parseTreeRewriter [ +RBReplaceMessageSendTransformation >> parseTreeRewriter [ + | rewriteRule oldString newString | rewriteRule := self parseTreeRewriterClass new. oldString := self buildSelectorString: oldSelector. newString := self newSelectorString. - rewriteRule replace: '``@object ' , oldString + rewriteRule + replace: '``@object ' , oldString with: '``@object ' , newString. - ^rewriteRule + ^ rewriteRule ] { #category : #preconditions } -RBReplaceMethodRefactoring >> preconditions [ - |conditions| - - conditions := (RBCondition withBlock: [ oldSelector numArgs < newSelector numArgs ifTrue: [ - (oldSelector numArgs + self initializers size) = newSelector numArgs - ifFalse: [ self refactoringFailure: 'You don''t have the necessary initializers to replace senders.' ] ]. true ]) - &(RBCondition definesSelector: oldSelector in: class ) - & (RBCondition definesSelector: newSelector in: class ). - - ^ conditions & (RBCondition withBlock: - [ |senders| - senders := self replaceInAllClasses - ifTrue: [ self model allReferencesTo: oldSelector ] - ifFalse: [ self model allReferencesTo: oldSelector in: {class} ]. - senders size > 1 - ifTrue: - [self refactoringWarning: ('This will modify all <1p> senders.Proceed anyway?' - expandMacrosWith: senders size)]. - true]) +RBReplaceMessageSendTransformation >> preconditions [ + + | conditions | + conditions := (RBCondition withBlock: [ + oldSelector numArgs < newSelector numArgs ifTrue: [ + oldSelector numArgs + self initializers size + = newSelector numArgs ifFalse: [ + self refactoringFailure: + 'You don''t have the necessary initializers to replace senders.' ] ]. + true ]) + & (RBCondition definesSelector: oldSelector in: class) + & (RBCondition definesSelector: newSelector in: class). + "This is unclear that the targeting method should already be defined." + + ^ conditions ] { #category : #initialization } -RBReplaceMethodRefactoring >> replaceCallMethod: aSelector in: aClass to: newSel permutation: aMap [ +RBReplaceMessageSendTransformation >> replaceCallMethod: aSelector in: aClass to: newSel permutation: aMap [ + oldSelector := aSelector asSymbol. newSelector := newSel asSymbol. class := self classObjectFor: aClass. @@ -148,21 +155,19 @@ RBReplaceMethodRefactoring >> replaceCallMethod: aSelector in: aClass to: newSel ] { #category : #initialization } -RBReplaceMethodRefactoring >> replaceCallMethod: aSelector in: aClass to: newSel permutation: aMap inAllClasses: aBoolean [ - oldSelector := aSelector asSymbol. - newSelector := newSel asSymbol. - class := self classObjectFor: aClass. - permutation := aMap. +RBReplaceMessageSendTransformation >> replaceCallMethod: aSelector in: aClass to: newSel permutation: aMap inAllClasses: aBoolean [ + + self replaceCallMethod: aSelector in: aClass to: newSel permutation: aMap. replaceInAllClasses := aBoolean. ] { #category : #accessing } -RBReplaceMethodRefactoring >> replaceInAllClasses [ +RBReplaceMessageSendTransformation >> replaceInAllClasses [ ^ replaceInAllClasses ifNil: [ replaceInAllClasses := false ] ] { #category : #transforming } -RBReplaceMethodRefactoring >> transform [ +RBReplaceMessageSendTransformation >> transform [ self replaceInAllClasses ifTrue: [ self renameMessageSends ] ifFalse: [ self renameMessageSendsIn: {class} ] diff --git a/src/Refactoring-Tests-Core/RBConditionTest.class.st b/src/Refactoring-Tests-Core/RBConditionTest.class.st index 459001cd287..7711a4dc1c1 100644 --- a/src/Refactoring-Tests-Core/RBConditionTest.class.st +++ b/src/Refactoring-Tests-Core/RBConditionTest.class.st @@ -4,6 +4,23 @@ Class { #category : #'Refactoring-Tests-Core-Base' } +{ #category : #tests } +RBConditionTest >> testCheckFailEarlyAndDoesNotCoverEveryConditions [ + + | falseCase trueCase composition | + falseCase := RBCondition + withBlock: [ false ] + errorString: 'The false case'. + trueCase := RBCondition + withBlock: [ false ] + errorString: 'The second false case'. + composition := falseCase & trueCase. + self deny: composition check. + self + assert: composition errorString + equals: 'The false case' +] + { #category : #tests } RBConditionTest >> testCheckInvalidMethodName [ "Usually used to validate input." @@ -23,6 +40,70 @@ RBConditionTest >> testCheckInvalidMethodName [ self deny: (RBCondition checkMethodName: 'foo:agr') ] +{ #category : #tests } +RBConditionTest >> testCheckThatAndIsWorking [ + + | falseCase trueCase composition | + falseCase := RBCondition + withBlock: [ false ] + errorString: 'The false case'. + trueCase := RBCondition + withBlock: [ true ] + errorString: 'The true case'. + composition := falseCase & trueCase. + self deny: composition check +] + +{ #category : #tests } +RBConditionTest >> testCheckThatOnlyFailingConditionErrorIsReported [ + + | falseCase trueCase composition | + falseCase := RBCondition + withBlock: [ false ] + errorString: 'The false case'. + trueCase := RBCondition + withBlock: [ true ] + errorString: 'The true case'. + composition := falseCase & trueCase. + self deny: composition check. + self assert: composition errorString equals: 'The false case'. +] + +{ #category : #tests } +RBConditionTest >> testCheckThatOnlyFailingConditionErrorIsReported2 [ + + | falseCase trueCase composition | + falseCase := RBCondition + withBlock: [ false ] + errorString: 'The false case'. + trueCase := RBCondition + withBlock: [ false ] + errorString: 'The second false case'. + composition := falseCase & trueCase. + self deny: composition check. + self halt. + self + assert: composition errorString + equals: 'The false case AND The second false case' +] + +{ #category : #tests } +RBConditionTest >> testCheckThatOnlyFailingConditionErrorIsReportedTrueCaseFirst [ + + | falseCase trueCase composition | + trueCase := RBCondition + withBlock: [ true ] + errorString: 'The true case'. + falseCase := RBCondition + withBlock: [ false ] + errorString: 'The false case'. + composition := trueCase & falseCase. + self deny: composition check. + self + assert: composition errorString + equals: 'The false case' +] + { #category : #tests } RBConditionTest >> testCheckValidMethodName [ "Usually used to validate input." diff --git a/src/Refactoring2-Transformations-Tests/RBReplaceSendersMethodParametrizedTest.class.st b/src/Refactoring2-Transformations-Tests/RBReplaceSendersMethodParametrizedTest.class.st index cb21c6c7a2d..802759af9fc 100644 --- a/src/Refactoring2-Transformations-Tests/RBReplaceSendersMethodParametrizedTest.class.st +++ b/src/Refactoring2-Transformations-Tests/RBReplaceSendersMethodParametrizedTest.class.st @@ -7,7 +7,7 @@ Class { { #category : #tests } RBReplaceSendersMethodParametrizedTest class >> testParameters [ ^ ParametrizedTestMatrix new - addCase: { #rbClass -> RBReplaceMethodRefactoring }; + addCase: { #rbClass -> RBReplaceMessageSendTransformation }; yourself ] diff --git a/src/SystemCommands-MessageCommands/SycReplaceMessageCommand.class.st b/src/SystemCommands-MessageCommands/SycReplaceMessageCommand.class.st index 90f1ce378c0..b16366bd758 100644 --- a/src/SystemCommands-MessageCommands/SycReplaceMessageCommand.class.st +++ b/src/SystemCommands-MessageCommands/SycReplaceMessageCommand.class.st @@ -5,7 +5,8 @@ Class { #name : #SycReplaceMessageCommand, #superclass : #SycChangeMessageSignatureCommand, #instVars : [ - 'newSelector' + 'newSelector', + 'selectedClass' ], #category : #'SystemCommands-MessageCommands' } @@ -13,14 +14,26 @@ Class { { #category : #execution } SycReplaceMessageCommand >> createRefactoring [ self flag: 'TODO'."Improve preview to add args when change the sender with empty args" - ^ (RBReplaceMethodRefactoring + + ^ newSelector newArgs + ifNotEmpty:[ + (RBReplaceMessageSendTransformation model: model replaceMethod: originalMessage selector - in: originalMessage contextUser origin + in: selectedClass to: newSelector selector permutation: newSelector permutation inAllClasses: self replaceInAllClasses) - initializers: newSelector newArgs values + initializers: newSelector newArgs values ] + ifEmpty:[ + (RBReplaceMessageSendTransformation + model: model + replaceMethod: originalMessage selector + in: selectedClass + to: newSelector selector + permutation: newSelector permutation + inAllClasses: self replaceInAllClasses) + initializers: newSelector newArgs ] ] { #category : #accessing } @@ -30,21 +43,33 @@ SycReplaceMessageCommand >> defaultMenuIconName [ { #category : #accessing } SycReplaceMessageCommand >> defaultMenuItemName [ - ^ 'Replace senders' + "Make sure that the user knows that this is a transformation by adding (T) in front of the menu item name." + + ^ '(T) Replace senders' ] { #category : #execution } SycReplaceMessageCommand >> prepareFullExecutionInContext: aToolContext [ - + | methodName dialog | super prepareFullExecutionInContext: aToolContext. + + "This is for the code editor + selectedClass := aToolContext selectedMethod methodClass. - methodName := RBMethodName selector: originalMessage selector arguments: originalMessage argumentNames copy. + The following expression selectedClass := originalMessage methodClass. is for the method list. The context is pain bad because it cannot handle both. We kept the method list. + Check class side canBeExecutedInContext: if you know how to fix it" + + selectedClass := originalMessage methodClass. + methodName := RBMethodName + selector: originalMessage selector + arguments: originalMessage argumentNames copy. dialog := SycMethodNameEditorPresenter openOn: methodName. - dialog cancelled ifTrue: [ CmdCommandAborted signal ]. - - originalMessage selector = methodName selector ifTrue: [ CmdCommandAborted signal]. - newSelector := methodName. + dialog cancelled ifTrue: [ CmdCommandAborted signal ]. + + originalMessage selector = methodName selector ifTrue: [ + CmdCommandAborted signal ]. + newSelector := methodName ] { #category : #execution } From c8529cc27257b15160d27f7f0777364f73e6121e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?St=C3=A9phaneDucasse?= Date: Wed, 9 Nov 2022 18:17:43 +0100 Subject: [PATCH 2/2] Removing halt in broken test --- .../RBConditionTest.class.st | 18 ------------------ 1 file changed, 18 deletions(-) diff --git a/src/Refactoring-Tests-Core/RBConditionTest.class.st b/src/Refactoring-Tests-Core/RBConditionTest.class.st index 7711a4dc1c1..f0675197d63 100644 --- a/src/Refactoring-Tests-Core/RBConditionTest.class.st +++ b/src/Refactoring-Tests-Core/RBConditionTest.class.st @@ -69,24 +69,6 @@ RBConditionTest >> testCheckThatOnlyFailingConditionErrorIsReported [ self assert: composition errorString equals: 'The false case'. ] -{ #category : #tests } -RBConditionTest >> testCheckThatOnlyFailingConditionErrorIsReported2 [ - - | falseCase trueCase composition | - falseCase := RBCondition - withBlock: [ false ] - errorString: 'The false case'. - trueCase := RBCondition - withBlock: [ false ] - errorString: 'The second false case'. - composition := falseCase & trueCase. - self deny: composition check. - self halt. - self - assert: composition errorString - equals: 'The false case AND The second false case' -] - { #category : #tests } RBConditionTest >> testCheckThatOnlyFailingConditionErrorIsReportedTrueCaseFirst [