Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
224 changes: 138 additions & 86 deletions src/Kernel-Tests/CompiledCodeTest.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -4,22 +4,25 @@ Class {
#instVars : [
'var'
],
#classVars : [
'MyTestSharedVariable'
],
#category : 'Kernel-Tests-Classes',
#package : 'Kernel-Tests',
#tag : 'Classes'
}

{ #category : 'examples' }
{ #category : 'private - test support' }
CompiledCodeTest >> compiledMethod1 [
^ self class >> #method1
]

{ #category : 'examples' }
{ #category : 'private - test support' }
CompiledCodeTest >> compiledMethod1Copy [
^ self compiledMethod1 copy
]

{ #category : 'examples' }
{ #category : 'private - test support' }
CompiledCodeTest >> method1 [

<pragma1: 123 foo: 'bar' >
Expand All @@ -29,12 +32,112 @@ CompiledCodeTest >> method1 [
#(#add #at: #remove) do: #printOn:
]

{ #category : 'examples' }
{ #category : 'private - test support' }
CompiledCodeTest >> methodFFI [

"For testing, not intended to be called"
^ self ffiCall: 'int gitpid()'
]

{ #category : 'private - test support' }
CompiledCodeTest >> methodForTest2 [

<pragma: #pragma>

| test |

test := 1 + 2.

self do: [
test := 1 - 2.
test := #( arrayInBlock ).
self name ].
^ #( #array )
]

{ #category : 'private - test support' }
CompiledCodeTest >> methodForTest3 [

<pragma: #pragma>

MyTestSharedVariable := 1 + 2.

self doIt: [
MyTestSharedVariable := 1 - 2.
MyTestSharedVariable := #( arrayInBlock ).
self name ].

^ #( #array )
]

{ #category : 'private - test support' }
CompiledCodeTest >> methodForTest4 [

<pragma: #pragma>

MyTestSharedVariable := 1 + 2.

Class.

self doIt: [
MyTestSharedVariable := 1 - 2.
MyTestSharedVariable := #( arrayInBlock ).
Object.
self name ].

^ #( #array )
]

{ #category : 'private - test support' }
CompiledCodeTest >> methodForTest5 [

<compilerOptions: #( #+ optionCleanBlockClosure )>
| b |
b := 1.
^ [ thisContext tempNamed: 'b' ] value
]

{ #category : 'private - test support' }
CompiledCodeTest >> methodReturnOne [

^ 1
]

{ #category : 'private - test support' }
CompiledCodeTest >> methodReturningBlock [

^ [
MyTestSharedVariable := 1 - 2.
MyTestSharedVariable := #(arrayInBlock).
Object.
self name ]
]

{ #category : 'private - test support' }
CompiledCodeTest >> methodReturningSelf [

^ self
]

{ #category : 'private - test support' }
CompiledCodeTest >> methodReturningThisContext [

^ thisContext
]

{ #category : 'private - test support' }
CompiledCodeTest >> methodSendingDoitToSelf [

^ self doit
]

{ #category : 'private - test support' }
CompiledCodeTest >> methodSendingDoitToSelfWithUnusedBloc [

self doit.
[ Object class ]
]

{ #category : 'tests - testing' }
CompiledCodeTest >> testBlockReturnSpecial [
"we do not compile blocks with quick returns for now"
Expand Down Expand Up @@ -122,15 +225,9 @@ CompiledCodeTest >> testFlag [
CompiledCodeTest >> testHasLiteral [

| method |
method := self class compiler permitFaulty: true; source: 'method
<pragma: #pragma>
test := 1+2.
self doIt: [
test := 1 - 2.
test := #(arrayInBlock).
self name ].
^#(#array) '; compileOrFail.
"simpe case: normal send in the method itself"
method := method := self class >> #methodForTest3.

"simple case: normal send in the method itself"
self assert: (method hasLiteral: #doIt:).
"special selector in the method is not found"
self deny: (method hasLiteral: #+).
Expand Down Expand Up @@ -168,15 +265,9 @@ CompiledCodeTest >> testHasLiteral2 [
CompiledCodeTest >> testHasLiteralSuchThat [

| method |
method := self class compiler permitFaulty: true; source: 'method
<pragma: #pragma>
test := 1+2.
self doIt: [
test := 1 - 2.
test := #(arrayInBlock).
self name ].
^#(#array) '; compileOrFail.
"simpe case: normal send in the method itself"
method := self class >> #methodForTest3.

"simple case: normal send in the method itself"
self assert: (method hasLiteralSuchThat: [:literal | literal == #doIt:]).
"special selector in the method is not found"
self deny: (method hasLiteralSuchThat: [:literal | literal == #+]).
Expand All @@ -200,15 +291,10 @@ CompiledCodeTest >> testHasLiteralSuchThat [
CompiledCodeTest >> testHasSelector [

| method |
method := self class compiler permitFaulty: true; source: 'method
<pragma: #pragma>
test := 1+2.
self doIt: [
test := 1 - 2.
test := #(arrayInBlock).
self name ].
^#(#array) '; compileOrFail.
"simpe case: normal send in the method itself"

method := self class >> #methodForTest3.

"simple case: normal send in the method itself"
self assert: (method hasSelector: #doIt:).
"special selector in the method"
self assert: (method hasSelector: #+).
Expand All @@ -232,14 +318,8 @@ CompiledCodeTest >> testHasSelector [
CompiledCodeTest >> testHasSelectorSpecialSelectorIndex [

| method specialIndex |
method := self class compiler permitFaulty: true; source: 'method
<pragma: #pragma>
test := 1+2.
self do: [
test := 1 - 2.
test := #(arrayInBlock).
self name ].
^#(#array) '; compileOrFail.
method := self class >> #methodForTest2.

"simpe case: normal send in the method itself"
specialIndex := Smalltalk specialSelectorIndexOrNil: #do:.
self assert: (method hasSelector: #do: specialSelectorIndex: specialIndex).
Expand Down Expand Up @@ -284,25 +364,11 @@ CompiledCodeTest >> testHasTemporaries [
CompiledCodeTest >> testLiteralsDoNotConsiderTheInnerBlockLiterals [

| method block |
method := self class compiler permitFaulty: true; source: 'method
<pragma: #pragma>
test := 1+2.
Class.
self doIt: [
test := 1 - 2.
test := #(arrayInBlock).
Object.
self name ].
^#(#array) '; compileOrFail.
block := (OpalEvaluator new permitFaulty: true; evaluate: '[
test := 1 - 2.
test := #(arrayInBlock).
Object.
self name ]') compiledBlock.
method := self class >> #methodForTest4.
block := self methodReturningBlock compiledBlock.
self assertCollection: method literals equals: {
2.
(UndeclaredVariable key: #test value: nil).
#runtimeUndeclaredWrite:inContext:.
(ClassVariable key: #MyTestSharedVariable value: nil).
(GlobalVariable key: #Class value: Class).
block.
#doIt:.
Expand All @@ -328,30 +394,20 @@ CompiledCodeTest >> testLiteralsDoesNotContainMethodName [
CompiledCodeTest >> testLiteralsEvenTheOnesInTheInnerBlocks [
"The behavior is different than literals"
| method |
method := self class compiler permitFaulty: true; source: 'method
<pragma: #pragma>
test := 1+2.
Class.
self doIt: [
test := 1 - 2.
test := #(arrayInBlock).
Object.
self name ].
^#(#array) '; compileOrFail.
method := self class >> #methodForTest4.

"Next assertion is expected: literals have a different behavior more close to the system"
self deny: method literalsEvenTheOnesInTheInnerBlocks equals: method literals.
self
assertCollection: method literalsEvenTheOnesInTheInnerBlocks
equals: {
2.
(UndeclaredVariable key: #test value: nil).
#runtimeUndeclaredWrite:inContext:.
(GlobalVariable key: #Class value: Class).
ClassVariable key: #MyTestSharedVariable value: nil.
GlobalVariable key: #Class value: Class.
2.
(UndeclaredVariable key: #test value: nil).
#runtimeUndeclaredWrite:inContext:.
ClassVariable key: #MyTestSharedVariable value: nil.
#( #arrayInBlock ).
(GlobalVariable key: #Object value: Object).
GlobalVariable key: #Object value: Object.
#name.
#doIt:.
#( #array ). }
Expand All @@ -363,12 +419,8 @@ CompiledCodeTest >> testLiteralsEvenTheOnesInTheInnerCleanBlocks [
"The behavior is different than literals"

| method |
method := self class compiler source:
'exampleAccessOuterFromCleanBlock
<compilerOptions: #(+ optionCleanBlockClosure)>
| b |
b := 1.
^[ thisContext tempNamed: ''b'' ] value'; compileOrFail.
method := self class >> #methodForTest5.

self
assertCollection: method literalsEvenTheOnesInTheInnerBlocks
equals: #( 'b' #tempNamed: )
Expand All @@ -377,15 +429,15 @@ CompiledCodeTest >> testLiteralsEvenTheOnesInTheInnerCleanBlocks [
{ #category : 'tests - scanning' }
CompiledCodeTest >> testLocalMessages [
| method |
method := self class compiler source: 'method self doit. [Object class]'; compileOrFail.
method := self class >> #methodSendingDoitToSelfWithUnusedBloc.
self assert: method localMessages asArray equals: #(#doit) .

]

{ #category : 'tests - scanning' }
CompiledCodeTest >> testMessages [
| method |
method := self class compiler source: 'method self doit. [Object class]'; compileOrFail.
method := self class >> #methodSendingDoitToSelfWithUnusedBloc.
self assertCollection: method messages asArray hasSameElements: #(#doit #class).
]

Expand Down Expand Up @@ -437,25 +489,25 @@ CompiledCodeTest >> testReadsRef [
{ #category : 'tests - scanning' }
CompiledCodeTest >> testReadsSelf [
| method |
method := self class compiler source: 'method self doit'; compileOrFail.
method := self class >> #methodSendingDoitToSelf.
self assert: method readsSelf.
method := self class compiler source: 'method ^self'; compileOrFail.
method := self class >> #methodReturningSelf.
self assert: method readsSelf.
method := self class compiler source: 'method ^thisContext'; compileOrFail.
method := self class >> #methodReturningThisContext.
self deny: method readsSelf.
"take care! FFI methods have a self send, but they do not have self bytecode after the first call
Here we test just the case of a FFI method that was not yet called to not make this test depend on FFI
calls"
method := self class compiler source: 'status ^ self ffiCall: #(int cairo_scaled_font_status (self))'; compileOrFail.
method := self class >> #methodFFI.
self assert: method readsSelf
]

{ #category : 'tests - scanning' }
CompiledCodeTest >> testReadsThisContext [
| method |
method := self class compiler source: 'method ^thisContext'; compileOrFail.
method := self class >> #methodReturningThisContext.
self assert: method readsThisContext.
method := self class compiler source: 'method ^self'; compileOrFail.
method := self class >> #methodReturningSelf.
self deny: method readsThisContext
]

Expand Down
35 changes: 35 additions & 0 deletions src/Kernel-Tests/ManifestKernelTests.class.st
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,42 @@ ManifestKernelTests class >> packageName [
^ #KernelTests
]

{ #category : 'code-critics' }
ManifestKernelTests class >> ruleCodeCruftLeftInMethodsRuleV1FalsePositive [

<ignoreForCoverage>
^ #(#(#(#RGMethodDefinition #(#CompiledCodeTest #testHasLiteral #false)) #'2026-06-01T11:00:05.559108+02:00') )
]

{ #category : 'code-critics' }
ManifestKernelTests class >> ruleDeadBlockRuleV1FalsePositive [

<ignoreForCoverage>
^ #(#(#(#RGMethodDefinition #(#CompiledCodeTest #methodSendingDoitToSelfWithUnusedBloc #false)) #'2026-06-01T10:59:14.984788+02:00') )
]

{ #category : 'code-critics' }
ManifestKernelTests class >> ruleExtraBlockRuleV1FalsePositive [

<ignoreForCoverage>
^ #(#(#(#RGMethodDefinition #(#CompiledCodeTest #methodForTest5 #false)) #'2026-06-01T10:59:41.970308+02:00') )
]

{ #category : 'code-critics' }
ManifestKernelTests class >> ruleRBModifiesCollectionRuleV1FalsePositive [
^ #(#(#(#RGMethodDefinition #(#ClassHierarchyTest #testSubclassInstVar #false)) #'2019-06-26T12:47:46.581134+02:00') )
]

{ #category : 'code-critics' }
ManifestKernelTests class >> ruleSelfSentNotImplementedRuleV1FalsePositive [

<ignoreForCoverage>
^ #(#(#(#RGMethodDefinition #(#CompiledCodeTest #methodForTest2 #false)) #'2026-05-29T15:14:10.242922+02:00') #(#(#RGMethodDefinition #(#CompiledCodeTest #methodSendingDoitToSelf #false)) #'2026-06-01T10:27:35.445639+02:00') #(#(#RGMethodDefinition #(#CompiledCodeTest #methodSendingDoitToSelfWithUnusedBloc #false)) #'2026-06-01T10:59:17.653294+02:00') #(#(#RGMethodDefinition #(#CompiledCodeTest #methodForTest4 #false)) #'2026-06-01T10:59:28.97238+02:00') #(#(#RGMethodDefinition #(#CompiledCodeTest #methodReturningBlock #false)) #'2026-06-01T10:59:51.16598+02:00') #(#(#RGMethodDefinition #(#CompiledCodeTest #methodForTest3 #false)) #'2026-06-01T10:59:58.627576+02:00') )
]

{ #category : 'code-critics' }
ManifestKernelTests class >> ruleSentNotImplementedRuleV1FalsePositive [

<ignoreForCoverage>
^ #(#(#(#RGMethodDefinition #(#CompiledCodeTest #methodSendingDoitToSelf #false)) #'2026-06-01T10:27:26.457047+02:00') #(#(#RGMethodDefinition #(#CompiledCodeTest #methodSendingDoitToSelfWithUnusedBloc #false)) #'2026-06-01T10:59:12.206319+02:00') )
]