From 9f6693f435cb4585ae408b45680a2a51453ad4ca Mon Sep 17 00:00:00 2001 From: Max Leske <250711+theseion@users.noreply.github.com> Date: Sat, 18 Jan 2025 17:24:54 +0100 Subject: [PATCH] chore: clean up tests --- .../FLBlockClosureSerializationTest.class.st | 24 +++++++++---------- .../FLCreateClassSerializationTest.class.st | 15 +++++------- ...FullBlockClosureSerializationTest.class.st | 6 ++--- .../FLSerializationTest.class.st | 4 ++-- 4 files changed, 23 insertions(+), 26 deletions(-) diff --git a/src/Fuel-Core-Tests/FLBlockClosureSerializationTest.class.st b/src/Fuel-Core-Tests/FLBlockClosureSerializationTest.class.st index e77bb8d6b8e..6392d8e4c9b 100644 --- a/src/Fuel-Core-Tests/FLBlockClosureSerializationTest.class.st +++ b/src/Fuel-Core-Tests/FLBlockClosureSerializationTest.class.st @@ -295,7 +295,7 @@ FLBlockClosureSerializationTest >> testBlockClosureWithThreeArguments [ FLBlockClosureSerializationTest >> testCleanBlockClosure [ | aClosure meterialized | - OCCompilationContext optionCleanBlockClosure ifFalse: [ ^ self skip ]. + Smalltalk compiler compilationContext optionCleanBlockClosure ifFalse: [ ^ self skip ]. aClosure := [ :x | x objects detect: [ :y | y isInteger ] ]. self assert: aClosure isClean. @@ -310,20 +310,11 @@ FLBlockClosureSerializationTest >> testCleanBlockClosure [ self assert: meterialized equals: 87 ] -{ #category : 'tests-clean' } -FLBlockClosureSerializationTest >> testNestedBlockClosureConstant [ - | closure materializedClosure | - closure := [ [ 42 ] ]. - materializedClosure := self resultOfSerializeAndMaterialize: closure. - closure assertWellMaterializedInto: materializedClosure in: self. - self assert: materializedClosure value value equals: 42 -] - { #category : 'tests' } -FLBlockClosureSerializationTest >> testNestedCleanBlockClosure [ +FLBlockClosureSerializationTest >> testNestedBlockClosureClean [ | aClosure meterialized | - OCCompilationContext optionCleanBlockClosure ifFalse: [ ^ self skip ]. + Smalltalk compiler compilationContext optionCleanBlockClosure ifFalse: [ ^ self skip ]. aClosure := [ [ :x | x objects detect: [ :y | y isInteger ] ] ] value. self assert: aClosure isClean. @@ -337,3 +328,12 @@ FLBlockClosureSerializationTest >> testNestedCleanBlockClosure [ self assert: meterialized equals: 87 ] + +{ #category : 'tests-clean' } +FLBlockClosureSerializationTest >> testNestedBlockClosureConstant [ + | closure materializedClosure | + closure := [ [ 42 ] ]. + materializedClosure := self resultOfSerializeAndMaterialize: closure. + closure assertWellMaterializedInto: materializedClosure in: self. + self assert: materializedClosure value value equals: 42 +] diff --git a/src/Fuel-Core-Tests/FLCreateClassSerializationTest.class.st b/src/Fuel-Core-Tests/FLCreateClassSerializationTest.class.st index 1f6e0b31e65..8e6de35e2fa 100644 --- a/src/Fuel-Core-Tests/FLCreateClassSerializationTest.class.st +++ b/src/Fuel-Core-Tests/FLCreateClassSerializationTest.class.st @@ -349,20 +349,17 @@ FLCreateClassSerializationTest >> testCreateHierarchyWithExistingClasses [ { #category : 'tests-bugs' } FLCreateClassSerializationTest >> testCreateHierarchyWithSubclassSerializedBeforeSuperclass [ - "Tests issue #210" + "Tests issue #210 + See FLBehaviorCluster>>registerIndexesOn:" - | a b serializedClasses set | + | a b serializedClasses | a := self classFactory silentlyNewClass. b := self classFactory silentlyMake: [ :aBuilder | aBuilder superclass: a ]. serializedClasses := { a . b }. - "Behavior clusters use an FLLargeIdentitySet for their objects. - We need to be sure that the subclass is serialized before the superclass." - serializedClasses reversed withIndexDo: [ :class :index | self classFactory silentlyCompile: 'largeIdentityHash ^ ' , index asString in: class class ]. - set := FLLargeIdentitySet new - addAll: serializedClasses; - yourself. - self assert: set asArray first identicalTo: b. + self shouldnt: [ self resultOfSerializeRemoveAndMaterializeAll: serializedClasses ] raise: MessageNotUnderstood. + + serializedClasses := { b. a}. self shouldnt: [ self resultOfSerializeRemoveAndMaterializeAll: serializedClasses ] raise: MessageNotUnderstood ] diff --git a/src/Fuel-Core-Tests/FLFullBlockClosureSerializationTest.class.st b/src/Fuel-Core-Tests/FLFullBlockClosureSerializationTest.class.st index f0645337e60..3f07cb7a4db 100644 --- a/src/Fuel-Core-Tests/FLFullBlockClosureSerializationTest.class.st +++ b/src/Fuel-Core-Tests/FLFullBlockClosureSerializationTest.class.st @@ -67,7 +67,7 @@ FLFullBlockClosureSerializationTest >> testBlockClosureChangeDifferentBytecodesC aClosure := aClass new perform: #methodWithClosure. self assert: aClosure isClean. self assertConstantBlockOuterContextBasedOnCompilationOption: aClosure. - OCCompilationContext optionConstantBlockClosure ifTrue: [ + Smalltalk compiler compilationContext optionConstantBlockClosure ifTrue: [ self assert: aClosure class equals: (Smalltalk at: #ConstantBlockClosure) ]. self serializer fullySerializeMethod: aClosure compiledBlock method. @@ -119,7 +119,7 @@ FLFullBlockClosureSerializationTest >> testBlockClosureChangeSameBytecodesConsta aClosure := aClass new perform: #methodWithClosure. self assert: aClosure isClean. self assertConstantBlockOuterContextBasedOnCompilationOption: aClosure. - OCCompilationContext optionConstantBlockClosure ifTrue: [ + Smalltalk compiler compilationContext optionConstantBlockClosure ifTrue: [ self assert: aClosure class equals: (Smalltalk at: #ConstantBlockClosure) ]. self serializer fullySerializeMethod: aClosure compiledBlock method. @@ -168,7 +168,7 @@ FLFullBlockClosureSerializationTest >> testBlockClosureRemovedConstant [ aClosure := aClass new perform: #methodWithClosure. self assert: aClosure isClean. self assertConstantBlockOuterContextBasedOnCompilationOption: aClosure. - OCCompilationContext optionConstantBlockClosure ifTrue: [ + Smalltalk compiler compilationContext optionConstantBlockClosure ifTrue: [ self assert: aClosure class equals: (Smalltalk at: #ConstantBlockClosure) ]. self serializer fullySerializeMethod: aClosure compiledBlock method. diff --git a/src/Fuel-Core-Tests/FLSerializationTest.class.st b/src/Fuel-Core-Tests/FLSerializationTest.class.st index 16735a7dc33..c92178ab5b2 100644 --- a/src/Fuel-Core-Tests/FLSerializationTest.class.st +++ b/src/Fuel-Core-Tests/FLSerializationTest.class.st @@ -29,7 +29,7 @@ FLSerializationTest class >> resources [ { #category : 'asserting' } FLSerializationTest >> assertCleanBlockOuterContextBasedOnCompilationOption: aClosure [ - OCCompilationContext optionCleanBlockClosure + Smalltalk compiler compilationContext optionCleanBlockClosure ifTrue: [ self assert: aClosure outerContext isNil ] ifFalse: [ self assert: aClosure outerContext isNotNil ] ] @@ -37,7 +37,7 @@ FLSerializationTest >> assertCleanBlockOuterContextBasedOnCompilationOption: aCl { #category : 'asserting' } FLSerializationTest >> assertConstantBlockOuterContextBasedOnCompilationOption: aClosure [ - OCCompilationContext optionConstantBlockClosure + Smalltalk compiler compilationContext optionConstantBlockClosure ifTrue: [ self assert: aClosure outerContext isNil ] ifFalse: [ self assert: aClosure outerContext isNotNil ] ]