diff --git a/bootstrap/scripts/runKernelTests.sh b/bootstrap/scripts/runKernelTests.sh index 577f8bb7e8a..212c8436a40 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 InitializePackagesCommandLineHandler.hermes --save --no-fail-on-undeclared --on-duplication=ignore +./pharo bootstrap.image loadHermes Kernel-Chronology-Extras.hermes AST-Core.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 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..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: @@ -130,13 +131,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/Kernel-CodeModel/Behavior.class.st b/src/Kernel-CodeModel/Behavior.class.st index a77dbeb0d31..0a1364fd19d 100644 --- a/src/Kernel-CodeModel/Behavior.class.st +++ b/src/Kernel-CodeModel/Behavior.class.st @@ -1043,6 +1043,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 @@ -1160,7 +1167,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/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 diff --git a/src/PharoBootstrap/PBClassLoader.class.st b/src/PharoBootstrap/PBClassLoader.class.st index 95b09b79d95..e66e1aa603b 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 @@ -38,9 +38,11 @@ PBClassLoader >> classDefinitionFor: aClass [ ] ifFalse: [ aClass isCompiledMethod ifTrue: [ 'CompiledMethodLayout' ] - ifFalse: [ aClass isWords - ifTrue: [ 'WordLayout' ] - ifFalse: [ 'ByteLayout' ]]]]. + ifFalse: [ aClass isDoubleWords + ifTrue: [ 'DoubleWordLayout' ] + ifFalse: [ aClass isWords + ifTrue: [ 'WordLayout' ] + ifFalse: [ 'ByteLayout' ]]]]]. ^ '| newClass | newClass := ShiftClassInstaller make: [ :builder | builder 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 +] 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/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 ] diff --git a/src/SUnit-Core/TestSuite.class.st b/src/SUnit-Core/TestSuite.class.st index b075880f7a1..6a486bbe913 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' } @@ -85,6 +72,13 @@ TestSuite >> defaultResources [ coll] ] +{ #category : 'initialization' } +TestSuite >> initialize [ + + super initialize. + randomGenerator := Random new +] + { #category : 'accessing' } TestSuite >> name [ @@ -97,12 +91,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 +126,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 +148,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 ]