From cc2648f60c01ec59b37a47ab5ed171daa0fd7482 Mon Sep 17 00:00:00 2001 From: AlessHo Date: Fri, 19 Nov 2021 13:36:29 +0100 Subject: [PATCH] Pushing new tests + comments for RBParseTreeSearcher --- .../RBParseTreeSearcherTest.class.st | 358 +++++++++++++++++- src/AST-Core/RBParseTreeSearcher.class.st | 53 +++ src/AST-Core/RBPatternVariableNode.class.st | 1 + 3 files changed, 407 insertions(+), 5 deletions(-) diff --git a/src/AST-Core-Tests/RBParseTreeSearcherTest.class.st b/src/AST-Core-Tests/RBParseTreeSearcherTest.class.st index cd2ff46be93..3bdb02877f9 100644 --- a/src/AST-Core-Tests/RBParseTreeSearcherTest.class.st +++ b/src/AST-Core-Tests/RBParseTreeSearcherTest.class.st @@ -46,24 +46,370 @@ RBParseTreeSearcherTest >> testDynamicArrayWithStatementListPattern [ | dict | searcher matches: '{`.@stmts.}' do: [ :aNode :answer | dict:= searcher context ]. - dict := searcher executeTree: (self parseExpression:'{ (1@2) . Color red . 3}'). + dict := searcher executeTree: (self parseExpression:'{ (1@2) . Color red . 3 }'). + "self halt." self assert: (dict at: (RBPatternVariableNode named: '`.@stmts')) size equals: 3 ] +{ #category : #'tests - to de refined' } +RBParseTreeSearcherTest >> testSearchListComplex [ + + " + - Here we looking for multiple lists in one match pattern at the same time. + - Lists can be any receiver or args + " + + | dict | + searcher + matches: '`@receiver assert: `@arg equals: true' + do: [ :aNode :answer | dict := searcher context ]. + + " + ****** Assert ******" + + " Ex1: " + searcher executeTree: (self parseExpression: 'self + assert: each isReadOnlyObject equals: true.'). + + self + assert: + (dict at: (RBPatternVariableNode named: '`@receiver')) formattedCode + equals: 'self'. + + self + assert: + (dict at: (RBPatternVariableNode named: '`@arg')) formattedCode + equals: 'each isReadOnlyObject'. + + " Ex2: " + searcher executeTree: (self parseExpression: + 'self assert: reader storedSettings first realValue equals: true.'). + + self + assert: + (dict at: (RBPatternVariableNode named: '`@receiver')) formattedCode + equals: 'self'. + + self + assert: + (dict at: (RBPatternVariableNode named: '`@arg')) formattedCode + equals: 'reader storedSettings first realValue'. + + " ****** Deny ******" + + "so in below example, there is no match with the suggested pattern. + Which is why, dict is still filled with the Patterns of the previous example " + + searcher executeTree: + (self parseExpression: 'self assert: token isLiteralToken.'). + + self + deny: + (dict at: (RBPatternVariableNode named: '`@arg')) formattedCode + equals: 'token isLiteralToken.' +] + +{ #category : #'tests - to de refined' } +RBParseTreeSearcherTest >> testSearchListReceiver [ + + " + - A receiver list can be: a simple receiver like self, or a complex receiver like (self newRequestTo: aString) + - So here we are looking for any receiver followed by put. + " + + | dict | + searcher + matches: '`@rcv put' + do: [ :aNode :answer | dict := searcher context ]. + + " ****** Assert ******" + + "Ex 1: " + searcher executeTree: (self parseExpression: 'self put'). + + self + assert: + (dict at: (RBPatternVariableNode named: '`@rcv')) formattedCode + equals: 'self'. + + "Ex 2: " + searcher executeTree: + (self parseExpression: '(self newRequestTo: aString) put'). + + self + assert: + (dict at: (RBPatternVariableNode named: '`@rcv')) formattedCode + equals: '(self newRequestTo: aString)'. + + "Ex 3: " + searcher executeTree: (self parseExpression: 'self httpClient put'). + + self + assert: + (dict at: (RBPatternVariableNode named: '`@rcv')) formattedCode + equals: 'self httpClient'. + + " ****** Deny ******" + + " The below example is not matching bcz the message is different than put. + Which is why the dict is not filled with patterns of this this example " + searcher executeTree: (self parseExpression: '1 at'). + + self + deny: + (dict at: (RBPatternVariableNode named: '`@rcv')) formattedCode + equals: '1' +] + +{ #category : #'tests - to de refined' } +RBParseTreeSearcherTest >> testSearchListTempVars [ + + " + - here we are looking for a method that containns a list of temporary vars followed by myVar1 and then a receiver followed by message messageTofind + " + + | dict myMessages | + searcher + matches: '`sel |`@temps `temp| `rcv messageTofind' + do: [ :aNode :answer | dict := searcher context ]. + + " ****** Assert ******" + + "Ex 1: The first example is correct, matching with our pattern even if we have multiple variables" + + searcher executeTree: (self parseExpression: 'example + |aTempVar aTempVar2 aTempVar3 myTempVar| + self messageTofind.'). + self + assert: + (dict at: (RBPatternVariableNode named: '`sel')) formattedCode + equals: 'example'. + + self + assert: + (dict at: (RBPatternVariableNode named: '`@temps')) formattedCode + equals: 'aTempVar aTempVar2 aTempVar3'. + + " !!! Not sure why below assert is not working properly, while on rewriter tool, the example is matching successfully !!!" + + "self + assert: + (dict at: (RBPatternVariableNode named: '`temp')) formattedCode + equals: 'myVar'." + + self + assert: + (dict at: (RBPatternVariableNode named: '`rcv')) formattedCode + equals: 'self'. + + " ****** Deny ******" + + "The second example is incorrect, NOT matching with our pattern bcz even we have one variable defined, but it is not followed by myMandatoryVar" + + searcher executeTree: (self parseExpression: 'example2 + |aTempVar| + self messageTofind. '). + + self + deny: (dict at: (RBPatternVariableNode named: '`sel')) formattedCode + equals: 'example2' +] + +{ #category : #'tests - to de refined' } +RBParseTreeSearcherTest >> testSearchLiteral [ + + " + - so here we are looking for any literal with message size + " + + | dict | + searcher + matches: '`#lit size' + do: [ :aNode :answer | dict := searcher context ]. + + " ****** Assert ******" + "- OrderedCollection is not litteral, which is why 3 matches could be found and not 4" + + "Ex1: Litteral can be a number " + searcher executeTree: (self parseExpression: '3 size'). + + self + assert: + (dict at: (RBPatternVariableNode named: '`#lit')) formattedCode + equals: '3'. + + + "Ex1: Litteral can be a string " + searcher executeTree: (self parseExpression: ' ''foo'' size'). + + self + assert: + (dict at: (RBPatternVariableNode named: '`#lit')) formattedCode + equals: '''foo'''. + + "Ex2: Litteral can be an array. + !!! Not sure why the example is not working, while it is working on the matching window of the rewrite tool !!!" + "searcher executeTree: (self parseExpression: '#(1 2 3) size'). + + self + assert: + (dict at: (RBPatternVariableNode named: '`#lit')) formattedCode + equals: '#(1 2 3)'." + + " ****** Deny ******" + + " Ordered Collection is not a literal." + searcher executeTree: + (self parseExpression: 'OrderedCollection new size'). + + self + deny: + (dict at: (RBPatternVariableNode named: '`#lit')) formattedCode + equals: 'OrderedCollection new' +] + +{ #category : #'tests - to de refined' } +RBParseTreeSearcherTest >> testSearchRecurseInto [ + + " + - Here we are testing the recurse into, which looks inside @vars for pattern that matches @vars + 1 + " + + searcher matches: '``@vars + 1' do: [ :aNode :answer | answer + 1 ]. + + " ****** Assert ******" + " + - So here: we have 3 message nodes + - The one we are looking recursevily into is the first message node: myNum + 1 which is matching with the original pattern. + " + + " + Match 1: (myNum + 1) + 1 + Match 2: (myNum + 1) + " + + self + assert: (searcher + executeTree: (self parseExpression: '(myNum + 1) + 1 + 5') + initialAnswer: 0) + equals: 2. + + " ****** Deny ******" + + "Should be equal 3 + Match 1: (myNum + 1) + 1 + Match 2: (myNum + 1) + Match 3: (myNum + 1) + " + + self + deny: (searcher + executeTree: + (self parseExpression: '(myNum + 1) + 1 + 5 + (myNum + 1)') + initialAnswer: 0) + equals: 1 +] + +{ #category : #'tests - to de refined' } +RBParseTreeSearcherTest >> testSearchSelectors [ + + " + - So here we are looking for an expression that starts with a receiver followed by at: message , then a list of arguments, then another selector that could be any selector ... followed by a second list of args + " + + | dict | + searcher + matches: '`@rcv at: `@arg `sel: `@arg1' + do: [ :aNode :answer | dict := searcher context ]. + + " ****** Assert ******" + + searcher executeTree: + (self parseExpression: 'cache at: each ifAbsentPut: [ each ].'). + + self + assert: + (dict at: (RBPatternVariableNode named: '`@rcv')) formattedCode + equals: 'cache'. + + self + assert: + (dict at: (RBPatternVariableNode named: '`@arg')) formattedCode + equals: 'each'. + + self + assert: + (dict at: (RBPatternVariableNode named: '`@arg1')) formattedCode + equals: '[ each ]'. + + searcher executeTree: + (self parseExpression: 'collection at: offset + count put: object.'). + + self + assert: + (dict at: (RBPatternVariableNode named: '`@rcv')) formattedCode + equals: 'collection'. + + self + assert: + (dict at: (RBPatternVariableNode named: '`@arg')) formattedCode + equals: 'offset + count'. + + self + assert: + (dict at: (RBPatternVariableNode named: '`@arg1')) formattedCode + equals: 'object'. + + " ****** Deny ******" + + searcher executeTree: + (self parseExpression: 'self assert: preferences exists.'). + + self + deny: + (dict at: (RBPatternVariableNode named: '`@rcv')) formattedCode + equals: 'self' +] + +{ #category : #'tests - to de refined' } +RBParseTreeSearcherTest >> testSearchStatements [ + + " + - No comment yet ... + " + + searcher matches: '`.Statements.' do: [ :aNode :answer | + answer + 1.]. + + " ****** Assert ******" + + self + assert: (searcher + executeTree: + (self parseExpression: 'myArray := OrderedCollection new. + myPoint := Point new setX: 1 setY: 2') + initialAnswer: 0) + equals: 2 +] + { #category : #'tests - to de refined' } RBParseTreeSearcherTest >> testSearching [ searcher - matches: '``@rcv at: ``@arg `sel: ``@arg1' - do: [ :aNode :answer | answer + 1 ]. + matches: '``@rcv at: `#arg `sel: ``@arg1' + do: [ :aT :answer | answer + 1 ]. self assert: (searcher executeTree: (self - parseExpression: 'self at: 1 put: 2; at: 2 ifAbsent: []; ifAbsent: 2 at: 1; at: 4; foo') + parseExpression: 'self at: (self at: 9 put: 8) put: 2; at: 2 ifAbsent: []; ifAbsent: 2 at: 1; at: 4; foo') initialAnswer: 0) equals: 2. + + + " + searcher := self parseTreeSearcher. searcher matches: '``@rcv `at: ``@arg1 `at: ``@arg2' @@ -76,6 +422,8 @@ RBParseTreeSearcherTest >> testSearching [ parseExpression: 'self at: 1 at: 3; at: 1 put: 32; at: 2; foo; at: 1 at: 1 at: 2') initialAnswer: 0) equals: 1. + + searcher := self parseTreeSearcher. searcher matchesMethod: 'at: `object `put: `o1 ``@rcv `put: 1' @@ -84,7 +432,7 @@ RBParseTreeSearcherTest >> testSearching [ assert: (searcher executeTree: (RBParser parseMethod: 'at: a put: b self foo put: 1') - initialAnswer: false) + initialAnswer: false)" ] { #category : #tests } diff --git a/src/AST-Core/RBParseTreeSearcher.class.st b/src/AST-Core/RBParseTreeSearcher.class.st index a8cf5c65c51..49fdaf6ba9d 100644 --- a/src/AST-Core/RBParseTreeSearcher.class.st +++ b/src/AST-Core/RBParseTreeSearcher.class.st @@ -7,6 +7,59 @@ Instance Variables: context a dictionary that contains what each meta-node matches against. This could be a normal Dictionary that is created for each search but is created once and reused (efficiency). messages the sent messages in our searches searches non-argument searches (search for the RBProgramNode and perform the BlockClosure when its found) + +*********************** + +"" + New comments: These comments are added in order to understand more how the RBParseTreeSearcher is working in Pharo, in addition of what special characters we can use to define the patterns we want to match. +"" + +A- Instance side: + - context + dictionary: contains the matched patterns + - searches + Ordered collection: contains all the rules like ArgumentRule, MethodRule, TreeRule, Rule ... + - argumentSearches + Ordered collection: filled when addArgumentRule or addArgumentRules is called + - matches:do: + looks for matches and if match found + --> the block in do is executed + --> a new rule is added to the list of rules 'searches' + - executeTree + - Executes the tree + - Fills context when successful match ??? + - addRule: + add rules to the to searches + - addRules: + add multiple rules to searches + - addArgumentSearches: + adds arguments to argumentSearches collection + - messages + returns the list of messages found in a match + - hasRules + returns searches list. + +B- Patterns: + +In order to unserstand more how pattern matching work, you can refer to the below description: +Supported charcters are listed below: + + 1- Backtick: ` + --> Type: Recurse into + --> Description: Whenever a match is found, look inside the matched NODE for more matches. + 2- Arobase: @ + --> Type: list + --> Description: First position matching, list with O or more elements + * When applied to a variable node --> it will match a literal, variable or a sequence of messages sent to a literal or variable + * When applied to a keyword message --> it will match a list of keyword messages + * When applied with a statement character --> Il will match a list of statements. + 3- Dot: . + --> Type: Statement + --> Description: matches a statement in a sequence node + 4- Hash: # + --> Type: Literal + --> Description: maches only literal Objects + " Class { #name : #RBParseTreeSearcher, diff --git a/src/AST-Core/RBPatternVariableNode.class.st b/src/AST-Core/RBPatternVariableNode.class.st index db9a07dba2f..97b4aff90c0 100644 --- a/src/AST-Core/RBPatternVariableNode.class.st +++ b/src/AST-Core/RBPatternVariableNode.class.st @@ -112,6 +112,7 @@ RBPatternVariableNode >> match: aNode inContext: aDictionary [ { #category : #matching } RBPatternVariableNode >> matchLiteral: aNode inContext: aDictionary [ + ^aNode isLiteralNode and: [ self compare: (aDictionary at: self ifAbsentPut: [aNode]) with: aNode] ]