Shuffle tests

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