Merge pull request pharo-project#9 from hogoww/master

[improvement] move mutant execution logic to be able to rerun it

src/MuTalk-Model/MethodMutation.class.st

@@ -7,9 +7,10 @@ Class {
 		'operator',
 		'originalClass',
 		'mutatedNode',
-		'nodeToMutate'
+		'nodeToMutate',
+		'testCaseReferences'
 	],
-	#category : 'MuTalk-Model'
+	#category : #'MuTalk-Model'
 }
 
 { #category : #'instance creation' }
@@ -125,6 +126,33 @@ MethodMutation >> printOn: aStream [
 		nextPutAll: originalMethod  selector printString.
 ]
 
+{ #category : #running }
+MethodMutation >> runMutant [
+
+	^ [ 
+		self install.
+		self runTests
+	] ensure: [ self uninstall ]
+]
+
+{ #category : #private }
+MethodMutation >> runTests [
+	| results |
+	results := TestAsserter classForTestResult new.
+	testCaseReferences collect: [ :tcr | results addAllResults: tcr runUnchecked ].
+	^ results
+]
+
+{ #category : #private }
+MethodMutation >> testCaseReferences [
+	^ testCaseReferences
+]
+
+{ #category : #private }
+MethodMutation >> testCaseReferences: aCollectionOfTestCaseReferences [
+	testCaseReferences := aCollectionOfTestCaseReferences
+]
+
 { #category : #installing }
 MethodMutation >> uninstall [
 	"UnInstall the mutant recompiling the original method into the class."

src/MuTalk-Model/MutantEvaluation.class.st

@@ -81,13 +81,11 @@ MutantEvaluation >> testResults [
 { #category : #evaluation }
 MutantEvaluation >> value [
 	| testResults |
-
 	Stdio stdout nextPutAll: mutation originalMethod name asString; lf; flush.
 
 	self initializeCoverageResultIfNil.
-	testResults := [ mutation install.
-	self testResults ]
-		ensure: [ mutation uninstall ].
+	mutation testCaseReferences: (strategy testCasesToEvaluate: mutation for: self).
+	testResults := mutation runMutant.
 	^ MutantEvaluationResult
 		for: mutation
 		results: testResults

src/MuTalk-Model/MutationTestingAnalysis.class.st

@@ -260,7 +260,7 @@ MutationTestingAnalysis >> run [
 	methods of
 	those classes) and execute all mutants in the set of testClases.
 	We obtain a result for each mutant generated"
-	^[testCases do: [ :aTestCase | aTestCase run ].
+	^[testCases do: [ :aTestCase | aTestCase runChecked ].
 	logger logAnalysisStartFor:self.
 	elapsedTime := Time millisecondsToRun: [
 					self generateCoverageAnalysis.

src/MuTalk-Model/TestCaseReference.class.st

@@ -5,7 +5,7 @@ Class {
 		'class',
 		'selector'
 	],
-	#category : 'MuTalk-Model'
+	#category : #'MuTalk-Model'
 }
 
 { #category : #'instance creation' }
@@ -31,18 +31,31 @@ TestCaseReference >> resources [
 
 { #category : #evaluating }
 TestCaseReference >> run [
-	| result |
-	result := self testCase run.
-	(result failuresSize > 0 or: [ result errorsSize > 0])
-		ifTrue: [TestsWithErrorsException signal].
-	^ result
+	"kept for retrocompatibility"
+
+	self deprecated: 'Use #runChecked instead.' transformWith: '`@receiver run' -> '`@receiver runChecked'.
+	^ self runChecked
 ]
 
 { #category : #evaluating }
 TestCaseReference >> run: aTestResult [
 	^self testCase run: aTestResult
 ]
 
+{ #category : #evaluating }
+TestCaseReference >> runChecked [
+	| result |	
+	result := self testCase run.
+	(result failuresSize > 0 or: [ result errorsSize > 0 ])
+		ifTrue: [ TestsWithErrorsException signalFor: self ].
+	^ result
+]
+
+{ #category : #evaluating }
+TestCaseReference >> runUnchecked [
+	^ self testCase run
+]
+
 { #category : #evaluating }
 TestCaseReference >> testCase [
 	^class selector: selector.

src/MuTalk-Model/TestResult.extension.st

@@ -1,5 +1,14 @@
 Extension { #name : #TestResult }
 
+{ #category : #'*MuTalk-Model' }
+TestResult >> addAllResults: aTestResult [
+
+	failures addAll: aTestResult failures.
+	errors addAll: aTestResult errors.
+	passed addAll: aTestResult passed.
+	skipped addAll: aTestResult skipped.
+]
+
 { #category : #'*MuTalk-Model' }
 TestResult >> concreteErrors [
     ^ errors

src/MuTalk-Tests/MethodInstallerTest.class.st

@@ -5,7 +5,7 @@ Class {
 		'anonymousClass',
 		'anonymousClassWithMethod'
 	],
-	#category : 'MuTalk-Tests'
+	#category : #'MuTalk-Tests'
 }
 
 { #category : #accessing }
@@ -20,7 +20,7 @@ MethodInstallerTest >> methodInstalled [
 
 ]
 
-{ #category : #'test resources' }
+{ #category : #'as yet unclassified' }
 MethodInstallerTest >> methodToUninstall [ ^self
 ]
 

src/MuTalk-Tests/MethodMutationTest.class.st

@@ -1,9 +1,14 @@
 Class {
 	#name : #MethodMutationTest,
 	#superclass : #TestCase,
-	#category : 'MuTalk-Tests'
+	#category : #'MuTalk-Tests'
 }
 
+{ #category : #tests }
+MethodMutationTest >> simpleTestCaseRessource [
+	self assert: 1 + 1 equals: 2
+]
+
 { #category : #'testing accessing' }
 MethodMutationTest >> testAccessing [
 	| compiledMethod operator modifiedSource methodMutation |
@@ -52,3 +57,23 @@ MethodMutationTest >> testMutatedNodeBugFix [
 	self shouldnt: [ m mutatedNode ] raise:  SubscriptOutOfBounds 
 
 ]
+
+{ #category : #tests }
+MethodMutationTest >> testMutationRun [
+	| compiledMethod operator modifiedSource methodMutation res |
+	compiledMethod := AuxiliarClassForMutationTestingAnalysis
+		>> #methodWithOnePlusSender.
+	operator := ReplacePlusWithMinusMutantOperator new.
+	modifiedSource := operator
+		modifiedSourceFor: compiledMethod
+		number: 1.
+	methodMutation := MethodMutation
+		for: compiledMethod
+		using: operator
+		result: modifiedSource
+		ofClass: AuxiliarClassForMutationTestingAnalysis.
+	methodMutation testCaseReferences: { TestCaseReference for: #simpleTestCaseRessource in: self class }.
+	res := methodMutation runMutant.
+
+	self assert: res runCount equals: 1.
+]

src/MuTalk-Tests/TestCaseReferenceTest.class.st

@@ -1,7 +1,7 @@
 Class {
 	#name : #TestCaseReferenceTest,
 	#superclass : #TestCase,
-	#category : 'MuTalk-Tests'
+	#category : #'MuTalk-Tests'
 }
 
 { #category : #resources }
@@ -13,7 +13,7 @@ TestCaseReferenceTest >> test1 [
 TestCaseReferenceTest >> testATestReferenceResult [
 	| testReference |
 	testReference := self testReferenceForTest1.
-	self assert: testReference run errors isEmpty.
+	self assert: testReference runUnchecked errors isEmpty.
 
 ]