From 23b5d99cc8bf8b6380f2e08fc33cc6834bffc3e3 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Mon, 27 Nov 2023 13:33:05 +0100 Subject: [PATCH 1/8] Add test shuffling plus the opportunity to give and recover the seed controlling it --- src/JenkinsTools-Core/HDTestReport.class.st | 29 ++++++++-- .../TestCommandLineHandler.class.st | 25 ++++++--- .../SequenceableCollection.extension.st | 8 +++ src/SUnit-Core/TestSuite.class.st | 54 +++++++++---------- src/SUnit-Tests/Package.extension.st | 7 +-- 5 files changed, 81 insertions(+), 42 deletions(-) diff --git a/src/JenkinsTools-Core/HDTestReport.class.st b/src/JenkinsTools-Core/HDTestReport.class.st index 445ed084785..502adecde95 100644 --- a/src/JenkinsTools-Core/HDTestReport.class.st +++ b/src/JenkinsTools-Core/HDTestReport.class.st @@ -18,7 +18,8 @@ Class { 'shouldSerializeError' ], #classVars : [ - 'CurrentStageName' + 'CurrentStageName', + 'ShuffleSeed' ], #category : 'JenkinsTools-Core', #package : 'JenkinsTools-Core' @@ -39,18 +40,32 @@ HDTestReport class >> runClasses: aCollectionOfClasses named: packageName [ | suite classes time result | suite := TestSuite named: packageName. - classes := (aCollectionOfClasses select: [ :class | class isTestCase and: [ class isAbstract not ] ]) asSortedCollection: [ :a :b | a name <= b name ]. + + "Use the configured shuffle seed if any, or a random one otherwise" + ShuffleSeed ifNotNil: [ suite shuffleSeed: ShuffleSeed asInteger ]. + + classes := (aCollectionOfClasses select: [ :class | + class isTestCase and: [ class isAbstract not ] ]) + asSortedCollection: [ :a :b | a name <= b name ]. classes ifEmpty: [ ^ nil ]. classes do: [ :class | suite addTests: class buildSuite tests ]. time := DateAndTime now. - Transcript << 'Beginning to run tests of ' << packageName << OSPlatform current lineEnding. + Transcript + << 'Beginning to run tests of ' << packageName + << ' with random seed ' << ShuffleSeed asString + << OSPlatform current lineEnding. "We flush so that if a crash happens during the tests, we print in which package is the naughty test in the logs." Transcript flush. + result := self runSuite: suite. - Transcript << 'Finished to run tests of ' << packageName << ' in ' << (DateAndTime now - time) humanReadablePrintString << OSPlatform current lineEnding. + + Transcript + << 'Finished to run tests of ' << packageName << ' in ' + << (DateAndTime now - time) humanReadablePrintString + << OSPlatform current lineEnding. Transcript flush. ^ result @@ -68,6 +83,11 @@ HDTestReport class >> runSuite: aTestSuite [ ^ self new runSuite: aTestSuite ] +{ #category : 'running' } +HDTestReport class >> shuffleSeed: aSeed [ + ShuffleSeed := aSeed +] + { #category : 'private' } HDTestReport >> calculateNodeName [ | environmentClass name bitString | @@ -327,6 +347,7 @@ HDTestReport >> setUp [ nextPutAll: 'name="'; nextPutAll: (self encode: suite name); nextPutAll: '" '; nextPutAll: 'tests="'; print: suite tests size; nextPutAll: '" '; nextPutAll: 'timestamp="'; print: Time now; nextPutAll: '" '; + nextPutAll: 'seed="'; print: suite shuffleSeed; nextPutAll: '" '; nextPutAll: '>'. "Now this is ugly. We want to update the time and the number of failures and errors, but still at the same time stream a valid XML. So remember this position and add some whitespace, that we can fill later." diff --git a/src/JenkinsTools-Core/TestCommandLineHandler.class.st b/src/JenkinsTools-Core/TestCommandLineHandler.class.st index 5d4df437bac..160491fe9bf 100644 --- a/src/JenkinsTools-Core/TestCommandLineHandler.class.st +++ b/src/JenkinsTools-Core/TestCommandLineHandler.class.st @@ -130,13 +130,22 @@ TestCommandLineHandler >> runPackages [ { #category : 'private' } TestCommandLineHandler >> testRunner [ - - (self hasOption: 'junit-xml-output') ifTrue: [ - HDTestReport currentStageName: ((self hasOption: 'stage-name') ifTrue: [ self optionAt: 'stage-name' ] ifFalse: [ '' ]). + + (self hasOption: 'junit-xml-output') ifTrue: [ + HDTestReport shuffleSeed: ((self hasOption: 'shuffle-seed') + ifTrue: [ self optionAt: 'shuffle-seed' ] + ifFalse: [ nil ]). + HDTestReport currentStageName: ((self hasOption: 'stage-name') + ifTrue: [ self optionAt: 'stage-name' ] + ifFalse: [ '' ]). ^ HDTestReport ]. - - self class environment at: #CommandLineTestRunner ifPresent: [ :commandLineTestRunner | - (self hasOption: 'no-xterm') ifTrue: [ ^ commandLineTestRunner ]. - ^ self class environment at: #VTermTestRunner - ] ifAbsent: [ self error: 'no tests output available, try to use the option --junit-xml-output' ] + + self class environment + at: #CommandLineTestRunner + ifPresent: [ :commandLineTestRunner | + (self hasOption: 'no-xterm') ifTrue: [ ^ commandLineTestRunner ]. + ^ self class environment at: #VTermTestRunner ] + ifAbsent: [ + self error: + 'no tests output available, try to use the option --junit-xml-output' ] ] diff --git a/src/Random-Core/SequenceableCollection.extension.st b/src/Random-Core/SequenceableCollection.extension.st index f3ea169148e..86051105ea5 100644 --- a/src/Random-Core/SequenceableCollection.extension.st +++ b/src/Random-Core/SequenceableCollection.extension.st @@ -32,3 +32,11 @@ SequenceableCollection >> shuffleBy: aRandom [ SequenceableCollection >> shuffled [ ^ self copy shuffle ] + +{ #category : '*Random-Core' } +SequenceableCollection >> shuffledBy: aRandom [ + "Durstenfeld's version of the Fisher-Yates shuffle" + "({1. 2. 3. 4. 5} shuffleBy: (Random seed: 42)) >>> #(1 2 5 4 3)" + + ^ self copy shuffleBy: aRandom +] diff --git a/src/SUnit-Core/TestSuite.class.st b/src/SUnit-Core/TestSuite.class.st index b075880f7a1..bfb0ae5e515 100644 --- a/src/SUnit-Core/TestSuite.class.st +++ b/src/SUnit-Core/TestSuite.class.st @@ -14,7 +14,8 @@ Class { 'tests', 'resources', 'name', - 'announcer' + 'announcer', + 'randomGenerator' ], #category : 'SUnit-Core-Kernel', #package : 'SUnit-Core', @@ -38,12 +39,6 @@ TestSuite >> , aTestSuite [ yourself ] -{ #category : 'dependencies' } -TestSuite >> addDependentToHierachy: anObject [ - self addDependent: anObject. - self tests do: [ :each | each addDependentToHierachy: anObject] -] - { #category : 'accessing' } TestSuite >> addTest: aTest [ self tests add: aTest @@ -61,16 +56,8 @@ TestSuite >> announceTest: aTest [ { #category : 'running' } TestSuite >> debug [ - self setUp. - [ - self tests do: [:each | - each debug. - self announceTest: each. - self changed: each. - ] - ] ensure:[ - self tearDown. - ] + + self runWith: [ :test | test debug ] ] { #category : 'accessing' } @@ -97,12 +84,6 @@ TestSuite >> name: aString [ name := aString ] -{ #category : 'dependencies' } -TestSuite >> removeDependentFromHierachy: anObject [ - self removeDependent: anObject. - self tests do: [ :each | each removeDependentFromHierachy: anObject] -] - { #category : 'running' } TestSuite >> resourceClass [ @@ -138,16 +119,17 @@ TestSuite >> run [ { #category : 'running' } TestSuite >> run: aResult [ + CurrentExecutionEnvironment runTestsBy: [ - self runUnmanaged: aResult ] + self runWith: [ :test | test run: aResult ] ] ] { #category : 'running' } -TestSuite >> runUnmanaged: aResult [ +TestSuite >> runWith: aBlock [ self setUp. - [ self tests + [ self shuffledTests do: [ :each | - each run: aResult. + aBlock value: each. self announceTest: each. self changed: each ] ] ensure: [ self tearDown ] @@ -159,6 +141,24 @@ TestSuite >> setUp [ each isAvailable ifFalse: [ each signalInitializationError ]] ] +{ #category : 'running' } +TestSuite >> shuffleSeed [ + + ^ randomGenerator seed +] + +{ #category : 'running' } +TestSuite >> shuffleSeed: aSeed [ + + randomGenerator := Random seed: aSeed +] + +{ #category : 'running' } +TestSuite >> shuffledTests [ + + ^ self tests shuffledBy: randomGenerator +] + { #category : 'running' } TestSuite >> tearDown [ self resourceClass resetResources: self resources diff --git a/src/SUnit-Tests/Package.extension.st b/src/SUnit-Tests/Package.extension.st index 910f8977bf4..0a852c8901c 100644 --- a/src/SUnit-Tests/Package.extension.st +++ b/src/SUnit-Tests/Package.extension.st @@ -4,9 +4,10 @@ Extension { #name : 'Package' } Package >> testSuite [ | suite | - - suite := TestSuite named: self packageName. - suite addTests: ((self classes select: #isTestCase) flatCollect: [:aTestClass | aTestClass suite tests]). + suite := TestSuite named: self name. + suite addTests: + ((self classes select: #isTestCase) flatCollect: [ :aTestClass | + aTestClass suite tests ]). ^ suite ] From 71dc1f464f63a4eec4ef7d88a770f7f563a57a3e Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Mon, 27 Nov 2023 13:33:24 +0100 Subject: [PATCH 2/8] Recategorise --- src/SUnit-Core/TestSuite.class.st | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/SUnit-Core/TestSuite.class.st b/src/SUnit-Core/TestSuite.class.st index bfb0ae5e515..6a486bbe913 100644 --- a/src/SUnit-Core/TestSuite.class.st +++ b/src/SUnit-Core/TestSuite.class.st @@ -72,6 +72,13 @@ TestSuite >> defaultResources [ coll] ] +{ #category : 'initialization' } +TestSuite >> initialize [ + + super initialize. + randomGenerator := Random new +] + { #category : 'accessing' } TestSuite >> name [ From 8d0e314aea1220d7bd68ea9b6c17a8758f122e14 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Mon, 27 Nov 2023 13:41:03 +0100 Subject: [PATCH 3/8] extended class comment/help --- src/JenkinsTools-Core/TestCommandLineHandler.class.st | 1 + 1 file changed, 1 insertion(+) diff --git a/src/JenkinsTools-Core/TestCommandLineHandler.class.st b/src/JenkinsTools-Core/TestCommandLineHandler.class.st index 160491fe9bf..af809c6b93b 100644 --- a/src/JenkinsTools-Core/TestCommandLineHandler.class.st +++ b/src/JenkinsTools-Core/TestCommandLineHandler.class.st @@ -7,6 +7,7 @@ Usage: test [--junit-xml-output] [--fail-on-failure] [ ...] --stage-name=aName it adds a prefix to the xml generated, this is useful when running in the CI infrastructure + --shuffle-seed an integer specifying the seed used to shuffle the tests a String matching a package name Examples: From 3602485295d86f7525352a34819e3c677cb75847 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Tue, 28 Nov 2023 12:39:57 +0100 Subject: [PATCH 4/8] Add double word support in ring and the bootstrap --- src/Kernel/Behavior.class.st | 9 ++++++++- src/PharoBootstrap/PBClassLoader.class.st | 6 ++++-- src/Ring-Core/RGBehavior.class.st | 6 ++++++ src/Ring-Core/RGDoubleWordLayout.class.st | 2 +- 4 files changed, 19 insertions(+), 4 deletions(-) diff --git a/src/Kernel/Behavior.class.st b/src/Kernel/Behavior.class.st index f386c9d4002..bf95c224f40 100644 --- a/src/Kernel/Behavior.class.st +++ b/src/Kernel/Behavior.class.st @@ -1049,6 +1049,13 @@ Behavior >> isDisabledSelector: selector [ ^ self classAndMethodFor: selector do: [:c :m | m isDisabled] ifAbsent: [false] ] +{ #category : 'testing' } +Behavior >> isDoubleWords [ + "Answer true if the receiver is made of 64-bit instance variables." + + ^self classLayout isDoubleWords +] + { #category : 'testing' } Behavior >> isEphemeronClass [ "Answer whether the receiver has ephemeral instance variables. The garbage collector will @@ -1166,7 +1173,7 @@ Behavior >> isWeak [ Behavior >> isWords [ "Answer true if the receiver is made of 32-bit instance variables." - ^self isBytes not + ^self classLayout isWords ] { #category : 'testing - class hierarchy' } diff --git a/src/PharoBootstrap/PBClassLoader.class.st b/src/PharoBootstrap/PBClassLoader.class.st index 95b09b79d95..d09bfa9d633 100644 --- a/src/PharoBootstrap/PBClassLoader.class.st +++ b/src/PharoBootstrap/PBClassLoader.class.st @@ -29,7 +29,7 @@ PBClassLoader >> classDefinitionFor: aClass [ "Answer a String that defines the receiver." | type | - type := aClass isWeak + type := type := aClass isWeak ifTrue: [ 'WeakLayout' ] ifFalse: [ aClass isPointers ifTrue: [ aClass isVariable @@ -40,7 +40,9 @@ PBClassLoader >> classDefinitionFor: aClass [ ifTrue: [ 'CompiledMethodLayout' ] ifFalse: [ aClass isWords ifTrue: [ 'WordLayout' ] - ifFalse: [ 'ByteLayout' ]]]]. + ifFalse: [ aClass isDoubleWords + ifTrue: [ 'DoubleWordLayout' ] + ifFalse: [ 'ByteLayout' ]]]]]. ^ '| newClass | newClass := ShiftClassInstaller make: [ :builder | builder diff --git a/src/Ring-Core/RGBehavior.class.st b/src/Ring-Core/RGBehavior.class.st index 60aa8a5cfe2..4d8ffab1207 100644 --- a/src/Ring-Core/RGBehavior.class.st +++ b/src/Ring-Core/RGBehavior.class.st @@ -561,6 +561,12 @@ RGBehavior >> isCompiledMethod [ ^ self layout isCompiledMethodLayout ] +{ #category : 'testing - layouts' } +RGBehavior >> isDoubleWords [ + + ^ self layout isDoubleWordLayout +] + { #category : 'testing - layouts' } RGBehavior >> isEphemeron [ diff --git a/src/Ring-Core/RGDoubleWordLayout.class.st b/src/Ring-Core/RGDoubleWordLayout.class.st index eabddc91200..3da1522f11e 100644 --- a/src/Ring-Core/RGDoubleWordLayout.class.st +++ b/src/Ring-Core/RGDoubleWordLayout.class.st @@ -10,6 +10,6 @@ Class { } { #category : 'testing' } -RGDoubleWordLayout >> isWordLayout [ +RGDoubleWordLayout >> isDoubleWordLayout [ ^ true ] From 7d7b2797a24f5f64f4261cf1f70b96cdae490a00 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Mon, 4 Dec 2023 15:35:10 +0100 Subject: [PATCH 5/8] Add double word support as RG extensions in the bootstrap --- src/PharoBootstrap/RGBehavior.extension.st | 7 +++++++ src/PharoBootstrap/RGDoubleWordLayout.extension copy.st | 7 +++++++ src/PharoBootstrap/RGDoubleWordLayout.extension.st | 7 +++++++ 3 files changed, 21 insertions(+) create mode 100644 src/PharoBootstrap/RGBehavior.extension.st create mode 100644 src/PharoBootstrap/RGDoubleWordLayout.extension copy.st create mode 100644 src/PharoBootstrap/RGDoubleWordLayout.extension.st diff --git a/src/PharoBootstrap/RGBehavior.extension.st b/src/PharoBootstrap/RGBehavior.extension.st new file mode 100644 index 00000000000..8ae37f0b658 --- /dev/null +++ b/src/PharoBootstrap/RGBehavior.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'RGBehavior' } + +{ #category : '*PharoBootstrap' } +RGBehavior >> isDoubleWords [ + + ^ self layout isDoubleWordLayout +] diff --git a/src/PharoBootstrap/RGDoubleWordLayout.extension copy.st b/src/PharoBootstrap/RGDoubleWordLayout.extension copy.st new file mode 100644 index 00000000000..a6a2023be5a --- /dev/null +++ b/src/PharoBootstrap/RGDoubleWordLayout.extension copy.st @@ -0,0 +1,7 @@ +Extension { #name : 'RGLayout' } + +{ #category : '*PharoBootstrap' } +RGLayout >> isDoubleWordLayout [ + + ^ false +] diff --git a/src/PharoBootstrap/RGDoubleWordLayout.extension.st b/src/PharoBootstrap/RGDoubleWordLayout.extension.st new file mode 100644 index 00000000000..26daacfe201 --- /dev/null +++ b/src/PharoBootstrap/RGDoubleWordLayout.extension.st @@ -0,0 +1,7 @@ +Extension { #name : 'RGDoubleWordLayout' } + +{ #category : '*PharoBootstrap' } +RGDoubleWordLayout >> isDoubleWordLayout [ + + ^ true +] From 88c223a200f95ebdcbaa81d678928d71c1f14ee5 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Mon, 4 Dec 2023 16:17:51 +0100 Subject: [PATCH 6/8] Load Random-Core for kernel tests --- bootstrap/scripts/runKernelTests.sh | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/bootstrap/scripts/runKernelTests.sh b/bootstrap/scripts/runKernelTests.sh index 9271334efcc..6dff7da6e90 100755 --- a/bootstrap/scripts/runKernelTests.sh +++ b/bootstrap/scripts/runKernelTests.sh @@ -57,7 +57,7 @@ export PHARO_CI_TESTING_ENVIRONMENT=1 ./pharo bootstrap.image #Adding packages removed from the bootstrap ./pharo bootstrap.image loadHermes Hermes-Extensions.hermes --save -./pharo bootstrap.image loadHermes Kernel-Chronology-Extras.hermes AST-Core.hermes Jobs.hermes InitializePackagesCommandLineHandler.hermes --save --no-fail-on-undeclared --on-duplication=ignore +./pharo bootstrap.image loadHermes Kernel-Chronology-Extras.hermes AST-Core.hermes Jobs.hermes InitializePackagesCommandLineHandler.hermes Random-Core.hermes --save --no-fail-on-undeclared --on-duplication=ignore #Initializing the package manager ./pharo bootstrap.image initializePackages --packages --protocols=protocolsKernel.txt --save From c714567c8c2b13fdc4d165c79b545723107ab20a Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Mon, 4 Dec 2023 20:51:16 +0100 Subject: [PATCH 7/8] Fix order of words/doublewords resolution --- src/PharoBootstrap/PBClassLoader.class.st | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/PharoBootstrap/PBClassLoader.class.st b/src/PharoBootstrap/PBClassLoader.class.st index d09bfa9d633..e66e1aa603b 100644 --- a/src/PharoBootstrap/PBClassLoader.class.st +++ b/src/PharoBootstrap/PBClassLoader.class.st @@ -38,10 +38,10 @@ PBClassLoader >> classDefinitionFor: aClass [ ] ifFalse: [ aClass isCompiledMethod ifTrue: [ 'CompiledMethodLayout' ] - ifFalse: [ aClass isWords - ifTrue: [ 'WordLayout' ] - ifFalse: [ aClass isDoubleWords - ifTrue: [ 'DoubleWordLayout' ] + ifFalse: [ aClass isDoubleWords + ifTrue: [ 'DoubleWordLayout' ] + ifFalse: [ aClass isWords + ifTrue: [ 'WordLayout' ] ifFalse: [ 'ByteLayout' ]]]]]. ^ '| newClass | newClass := ShiftClassInstaller make: [ :builder | From 0eb17ccd11a9abfa4f94c078fb7c4469275b9a00 Mon Sep 17 00:00:00 2001 From: Guille Polito Date: Tue, 5 Dec 2023 21:26:11 +0100 Subject: [PATCH 8/8] Move extension to the kernel --- src/Kernel/Number.class.st | 5 +++++ src/Math-Operations-Extensions/Number.extension.st | 7 ------- 2 files changed, 5 insertions(+), 7 deletions(-) diff --git a/src/Kernel/Number.class.st b/src/Kernel/Number.class.st index 9338164aee7..ec2cab1411a 100644 --- a/src/Kernel/Number.class.st +++ b/src/Kernel/Number.class.st @@ -726,6 +726,11 @@ Number >> storeStringBase: base [ ^ String streamContents: [:strm | self storeOn: strm base: base] ] +{ #category : 'testing' } +Number >> strictlyPositive [ + ^ self > 0 +] + { #category : 'printing' } Number >> stringForReadout [ ^ self rounded printString diff --git a/src/Math-Operations-Extensions/Number.extension.st b/src/Math-Operations-Extensions/Number.extension.st index 5c020923108..4b6c2cadd2d 100644 --- a/src/Math-Operations-Extensions/Number.extension.st +++ b/src/Math-Operations-Extensions/Number.extension.st @@ -214,13 +214,6 @@ Number >> squared [ ^self * self ] -{ #category : '*Math-Operations-Extensions' } -Number >> strictlyPositive [ - "Answer whether the receiver is mathematically positive." - - ^ self > 0 -] - { #category : '*Math-Operations-Extensions' } Number >> tan [ "The receiver represents an angle measured in radians. Answer its