From 6a41a6a3df5efc157350fa55a984edfa07cf4186 Mon Sep 17 00:00:00 2001 From: Marcus Denker Date: Thu, 23 Jul 2020 13:46:59 +0200 Subject: [PATCH] - add test #testHasSelector and #testHasSelectorSpecialSelectorIndex - recategorize CompiledCodeTest - implement hasSelector:specialSelectorIndex: to only iterate the blocks for special selectors fixes #6965 --- src/Kernel-Tests/CompiledCodeTest.class.st | 103 ++++++++++++++++++--- src/Kernel/CompiledCode.class.st | 18 ++-- 2 files changed, 97 insertions(+), 24 deletions(-) diff --git a/src/Kernel-Tests/CompiledCodeTest.class.st b/src/Kernel-Tests/CompiledCodeTest.class.st index ad55856343f..a1158df9d6b 100644 --- a/src/Kernel-Tests/CompiledCodeTest.class.st +++ b/src/Kernel-Tests/CompiledCodeTest.class.st @@ -4,12 +4,12 @@ Class { #category : #'Kernel-Tests-Classes' } -{ #category : #accessing } +{ #category : #examples } CompiledCodeTest >> compiledMethod1 [ ^ self class >> #method1 ] -{ #category : #accessing } +{ #category : #examples } CompiledCodeTest >> method1 [ @@ -19,7 +19,80 @@ CompiledCodeTest >> method1 [ #(#add #at: #remove) do: #printOn: ] -{ #category : #accessing } +{ #category : #'tests-literals' } +CompiledCodeTest >> testHasSelector [ + + | method | + method := self class compiler compile: 'method + + test := 1+2. + self do: [ + test := 1 - 2. + test := #(arrayInBlock). + self name ]. + ^#(#array) '. + "simpe case: normal send in the method itself" + self assert: (method hasSelector: #do:). + "special selector in the method" + self assert: (method hasSelector: #+). + "special selector in the block" + self assert: (method hasSelector: #-). + "normal selector in the block" + self assert: (method hasSelector: #name). + "we look into arrays" + self assert: (method hasSelector: #array). + "we look into arrays in Blocks" + self assert: (method hasSelector: #arrayInBlock). + "pragmas are covered" + self assert: (method hasSelector: #pragma:). + "literals as args of pragmas. too" + self assert: (method hasSelector: #pragma:). + "the method selecto NOT" + self deny: (method hasSelector: #method). +] + +{ #category : #'tests-literals' } +CompiledCodeTest >> testHasSelectorSpecialSelectorIndex [ + + | method specialIndex | + method := self class compiler compile: 'method + + test := 1+2. + self do: [ + test := 1 - 2. + test := #(arrayInBlock). + self name ]. + ^#(#array) '. + "simpe case: normal send in the method itself" + specialIndex := Smalltalk specialSelectorIndexOrNil: #do:. + self assert: (method hasSelector: #do: specialSelectorIndex: specialIndex). + "special selector in the method" + specialIndex := Smalltalk specialSelectorIndexOrNil: #+. + self assert: (method hasSelector: #+ specialSelectorIndex: specialIndex). + "special selector in the block" + specialIndex := Smalltalk specialSelectorIndexOrNil: #-. + self assert: (method hasSelector: #- specialSelectorIndex: specialIndex). + "normal selector in the block" + specialIndex := Smalltalk specialSelectorIndexOrNil: #name. + self assert: (method hasSelector: #name specialSelectorIndex: specialIndex). + "we look into arrays" + specialIndex := Smalltalk specialSelectorIndexOrNil: #array. + self assert: (method hasSelector: #array specialSelectorIndex: specialIndex). + "we look into arrays in Blocks" + specialIndex := Smalltalk specialSelectorIndexOrNil: #arrayInBlock. + self assert: (method hasSelector: #arrayInBlock specialSelectorIndex: specialIndex). + "pragmas are covered" + specialIndex := Smalltalk specialSelectorIndexOrNil: #pragma:. + self assert: (method hasSelector: #pragma: specialSelectorIndex: specialIndex). + "literals as args of pragmas. too" + specialIndex := Smalltalk specialSelectorIndexOrNil: #pragma:. + self assert: (method hasSelector: #pragma: specialSelectorIndex: specialIndex). + "the method selecto NOT" + specialIndex := Smalltalk specialSelectorIndexOrNil: #method. + self deny: (method hasSelector: #method specialSelectorIndex: specialIndex). +] + +{ #category : #'tests-literals' } CompiledCodeTest >> testLiteralsDoesNotContainMethodClass [ self @@ -28,13 +101,13 @@ CompiledCodeTest >> testLiteralsDoesNotContainMethodClass [ refersToLiteral: (self class environment associationAt: self class name asSymbol)) ] -{ #category : #accessing } +{ #category : #'tests-literals' } CompiledCodeTest >> testLiteralsDoesNotContainMethodName [ self deny: (self compiledMethod1 refersToLiteral: #method1) ] -{ #category : #accessing } +{ #category : #'tests-literals' } CompiledCodeTest >> testRefersToLiteralsReturnsFalseWhenLiteralNotInMethodPropertiesKey [ [ self compiledMethod1 propertyAt: #Once put: true. @@ -42,38 +115,38 @@ CompiledCodeTest >> testRefersToLiteralsReturnsFalseWhenLiteralNotInMethodProper ensure: [ self compiledMethod1 removeProperty: #Once ] ] -{ #category : #accessing } +{ #category : #'tests-literals' } CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsArrayOfLiterals [ self assert: (self compiledMethod1 refersToLiteral: #(#add #at: #remove)) ] -{ #category : #accessing } +{ #category : #'tests-literals' } CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsByteString [ self assert: (self compiledMethod1 refersToLiteral: 'Pharo loves tests') ] -{ #category : #accessing } +{ #category : #'tests-literals' } CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsByteSymbol [ self assert: (self compiledMethod1 refersToLiteral: #printOn:) ] -{ #category : #accessing } +{ #category : #'tests-literals' } CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsContainedInArrayOfLitterals [ self assert: (self compiledMethod1 refersToLiteral: #add) ] -{ #category : #accessing } +{ #category : #'tests-literals' } CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsGlobalVariable [ self assert: (self compiledMethod1 refersToLiteral: (self class environment associationAt: #Array)) ] -{ #category : #accessing } +{ #category : #'tests-literals' } CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsInMethodPropertiesKey [ [ self compiledMethod1 propertyAt: #Once put: true. @@ -81,7 +154,7 @@ CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsInMethodProperti ensure: [ self compiledMethod1 removeProperty: #Once ] ] -{ #category : #accessing } +{ #category : #'tests-literals' } CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsInMethodPropertiesValue [ [ self compiledMethod1 propertyAt: #Once put: '123'. @@ -89,7 +162,7 @@ CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsInMethodProperti ensure: [ self compiledMethod1 removeProperty: #Once ] ] -{ #category : #accessing } +{ #category : #'tests-literals' } CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsInMethodPropertiesValueArray [ [ self compiledMethod1 propertyAt: #Once put: #(1 2 3). @@ -97,14 +170,14 @@ CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsInMethodProperti ensure: [ self compiledMethod1 removeProperty: #Once ] ] -{ #category : #accessing } +{ #category : #'tests-literals' } CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsInPragmaArguments [ self assert: (self compiledMethod1 refersToLiteral: 'bar'). self assert: (self compiledMethod1 refersToLiteral: 123) ] -{ #category : #accessing } +{ #category : #'tests-literals' } CompiledCodeTest >> testRefersToLiteralsReturnsTrueWhenLiteralIsInPragmaSelector [ self assert: (self compiledMethod1 diff --git a/src/Kernel/CompiledCode.class.st b/src/Kernel/CompiledCode.class.st index 8362072dc59..f9c68f5d209 100644 --- a/src/Kernel/CompiledCode.class.st +++ b/src/Kernel/CompiledCode.class.st @@ -295,15 +295,15 @@ CompiledCode >> hasSelector: selector specialSelectorIndex: specialOrNil [ If you do, you may call this method directly to avoid recomputing the special selector index all the time. - I traverse the method and all the compiled blocks in the literals - " - - ^ self withAllBlocks - anySatisfy: [ :aCompiledCode | - (aCompiledCode refersToLiteral: selector) - or: [ specialOrNil isNotNil - and: [ aCompiledCode - scanFor: self encoderClass firstSpecialSelectorByte + specialOrNil ] ] ] + I traverse the method and all the compiled blocks in the literals" + + + (self refersToLiteral: selector) ifTrue: [ ^ true ]. + "refersToLiteral: traverses all blocks, but only for no-special literals" + specialOrNil ifNil: [ ^ false ]. + "if the selector is special, scan all blocks and myself" + ^ self withAllBlocks anySatisfy: [ :aCompiledCode | aCompiledCode scanFor: + self encoderClass firstSpecialSelectorByte + specialOrNil ] ] { #category : #accessing }