Merge pull request #909 from hernanmd/p13-new-finder-integration

New Finder integration

src/NewTools-Finder/Boolean.extension.st

@@ -0,0 +1,6 @@
+Extension { #name : 'Boolean' }
+
+{ #category : '*NewTools-Finder' }
+Boolean class >> approvedSelectorsForMethodFinder [
+	^ self selectors
+]

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 ]
+]

src/NewTools-Finder/ClassDescription.extension.st

@@ -0,0 +1,33 @@
+Extension { #name : 'ClassDescription' }
+
+{ #category : '*NewTools-Finder' }
+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 >> 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 >> 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."
+
+	^ #()
+]

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 )
+]

src/NewTools-Finder/Color.extension.st

@@ -0,0 +1,6 @@
+Extension { #name : 'Color' }
+
+{ #category : '*NewTools-Finder' }
+Color class >> approvedSelectorsForMethodFinder [
+	^ self selectors
+]

src/NewTools-Finder/Integer.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : 'Integer' }
+
+{ #category : '*NewTools-Finder' }
+Integer class >> forbiddenSelectorsForMethodFinder [
+
+	^ #(#benchFib #tinyBenchmarks)
+]

src/NewTools-Finder/Magnitude.extension.st

@@ -0,0 +1,6 @@
+Extension { #name : 'Magnitude' }
+
+{ #category : '*NewTools-Finder' }
+Magnitude class >> approvedSelectorsForMethodFinder [
+	^ self selectors
+]

src/NewTools-Finder/Margin.extension.st

@@ -0,0 +1,6 @@
+Extension { #name : 'Margin' }
+
+{ #category : '*NewTools-Finder' }
+Margin class >> approvedSelectorsForMethodFinder [
+	^ self selectors
+]

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
+	   )
+]

src/NewTools-Finder/Point.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : 'Point' }
+
+{ #category : '*NewTools-Finder' }
+Point class >> approvedSelectorsForMethodFinder [
+
+	^ self selectors
+]

src/NewTools-Finder/ProtoObject.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : 'ProtoObject' }
+
+{ #category : '*NewTools-Finder' }
+ProtoObject >> allSelectorsToTestInMethodFinder [
+
+	^ #()
+]

src/NewTools-Finder/Rectangle.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : 'Rectangle' }
+
+{ #category : '*NewTools-Finder' }
+Rectangle class >> approvedSelectorsForMethodFinder [
+
+	^ self selectors
+]

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
+]

src/NewTools-Finder/StMethodFinderSend.class.st

@@ -7,12 +7,25 @@ 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'
 }
 
+{ #category : 'accessing' }
+StMethodFinderSend class >> receiver: r selector: s1 withArguments: args [
+
+	^ self new
+		receiver: r;
+		selector: s1;
+		arguments: args;
+		yourself
+]
+
 { #category : 'comparing' }
 StMethodFinderSend >> = aStMethodFinderSend [
 
@@ -55,6 +68,12 @@ StMethodFinderSend >> displayIcon [
 	^ self iconNamed: #page
 ]
 
+{ #category : 'accessing' }
+StMethodFinderSend >> evaluate [
+
+	^ receiver perform: selector withArguments: arguments
+]
+
 { #category : 'accessing' }
 StMethodFinderSend >> evaluateWithTimeOut: anInteger [ 
 
@@ -182,12 +201,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 [
 

src/NewTools-Finder/Symbol.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : 'Symbol' }
+
+{ #category : '*NewTools-Finder' }
+Symbol class >> forbiddenSelectorsForMethodFinder [
+
+	^ super forbiddenSelectorsForMethodFinder , #( string: #privateAt:put: )
+]

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' }