Merge pull request #116 from DurieuxPol/enh/methods

Analysis uses methods instead of classes & extension methods are ignored if not from package

src/BaselineOfMuTalk/BaselineOfMuTalk.class.st

@@ -14,16 +14,17 @@ BaselineOfMuTalk >> baseline: spec [
 		   package: 'TestCoverage';
 			package: 'MuTalk-Model' with: [ spec requires: #( 'TestCoverage' ) ];
 			package: 'MuTalk-TestResources' with: [ spec requires: #( 'MuTalk-Model' ) ];
+			package: 'MuTalk-TestResourcesForExtensionMethods' with: [ spec requires: #( 'MuTalk-Model' 'MuTalk-TestResources' ) ];
 			package: 'MuTalk-CI' with: [ spec requires: #( 'MuTalk-Model' ) ];
 			package: 'MuTalk-CI-Tests' with: [ spec requires: #( 'MuTalk-Model' 'MuTalk-CI' ) ];
-			package: 'MuTalk-Tests' with: [ spec requires: #( 'MuTalk-Model' 'MuTalk-TestResources' ) ];
+			package: 'MuTalk-Tests' with: [ spec requires: #( 'MuTalk-Model' 'MuTalk-TestResources' 'MuTalk-TestResourcesForExtensionMethods') ];
 			package: 'MuTalk-SpecUI' with: [ spec requires: #('MuTalk-Model') ];
 			package: 'MuTalk-Utilities' with: [ spec requires: #( 'MuTalk-Model' ) ];
 			package: 'MuTalk-Utilities-Tests' with: [ spec requires: #( 'MuTalk-Model' 'MuTalk-Utilities' ) ].
 
 		spec
 			group: 'default'
 			with:
-				#( 'TestCoverage' 'MuTalk-Model' 'MuTalk-TestResources' 'MuTalk-Tests'
+				#( 'TestCoverage' 'MuTalk-Model' 'MuTalk-TestResources' 'MuTalk-TestResourcesForExtensionMethods' 'MuTalk-Tests'
 				   'MuTalk-CI' 'MuTalk-CI-Tests' 'MuTalk-SpecUI' 'MuTalk-Utilities' 'MuTalk-Utilities-Tests' ) ]
 ]

src/MuTalk-Model/MTAllMutantGenerationStrategy.class.st

@@ -7,20 +7,7 @@ Class {
 }
 
 { #category : 'generating' }
-MTAllMutantGenerationStrategy >> classesAndMetaclassesFrom: modelClasses [ 
-	^ modelClasses
-		inject: OrderedCollection new
-		into: [:classes :aClass | 
-			classes add: aClass;
-				 add: aClass class.
-			classes]
-]
+MTAllMutantGenerationStrategy >> methodsToMutateFrom: aMutationTestingAnalysis [
 
-{ #category : 'generating' }
-MTAllMutantGenerationStrategy >> methodsToMutateFrom: aMutationTestingAnalysis [ 
-	^ (self classesAndMetaclassesFrom: aMutationTestingAnalysis modelClasses)
-		inject: OrderedCollection new
-		into: [:methods :aClass | 
-			methods addAll: aClass methods.
-			methods]
+	^ aMutationTestingAnalysis methodsToMutate
 ]

src/MuTalk-Model/MTAnalysis.class.st

@@ -2,7 +2,7 @@ Class {
 	#name : 'MTAnalysis',
 	#superclass : 'Object',
 	#instVars : [
-		'modelClasses',
+		'methodsToMutate',
 		'operators',
 		'elapsedTime',
 		'mutations',
@@ -34,9 +34,14 @@ MTAnalysis >> budget: anObject [
 ]
 
 { #category : 'accessing' }
-MTAnalysis >> classesToMutate: anObject [
+MTAnalysis >> classesToMutate: aClassCollection [
 
-	modelClasses := anObject
+	methodsToMutate := aClassCollection flatCollect: [ :class |
+		                   | methods |
+		                   methods := class package methodsForClass: class.
+		                   methods addAll:
+			                   (class package methodsForClass: class class).
+		                   methods ]
 ]
 
 { #category : 'accessing' }
@@ -115,7 +120,7 @@ MTAnalysis >> generateCoverageAnalysis [
 
 	logger logStartCoverageAnalysis.
 	coverageAnalysisResult := (MTCoverageAnalysis
-		                           for: self modelClasses
+		                           for: methodsToMutate
 		                           running: testCases)
 		                          run;
 		                          result
@@ -193,13 +198,24 @@ MTAnalysis >> logger: anObject [
 	logger := anObject
 ]
 
+{ #category : 'accessing' }
+MTAnalysis >> methodsToMutate [
+
+	^ methodsToMutate
+]
+
+{ #category : 'accessing' }
+MTAnalysis >> methodsToMutate: anObject [
+
+	methodsToMutate := anObject
+]
+
 { #category : 'accessing' }
 MTAnalysis >> modelClasses [
-	"Filter tests and testsResources"
 
-	^ modelClasses reject: [ :class |
-		  self testBaseClasses anySatisfy: [ :classToFilter |
-			  class includesBehavior: classToFilter ] ]
+	| classes |
+	classes := methodsToMutate collect: #methodClass.
+	^ classes copyWithoutDuplicates
 ]
 
 { #category : 'accessing' }
@@ -254,8 +270,8 @@ MTAnalysis >> operators: anObject [
 { #category : 'accessing' }
 MTAnalysis >> packagesToMutate: aCollectionOfPackages [
 
-	modelClasses := aCollectionOfPackages flatCollect: [ :packageName |
-		                packageName asPackage definedClasses ]
+	methodsToMutate := aCollectionOfPackages flatCollect: [ :packageName |
+		                   packageName asPackage methods ]
 ]
 
 { #category : 'computing' }

src/MuTalk-Model/MTCoverageAnalysis.class.st

@@ -2,21 +2,38 @@ Class {
 	#name : 'MTCoverageAnalysis',
 	#superclass : 'Object',
 	#instVars : [
-		'classes',
 		'result',
-		'classesAndMetaclasses',
 		'testCases',
 		'currentTest',
-		'testRunningElapsedTime'
+		'testRunningElapsedTime',
+		'methods'
 	],
 	#category : 'MuTalk-Model-Coverage',
 	#package : 'MuTalk-Model',
 	#tag : 'Coverage'
 }
 
 { #category : 'instance creation' }
-MTCoverageAnalysis class >> for: aCollectionOfClasses running: aCollectionOfTestCases [
-	^self new initializeFor: aCollectionOfClasses running: aCollectionOfTestCases
+MTCoverageAnalysis class >> for: aCollectionOfMethods running: aCollectionOfTestCases [
+
+	^ self new
+		  initializeFor: aCollectionOfMethods
+		  running: aCollectionOfTestCases
+]
+
+{ #category : 'instance creation' }
+MTCoverageAnalysis class >> forClasses: aCollectionOfClasses running: aCollectionOfTestCases [
+
+	| methodCollection |
+	methodCollection := aCollectionOfClasses flatCollect: [ :class |
+		                    | methods |
+		                    methods := class package methodsForClass: class.
+		                    methods addAll:
+			                    (class package methodsForClass: class class).
+		                    methods ].
+	^ self new
+		  initializeFor: methodCollection
+		  running: aCollectionOfTestCases
 ]
 
 { #category : 'private' }
@@ -28,15 +45,6 @@ MTCoverageAnalysis >> addTestsFrom: aWrapper to: methodToTestDictionary [
 				addAll: aWrapper tests]
 ]
 
-{ #category : 'private' }
-MTCoverageAnalysis >> classesAndMetaclasses [
-	classesAndMetaclasses isNil ifTrue:[
-		classesAndMetaclasses := (classes collect:[:aClass | aClass class]) asOrderedCollection.
-		classesAndMetaclasses addAll: classes.].
-	^classesAndMetaclasses.
-
-]
-
 { #category : 'accessing' }
 MTCoverageAnalysis >> currentTest [
 	^ currentTest 
@@ -54,8 +62,9 @@ MTCoverageAnalysis >> flushMethodLookupCaches [
 ]
 
 { #category : 'initialize-release' }
-MTCoverageAnalysis >> initializeFor: aCollectionOfClasses running: aCollectionOfTestCases [ 
-	classes := aCollectionOfClasses. 
+MTCoverageAnalysis >> initializeFor: aCollectionOfMethods running: aCollectionOfTestCases [
+
+	methods := aCollectionOfMethods.
 	testCases := aCollectionOfTestCases
 ]
 
@@ -66,13 +75,11 @@ MTCoverageAnalysis >> installAll: wrappers [
 
 { #category : 'private' }
 MTCoverageAnalysis >> methodReferences [
-	^ self classesAndMetaclasses
-		inject: OrderedCollection new
-		into: [:methodReferences :aClass | 
-			methodReferences
-				addAll: (aClass selectors
-						collect: [:aSelector | RGMethodDefinition class: aClass selector: aSelector]).
-			methodReferences]
+
+	^ methods collect: [ :aMethod |
+		  RGMethodDefinition
+			  class: aMethod methodClass
+			  selector: aMethod selector ]
 ]
 
 { #category : 'private' }
@@ -104,7 +111,7 @@ MTCoverageAnalysis >> run [
 	result := MTCoverageAnalysisResult
 		          from: (self methodToTestDictionaryFrom: wrappers)
 		          elapsedTime: testRunningElapsedTime.
-	result methodReferences: (self classesAndMetaclasses flatCollect: [:cls | cls methods])
+	result methodReferences: methods
 ]
 
 { #category : 'private' }

src/MuTalk-Model/MTMutantEvaluation.class.st

@@ -37,11 +37,16 @@ MTMutantEvaluation >> coverageAnalysisResult [
 
 { #category : 'initialize-release' }
 MTMutantEvaluation >> initializeCoverageResultIfNil [
-	coverageAnalysisResult 
-		ifNil:[ |coverageAnalysis|
-				coverageAnalysis := MTCoverageAnalysis for: (OrderedCollection with: mutation originalClass)
-															 running: testCases. 
-				coverageAnalysisResult := coverageAnalysis run;result].
+
+	coverageAnalysisResult ifNil: [
+		| coverageAnalysis |
+		coverageAnalysis := MTCoverageAnalysis
+			                    forClasses:
+			                    (OrderedCollection with: mutation originalClass)
+			                    running: testCases.
+		coverageAnalysisResult := coverageAnalysis
+			                          run;
+			                          result ]
 ]
 
 { #category : 'initialize-release' }

src/MuTalk-TestResources/MTAuxiliarClassForAnalysisWithExtensionMethods.class.st

@@ -0,0 +1,6 @@
+Class {
+	#name : 'MTAuxiliarClassForAnalysisWithExtensionMethods',
+	#superclass : 'Object',
+	#category : 'MuTalk-TestResources',
+	#package : 'MuTalk-TestResources'
+}

src/MuTalk-TestResourcesForExtensionMethods/MTAuxiliarClassForAnalysisWithExtensionMethods.extension.st

@@ -0,0 +1,5 @@
+Extension { #name : 'MTAuxiliarClassForAnalysisWithExtensionMethods' }
+
+{ #category : '*MuTalk-TestResourcesForExtensionMethods' }
+MTAuxiliarClassForAnalysisWithExtensionMethods >> extensionMethod [
+]

src/MuTalk-TestResourcesForExtensionMethods/package.st

@@ -0,0 +1 @@
+Package { #name : 'MuTalk-TestResourcesForExtensionMethods' }

src/MuTalk-Tests/MTAnalysisTest.class.st

@@ -288,6 +288,32 @@ MTAnalysisTest >> testExecutingTwoMutations [
 	self assert: generalResult numberOfKilledMutants equals: 2
 ]
 
+{ #category : 'tests' }
+MTAnalysisTest >> testExtensionMethodsMutatedWhenUsingPackages [
+
+	| analysis mutations selectors |
+	analysis := MTAnalysis new packagesToMutate:
+		            { 'MuTalk-TestResourcesForExtensionMethods' }.
+	mutations := analysis generateMutations.
+	selectors := mutations collect: [ :mutant |
+		             mutant originalMethod selector ].
+
+	self assert: (selectors includes: #extensionMethod)
+]
+
+{ #category : 'tests' }
+MTAnalysisTest >> testExtensionMethodsNotMutatedWhenUsingClasses [
+
+	| analysis mutations selectors |
+	analysis := MTAnalysis new classesToMutate:
+		            { MTAuxiliarClassForAnalysisWithExtensionMethods }.
+	mutations := analysis generateMutations.
+	selectors := mutations collect: [ :mutant |
+		             mutant originalMethod selector ].
+
+	self deny: (selectors includes: #extensionMethod)
+]
+
 { #category : 'tests' }
 MTAnalysisTest >> testRunningAllTests [
 	"This test verify that the test evaluation keeps running even after the first error, if specified"

src/MuTalk-Tests/MTTestCoverageAnalysis.class.st

@@ -8,24 +8,28 @@ Class {
 { #category : 'testing' }
 MTTestCoverageAnalysis >> testBugWhenHavingATestResourceSendingToOther [
 	"the problem was when sending from a resource a message to another object wich class is going to be considered for coverage"
-	| analysis testCases|
+
+	| analysis testCases |
 	analysis := MTCoverageAnalysis
-		for: (Array with: MTClassForTestingCoverage with:MTTestResourceClassForTestingCoverage)
-		running: MTTestClassForTestingCoverage suite tests.
+		            forClasses: (Array
+				             with: MTClassForTestingCoverage
+				             with: MTTestResourceClassForTestingCoverage)
+		            running: MTTestClassForTestingCoverage suite tests.
 	analysis run.
-	testCases := analysis result testCasesThatCovers: MTClassForTestingCoverage class >> #aClassCoveredMethod.
-
-	self assert: ((testCases collect: [:each | each selector]) includes:#testCaseThatCoversAClassMethod).
-
+	testCases := analysis result testCasesThatCovers:
+		             MTClassForTestingCoverage class >> #aClassCoveredMethod.
 
+	self assert:
+		((testCases collect: [ :each | each selector ]) includes:
+			 #testCaseThatCoversAClassMethod)
 ]
 
 { #category : 'testing' }
 MTTestCoverageAnalysis >> testCoveredMethods [
 
 	| analysis |
 	analysis := MTCoverageAnalysis
-		            for: (Array with: MTClassForTestingCoverage)
+		            forClasses: (Array with: MTClassForTestingCoverage)
 		            running: MTTestClassForTestingCoverage suite tests.
 	analysis run.
 
@@ -43,27 +47,32 @@ MTTestCoverageAnalysis >> testCoveredMethods [
 
 { #category : 'testing' }
 MTTestCoverageAnalysis >> testGettingTheTestCasesThatCoverAClassMethod [
-	| analysis testCases|
+
+	| analysis testCases |
 	analysis := MTCoverageAnalysis
-		for: (Array with: MTClassForTestingCoverage)
-		running: MTTestClassForTestingCoverage suite tests.
+		            forClasses: (Array with: MTClassForTestingCoverage)
+		            running: MTTestClassForTestingCoverage suite tests.
 	analysis run.
-	testCases := analysis result testCasesThatCovers: MTClassForTestingCoverage class >> #aClassCoveredMethod.
-
-	self assert: ((testCases collect: [:each | each selector]) includes:#testCaseThatCoversAClassMethod).
-
+	testCases := analysis result testCasesThatCovers:
+		             MTClassForTestingCoverage class >> #aClassCoveredMethod.
 
+	self assert:
+		((testCases collect: [ :each | each selector ]) includes:
+			 #testCaseThatCoversAClassMethod)
 ]
 
 { #category : 'testing' }
 MTTestCoverageAnalysis >> testGettingTheTestCasesThatCoverAMethod [
-	| analysis testCases|
 
-	analysis := MTCoverageAnalysis 
-		for: (Array with: MTClassForTestingCoverage)
-		running: MTTestClassForTestingCoverage suite tests.
+	| analysis testCases |
+	analysis := MTCoverageAnalysis
+		            forClasses: (Array with: MTClassForTestingCoverage)
+		            running: MTTestClassForTestingCoverage suite tests.
 	analysis run.
-	testCases := analysis result testCasesThatCovers: MTClassForTestingCoverage >> #aCoveredMethod.
-	self assert: ((testCases collect: [:each | each selector]) includes:#testCase1).
-	self deny: ((testCases collect: [:each | each selector]) includes:#testCase3).
+	testCases := analysis result testCasesThatCovers:
+		             MTClassForTestingCoverage >> #aCoveredMethod.
+	self assert:
+		((testCases collect: [ :each | each selector ]) includes: #testCase1).
+	self deny:
+		((testCases collect: [ :each | each selector ]) includes: #testCase3)
 ]

src/MuTalk-Utilities-Tests/MTNonMutatedMethodsAnalysisTest.class.st

@@ -8,13 +8,15 @@ Class {
 { #category : 'tests' }
 MTNonMutatedMethodsAnalysisTest >> testNonMutatedMethods [
 
-	| results |
-	results := (MTNonMutatedMethodsAnalysis forClasses: {
-			            MTAuxiliarClassForMatrix.
-			            MTAuxiliarClassForMatrixTest })
-		           methodsWithoutMutation asSet.
+	| analysis results |
+	analysis := (MTNonMutatedMethodsAnalysis forClasses:
+		             { MTAuxiliarClassForMatrix }) initializeMtAnalysis.
+	analysis mtAnalysis operators: {
+			MTReplacePlusWithMinusMutantOperator new.
+			MTReplaceMinusWithPlusMutantOperator new }.
+	results := analysis methodsWithoutMutation asSet.
 
-	self
-		assert: results
-		equals: MTAuxiliarClassForMatrixTest methods asSet
+	self assert: results equals: {
+			(MTAuxiliarClassForMatrix >> #initialize).
+			(MTAuxiliarClassForMatrix >> #reset) } asSet
 ]