Merge pull request #15581 from guillep/shuffle-tests

Shuffle tests

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

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."

src/JenkinsTools-Core/TestCommandLineHandler.class.st

@@ -7,6 +7,7 @@ Usage: test [--junit-xml-output] [--fail-on-failure] [<package> ...]
 	--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
 	 <package>            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' ]
 ]

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 : 'accessing - method dictionary' }

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

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

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

src/PharoBootstrap/RGBehavior.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : 'RGBehavior' }
+
+{ #category : '*PharoBootstrap' }
+RGBehavior >> isDoubleWords [ 
+
+	^ self layout isDoubleWordLayout
+]

src/PharoBootstrap/RGDoubleWordLayout.extension copy.st

@@ -0,0 +1,7 @@
+Extension { #name : 'RGLayout' }
+
+{ #category : '*PharoBootstrap' }
+RGLayout >> isDoubleWordLayout [ 
+
+	^ false
+]

src/PharoBootstrap/RGDoubleWordLayout.extension.st

@@ -0,0 +1,7 @@
+Extension { #name : 'RGDoubleWordLayout' }
+
+{ #category : '*PharoBootstrap' }
+RGDoubleWordLayout >> isDoubleWordLayout [ 
+
+	^ true
+]

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
+]

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 [
 

src/Ring-Core/RGDoubleWordLayout.class.st

@@ -10,6 +10,6 @@ Class {
 }
 
 { #category : 'testing' }
-RGDoubleWordLayout >> isWordLayout [
+RGDoubleWordLayout >> isDoubleWordLayout [
 	^ true
 ]

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

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
 ]