From 9987bbb5e18ee8960e5f537968fbfe97fd15bfb8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hern=C3=A1n=20Morales=20Durand?= Date: Wed, 20 Nov 2024 21:21:57 +0100 Subject: [PATCH 1/5] Link Spoter with New Finder --- src/NewTools-Spotter/StSpotter.class.st | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/NewTools-Spotter/StSpotter.class.st b/src/NewTools-Spotter/StSpotter.class.st index 902254f3..e4872fb5 100644 --- a/src/NewTools-Spotter/StSpotter.class.st +++ b/src/NewTools-Spotter/StSpotter.class.st @@ -675,8 +675,7 @@ StSpotter >> nextSelectablePresenter: selectedPresenter oldPresenters: oldPresen StSpotter >> openFinder [ self window close. - self flag: #TODO. "Move finder to spec (right now is a morph)" - FinderUI open + StFinderPresenter open. ] { #category : 'private' } From 53be39567ae9f328491f5f28786b2070acf20754 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hern=C3=A1n=20Morales=20Durand?= Date: Thu, 21 Nov 2024 11:16:23 +0100 Subject: [PATCH 2/5] Fix missing method finder references --- src/NewTools-Finder/StMethodFinder.class.st | 22 ++++++++- .../StMethodFinderSend.class.st | 48 ++++++++++++++++++- 2 files changed, 68 insertions(+), 2 deletions(-) diff --git a/src/NewTools-Finder/StMethodFinder.class.st b/src/NewTools-Finder/StMethodFinder.class.st index bb7842bc..809d387c 100644 --- a/src/NewTools-Finder/StMethodFinder.class.st +++ b/src/NewTools-Finder/StMethodFinder.class.st @@ -7,7 +7,7 @@ Extends `MethodFinder` to add support for search examples with: " Class { #name : 'StMethodFinder', - #superclass : 'MethodFinder', + #superclass : 'Object', #category : 'NewTools-Finder-Search', #package : 'NewTools-Finder', #tag : 'Search' @@ -35,3 +35,23 @@ StMethodFinder >> methodFinderSendClass [ ^ StMethodFinderSend ] + +{ #category : 'public access' } +StMethodFinder >> possibleSolutionsForInput: inputCollection [ + + | sends | + + sends := OrderedCollection new. + inputCollection permutationsDo: [ :permutation | + | foundPermutationSends args receiver | + args := permutation allButFirst. + receiver := permutation first. + foundPermutationSends := + (receiver evaluate class allSelectorsToTestInMethodFinderWithArity: inputCollection size - 1) collect: [ : method | + self methodFinderSendClass + receiver: receiver evaluate + selector: method + withArguments: (args collect: #evaluate) ]. + sends addAll: foundPermutationSends ]. + ^ sends +] diff --git a/src/NewTools-Finder/StMethodFinderSend.class.st b/src/NewTools-Finder/StMethodFinderSend.class.st index 51f8817b..cc26203e 100644 --- a/src/NewTools-Finder/StMethodFinderSend.class.st +++ b/src/NewTools-Finder/StMethodFinderSend.class.st @@ -7,7 +7,10 @@ Extends `MethodFinderSend` to support Finder UI operations for searching example " Class { #name : 'StMethodFinderSend', - #superclass : 'MethodFinderSend', + #superclass : 'Message', + #instVars : [ + 'receiver' + ], #category : 'NewTools-Finder-Search', #package : 'NewTools-Finder', #tag : 'Search' @@ -55,6 +58,12 @@ StMethodFinderSend >> displayIcon [ ^ self iconNamed: #page ] +{ #category : 'accessing' } +StMethodFinderSend >> evaluate [ + + ^ receiver perform: selector withArguments: arguments +] + { #category : 'accessing' } StMethodFinderSend >> evaluateWithTimeOut: anInteger [ @@ -182,12 +191,49 @@ StMethodFinderSend >> previewText [ ^ StFinderPresenter methodFinderExplanation ] +{ #category : 'printing' } +StMethodFinderSend >> printOn: aStream [ + + aStream print: receiver. + aStream space. + arguments ifEmpty: [^ aStream nextPutAll: selector]. + arguments + with: selector keywords + do: [:arg :word | + aStream nextPutAll: word asString. + aStream space. + aStream print: arg. + aStream space ]. + aStream skip: -1 +] + { #category : 'accessing' } StMethodFinderSend >> profile [ self shouldBeImplemented ] +{ #category : 'accessing' } +StMethodFinderSend >> receiver [ + + ^ receiver +] + +{ #category : 'accessing' } +StMethodFinderSend >> receiver: anObject [ + + receiver := anObject +] + +{ #category : 'accessing' } +StMethodFinderSend >> resultIn: expectedResult [ + + [ [ ^ expectedResult = self evaluate ] + onErrorDo: [ :anError | ^ false ] ] + on: Deprecation + do: [ :depr | ^ false ] +] + { #category : 'accessing' } StMethodFinderSend >> resultIn: expectedResult timeout: anInteger [ From 05118c87c71c1c4d9ff97c85f7693b16557e5aa3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hern=C3=A1n=20Morales=20Durand?= Date: Thu, 21 Nov 2024 11:55:12 +0100 Subject: [PATCH 3/5] Add approved selectors methods --- src/NewTools-Finder/Boolean.extension.st | 6 +++ src/NewTools-Finder/ByteString.extension.st | 8 ++++ .../ClassDescription.extension.st | 40 +++++++++++++++++++ src/NewTools-Finder/Collection.extension.st | 12 ++++++ src/NewTools-Finder/Color.extension.st | 6 +++ src/NewTools-Finder/Integer.extension.st | 7 ++++ src/NewTools-Finder/Magnitude.extension.st | 6 +++ src/NewTools-Finder/Margin.extension.st | 6 +++ src/NewTools-Finder/Object.extension.st | 10 +++++ src/NewTools-Finder/Point.extension.st | 7 ++++ src/NewTools-Finder/ProtoObject.extension.st | 7 ++++ src/NewTools-Finder/Rectangle.extension.st | 7 ++++ .../StMethodFinderSend.class.st | 10 +++++ src/NewTools-Finder/Symbol.extension.st | 7 ++++ 14 files changed, 139 insertions(+) create mode 100644 src/NewTools-Finder/Boolean.extension.st create mode 100644 src/NewTools-Finder/ByteString.extension.st create mode 100644 src/NewTools-Finder/ClassDescription.extension.st create mode 100644 src/NewTools-Finder/Collection.extension.st create mode 100644 src/NewTools-Finder/Color.extension.st create mode 100644 src/NewTools-Finder/Integer.extension.st create mode 100644 src/NewTools-Finder/Magnitude.extension.st create mode 100644 src/NewTools-Finder/Margin.extension.st create mode 100644 src/NewTools-Finder/Object.extension.st create mode 100644 src/NewTools-Finder/Point.extension.st create mode 100644 src/NewTools-Finder/ProtoObject.extension.st create mode 100644 src/NewTools-Finder/Rectangle.extension.st create mode 100644 src/NewTools-Finder/Symbol.extension.st diff --git a/src/NewTools-Finder/Boolean.extension.st b/src/NewTools-Finder/Boolean.extension.st new file mode 100644 index 00000000..1b103158 --- /dev/null +++ b/src/NewTools-Finder/Boolean.extension.st @@ -0,0 +1,6 @@ +Extension { #name : 'Boolean' } + +{ #category : '*NewTools-Finder' } +Boolean class >> approvedSelectorsForMethodFinder [ + ^ self selectors +] diff --git a/src/NewTools-Finder/ByteString.extension.st b/src/NewTools-Finder/ByteString.extension.st new file mode 100644 index 00000000..d39b0811 --- /dev/null +++ b/src/NewTools-Finder/ByteString.extension.st @@ -0,0 +1,8 @@ +Extension { #name : 'ByteString' } + +{ #category : '*NewTools-Finder' } +ByteString class >> allSelectorsToTestInMethodFinderWithArity: anInteger [ + "Returns all the selectors with a certain arity which are approved by the class so which can be tested in the Method Finder." + + ^ self allSelectorsToTestInMethodFinder select: [ :selector | selector numArgs = anInteger ] +] diff --git a/src/NewTools-Finder/ClassDescription.extension.st b/src/NewTools-Finder/ClassDescription.extension.st new file mode 100644 index 00000000..1494c6a9 --- /dev/null +++ b/src/NewTools-Finder/ClassDescription.extension.st @@ -0,0 +1,40 @@ +Extension { #name : 'ClassDescription' } + +{ #category : '*NewTools-Finder' } +ClassDescription class >> allSelectorsToTestInMethodFinder [ + "Returns all the selectors that the class approved, so which can be tested by the MethodFinder without problem. This set is the set of selectors that the class approved plus all the selectors approved by its superclass unless if they are forbidden by the class." + + ^ (self approvedSelectorsForMethodFinder union: self superclass allSelectorsToTestInMethodFinder) + difference: self forbiddenSelectorsForMethodFinder asSet +] + +{ #category : '*NewTools-Finder' } +ClassDescription class >> allSelectorsToTestInMethodFinderWithArity: anInteger [ + "Returns all the selectors with a certain arity which are approved by the class so which can be tested in the Method Finder." + + ^ self allSelectorsToTestInMethodFinder select: [ :selector | selector numArgs = anInteger ] +] + +{ #category : '*NewTools-Finder' } +ClassDescription >> allSelectorsToTestInMethodFinderWithArity: anInteger [ + "Returns all the selectors with a certain arity which are approved by the class so which can be tested in the Method Finder." + + ^ self allSelectorsToTestInMethodFinder select: [ :selector | selector numArgs = anInteger ] +] + +{ #category : '*NewTools-Finder' } +ClassDescription class >> approvedSelectorsForMethodFinder [ + "The list of the selectors that the class approved. It's empty by default. + An approved selector is a selector where the message send to the class could be + tested by the Method Finder without problem. For instance, it does not modify + the environment and it does not touch to a globalvariable ." + + ^ #(isNil) +] + +{ #category : '*NewTools-Finder' } +ClassDescription >> forbiddenSelectorsForMethodFinder [ + "The list of selector forbidden by the class. A forbidden selector will not be tested by the Method Finder. So, a forbiden selector could be a method which modifies the environment, a global variable, etc." + + ^ #() +] diff --git a/src/NewTools-Finder/Collection.extension.st b/src/NewTools-Finder/Collection.extension.st new file mode 100644 index 00000000..c9c17b98 --- /dev/null +++ b/src/NewTools-Finder/Collection.extension.st @@ -0,0 +1,12 @@ +Extension { #name : 'Collection' } + +{ #category : '*NewTools-Finder' } +Collection class >> approvedSelectorsForMethodFinder [ + ^ self selectors +] + +{ #category : '*NewTools-Finder' } +Collection class >> forbiddenSelectorsForMethodFinder [ + + ^ #( #combinations ) +] diff --git a/src/NewTools-Finder/Color.extension.st b/src/NewTools-Finder/Color.extension.st new file mode 100644 index 00000000..0c08af5b --- /dev/null +++ b/src/NewTools-Finder/Color.extension.st @@ -0,0 +1,6 @@ +Extension { #name : 'Color' } + +{ #category : '*NewTools-Finder' } +Color class >> approvedSelectorsForMethodFinder [ + ^ self selectors +] diff --git a/src/NewTools-Finder/Integer.extension.st b/src/NewTools-Finder/Integer.extension.st new file mode 100644 index 00000000..89b73de0 --- /dev/null +++ b/src/NewTools-Finder/Integer.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'Integer' } + +{ #category : '*NewTools-Finder' } +Integer class >> forbiddenSelectorsForMethodFinder [ + + ^ #(#benchFib #tinyBenchmarks) +] diff --git a/src/NewTools-Finder/Magnitude.extension.st b/src/NewTools-Finder/Magnitude.extension.st new file mode 100644 index 00000000..c077dfc9 --- /dev/null +++ b/src/NewTools-Finder/Magnitude.extension.st @@ -0,0 +1,6 @@ +Extension { #name : 'Magnitude' } + +{ #category : '*NewTools-Finder' } +Magnitude class >> approvedSelectorsForMethodFinder [ + ^ self selectors +] diff --git a/src/NewTools-Finder/Margin.extension.st b/src/NewTools-Finder/Margin.extension.st new file mode 100644 index 00000000..4a5cb7a5 --- /dev/null +++ b/src/NewTools-Finder/Margin.extension.st @@ -0,0 +1,6 @@ +Extension { #name : 'Margin' } + +{ #category : '*NewTools-Finder' } +Margin class >> approvedSelectorsForMethodFinder [ + ^ self selectors +] diff --git a/src/NewTools-Finder/Object.extension.st b/src/NewTools-Finder/Object.extension.st new file mode 100644 index 00000000..01920b7d --- /dev/null +++ b/src/NewTools-Finder/Object.extension.st @@ -0,0 +1,10 @@ +Extension { #name : 'Object' } + +{ #category : '*NewTools-Finder' } +Object class >> approvedSelectorsForMethodFinder [ + + ^ #(at: basicAt: basicSize yourself size + -> + = == ~= hash literalEqual + ) +] diff --git a/src/NewTools-Finder/Point.extension.st b/src/NewTools-Finder/Point.extension.st new file mode 100644 index 00000000..ae8b5285 --- /dev/null +++ b/src/NewTools-Finder/Point.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'Point' } + +{ #category : '*NewTools-Finder' } +Point class >> approvedSelectorsForMethodFinder [ + + ^ self selectors +] diff --git a/src/NewTools-Finder/ProtoObject.extension.st b/src/NewTools-Finder/ProtoObject.extension.st new file mode 100644 index 00000000..483570d3 --- /dev/null +++ b/src/NewTools-Finder/ProtoObject.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'ProtoObject' } + +{ #category : '*NewTools-Finder' } +ProtoObject >> allSelectorsToTestInMethodFinder [ + + ^ #() +] diff --git a/src/NewTools-Finder/Rectangle.extension.st b/src/NewTools-Finder/Rectangle.extension.st new file mode 100644 index 00000000..a1279119 --- /dev/null +++ b/src/NewTools-Finder/Rectangle.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'Rectangle' } + +{ #category : '*NewTools-Finder' } +Rectangle class >> approvedSelectorsForMethodFinder [ + + ^ self selectors +] diff --git a/src/NewTools-Finder/StMethodFinderSend.class.st b/src/NewTools-Finder/StMethodFinderSend.class.st index cc26203e..e0b4fdd6 100644 --- a/src/NewTools-Finder/StMethodFinderSend.class.st +++ b/src/NewTools-Finder/StMethodFinderSend.class.st @@ -16,6 +16,16 @@ Class { #tag : 'Search' } +{ #category : 'as yet unclassified' } +StMethodFinderSend class >> receiver: r selector: s1 withArguments: args [ + + ^ self new + receiver: r; + selector: s1; + arguments: args; + yourself +] + { #category : 'comparing' } StMethodFinderSend >> = aStMethodFinderSend [ diff --git a/src/NewTools-Finder/Symbol.extension.st b/src/NewTools-Finder/Symbol.extension.st new file mode 100644 index 00000000..d0e5f91d --- /dev/null +++ b/src/NewTools-Finder/Symbol.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'Symbol' } + +{ #category : '*NewTools-Finder' } +Symbol class >> forbiddenSelectorsForMethodFinder [ + + ^ super forbiddenSelectorsForMethodFinder , #( string: #privateAt:put: ) +] From 6d5ee0e89ed2a74659ed75f246b27cfa36ded0fa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hern=C3=A1n=20Morales=20Durand?= Date: Thu, 21 Nov 2024 13:09:29 +0100 Subject: [PATCH 4/5] Correct wrongly migrated methods in ClassDescription --- src/NewTools-Finder/ClassDescription.extension.st | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/src/NewTools-Finder/ClassDescription.extension.st b/src/NewTools-Finder/ClassDescription.extension.st index 1494c6a9..f90d3b6e 100644 --- a/src/NewTools-Finder/ClassDescription.extension.st +++ b/src/NewTools-Finder/ClassDescription.extension.st @@ -1,20 +1,13 @@ Extension { #name : 'ClassDescription' } { #category : '*NewTools-Finder' } -ClassDescription class >> allSelectorsToTestInMethodFinder [ +ClassDescription >> allSelectorsToTestInMethodFinder [ "Returns all the selectors that the class approved, so which can be tested by the MethodFinder without problem. This set is the set of selectors that the class approved plus all the selectors approved by its superclass unless if they are forbidden by the class." ^ (self approvedSelectorsForMethodFinder union: self superclass allSelectorsToTestInMethodFinder) difference: self forbiddenSelectorsForMethodFinder asSet ] -{ #category : '*NewTools-Finder' } -ClassDescription class >> allSelectorsToTestInMethodFinderWithArity: anInteger [ - "Returns all the selectors with a certain arity which are approved by the class so which can be tested in the Method Finder." - - ^ self allSelectorsToTestInMethodFinder select: [ :selector | selector numArgs = anInteger ] -] - { #category : '*NewTools-Finder' } ClassDescription >> allSelectorsToTestInMethodFinderWithArity: anInteger [ "Returns all the selectors with a certain arity which are approved by the class so which can be tested in the Method Finder." @@ -23,7 +16,7 @@ ClassDescription >> allSelectorsToTestInMethodFinderWithArity: anInteger [ ] { #category : '*NewTools-Finder' } -ClassDescription class >> approvedSelectorsForMethodFinder [ +ClassDescription >> approvedSelectorsForMethodFinder [ "The list of the selectors that the class approved. It's empty by default. An approved selector is a selector where the message send to the class could be tested by the Method Finder without problem. For instance, it does not modify From d0828c62dc20d5e328306daeeb27d96c7f684d70 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hern=C3=A1n=20Morales=20Durand?= Date: Thu, 21 Nov 2024 13:31:47 +0100 Subject: [PATCH 5/5] Classify unclassified method --- src/NewTools-Finder/StMethodFinderSend.class.st | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/NewTools-Finder/StMethodFinderSend.class.st b/src/NewTools-Finder/StMethodFinderSend.class.st index e0b4fdd6..cba769e7 100644 --- a/src/NewTools-Finder/StMethodFinderSend.class.st +++ b/src/NewTools-Finder/StMethodFinderSend.class.st @@ -16,7 +16,7 @@ Class { #tag : 'Search' } -{ #category : 'as yet unclassified' } +{ #category : 'accessing' } StMethodFinderSend class >> receiver: r selector: s1 withArguments: args [ ^ self new