Merge branch 'development' into fixes-while-updating-settings

src/Famix-MetamodelBuilder-Core/FamixMetamodelGenerator.class.st

@@ -58,6 +58,16 @@ FamixMetamodelGenerator class >> composedMetaModels [
 	^ self allSubclasses select: [ :mm | mm isAbstract not and: [ mm isComposed ] ]
 ]
 
+{ #category : #generation }
+FamixMetamodelGenerator class >> deleteMetaModel [
+	<script>
+	<ignoreForCoverage>
+
+	"Remove the package that was generated by this generator.
+	This is used to cleanup existing code and testing"
+	self packageName asPackage removeFromSystem
+]
+
 { #category : #generation }
 FamixMetamodelGenerator class >> generate [
 	<script>

src/Famix-MetamodelBuilder-Core/FmxClassRemoval.class.st

@@ -47,6 +47,12 @@ FmxClassRemoval >> classToRemove: anObject [
 	class := anObject
 ]
 
+{ #category : #testing }
+FmxClassRemoval >> isRemoval [
+
+	^ true
+]
+
 { #category : #printing }
 FmxClassRemoval >> printOn: aStream [
 

src/Famix-MetamodelBuilder-Core/FmxCodeChange.class.st

@@ -28,3 +28,9 @@ FmxCodeChange class >> isAbstract [
 FmxCodeChange >> apply [
 	self subclassResponsibility
 ]
+
+{ #category : #testing }
+FmxCodeChange >> isRemoval [
+
+	^ false
+]

src/Famix-MetamodelBuilder-Core/FmxMBRealRingEnvironment.class.st

@@ -9,8 +9,10 @@ Class {
 
 { #category : #accessing }
 FmxMBRealRingEnvironment >> apply [
+
 	self collectChangesToApply.
-	changesToApply do: #apply
+	changesToApply select: [ :e | e isRemoval ] thenDo: #apply.
+	changesToApply select: [ :e | e isRemoval not ] thenDo: #apply
 ]
 
 { #category : #testing }
@@ -41,25 +43,48 @@ FmxMBRealRingEnvironment >> compile: aSource in: aClass classified: aProtocol pa
 ]
 
 { #category : #installing }
-FmxMBRealRingEnvironment >> recordAdoptionOfClassDefinitionFrom: realClass to: anRGClass [
+FmxMBRealRingEnvironment >> recordAdoptionOfClassDefinitionFrom: currentClass to: anRGClassModel [
+
+	| currentCustomSlots currentCustomSlotNames modelSlotDefinitions currentGeneratedSlots modelGeneratedSlots slotRemovals |
+	(currentClass needToAdaptTo: anRGClassModel) ifFalse: [ ^ self ].
+
+	"We are updating a class installed in the system (currentClass) to a new representation defined in the model (anRGClass).
+	This has to be done in order to allow updating the class at run time"
+
+	currentGeneratedSlots := currentClass generatedSlots.
+	currentCustomSlots := currentClass localSlots copyWithoutAll:
+		                      currentGeneratedSlots.
+	currentCustomSlotNames := currentCustomSlots collect: #name.
+
+	modelGeneratedSlots := anRGClassModel slots reject: [ :each |
+		                       currentCustomSlotNames includes: each name ].
+
+	modelSlotDefinitions := (modelGeneratedSlots collect:
+		                         #definitionString) asOrderedCollection.
+	modelSlotDefinitions addAll:
+		(currentCustomSlots collect: #definitionString).
+	modelSlotDefinitions := modelSlotDefinitions sorted.
 
-	| customSlots customSlotNames slotDefinitions |
-	(realClass needToAdaptTo: anRGClass) ifFalse: [ ^ self ].
+	slotRemovals := currentGeneratedSlots reject: [ :e |
+		                modelGeneratedSlots anySatisfy: [ :current |
+			                current name = e name ] ].
 
-	customSlots := realClass localSlots copyWithoutAll: realClass generatedSlots.
-	customSlotNames := customSlots collect: #name.
-	slotDefinitions := ((anRGClass slots reject: [ :each | customSlotNames includes: each name ]) collect: #definitionString) asOrderedCollection.
-	slotDefinitions addAll: (customSlots collect: #definitionString).
-	slotDefinitions := slotDefinitions sorted.
+	slotRemovals ifNotEmpty: [
+		changesToApply add: (FmxSlotRemovals slots: slotRemovals) ].
 
 	self
-		recordClassAdditionFromClass: anRGClass
-		traits: (self traitStringFrom: realClass to: anRGClass)
-		slots: '{' , (slotDefinitions joinUsing: '. ') , '}'
-		classSlots: '{' , ((realClass class localSlots collect: #definitionString) joinUsing: ' . ') , '}'
-		sharedVariables: '{' , ((realClass classVarNames collect: [ :each | '#' , each ]) joinUsing: ' ') , '}'
-		package: realClass package name
-		tag: realClass packageTag name
+		recordClassAdditionFromClass: anRGClassModel
+		traits: (self traitStringFrom: currentClass to: anRGClassModel)
+		slots: '{' , (modelSlotDefinitions joinUsing: '. ') , '}'
+		classSlots:
+			'{' , ((currentClass class localSlots collect: #definitionString)
+				 joinUsing: ' . ') , '}'
+		sharedVariables:
+			'{'
+			, ((currentClass classVarNames collect: [ :each | '#' , each ])
+					 joinUsing: ' ') , '}'
+		package: currentClass package name
+		tag: currentClass packageTag name
 ]
 
 { #category : #installing }

src/Famix-MetamodelBuilder-Core/FmxMethodRemovals.class.st

@@ -41,6 +41,12 @@ FmxMethodRemovals >> apply [
 	self selectors do: [ :selector | class removeSelector: selector ]
 ]
 
+{ #category : #testing }
+FmxMethodRemovals >> isRemoval [
+
+	^ true
+]
+
 { #category : #accessing }
 FmxMethodRemovals >> selectors [
 	^ selectors

src/Famix-MetamodelBuilder-Core/FmxSlotRemovals.class.st

@@ -0,0 +1,47 @@
+"
+Description
+--------------------
+
+I represent a the removal of slots from a class when updating an already generated metamodel.
+
+"
+Class {
+	#name : #FmxSlotRemovals,
+	#superclass : #FmxCodeChange,
+	#instVars : [
+		'slots'
+	],
+	#category : #'Famix-MetamodelBuilder-Core-Changes'
+}
+
+{ #category : #'as yet unclassified' }
+FmxSlotRemovals class >> slots: aCollection [
+
+	^ self new
+		  slots: aCollection;
+		  yourself
+]
+
+{ #category : #accessing }
+FmxSlotRemovals >> apply [
+
+	slots do: [ :e | e owningClass removeInstVarNamed: e name  ]
+]
+
+{ #category : #testing }
+FmxSlotRemovals >> isRemoval [
+
+	^ true
+]
+
+{ #category : #accessing }
+FmxSlotRemovals >> slots [
+
+	^ slots
+]
+
+{ #category : #accessing }
+FmxSlotRemovals >> slots: anObject [
+
+	slots := anObject
+]

src/Famix-TestGenerators/FamixTest9BisGenerator.class.st

@@ -0,0 +1,24 @@
+Class {
+	#name : #FamixTest9BisGenerator,
+	#superclass : #FamixTest9Generator,
+	#category : #'Famix-TestGenerators'
+}
+
+{ #category : #accessing }
+FamixTest9BisGenerator class >> packageName [
+
+	^ #'Famix-Test9-Entities'
+]
+
+{ #category : #accessing }
+FamixTest9BisGenerator class >> prefix [
+
+	^ #'FamixTest9'
+]
+
+{ #category : #definition }
+FamixTest9BisGenerator >> defineRelations [
+
+	"Here everything is the same except for the entities on the relation"
+	subclass *- superclass
+]

src/Famix-TestGenerators/FamixTest9Generator.class.st

@@ -0,0 +1,47 @@
+Class {
+	#name : #FamixTest9Generator,
+	#superclass : #FamixBasicInfrastructureGenerator,
+	#instVars : [
+		'superclass',
+		'subclass'
+	],
+	#category : #'Famix-TestGenerators'
+}
+
+{ #category : #accessing }
+FamixTest9Generator class >> packageName [
+
+	^ #'Famix-Test9-Entities'
+]
+
+{ #category : #accessing }
+FamixTest9Generator class >> prefix [
+
+	^ #'FamixTest9'
+]
+
+{ #category : #testing }
+FamixTest9Generator class >> shouldBeUpToDateInLatestMoose [
+
+	"This generator is used dynamically by the tests"
+	^ false
+]
+
+{ #category : #definition }
+FamixTest9Generator >> defineClasses [
+
+	superclass := self builder newClassNamed: #MySuperclass.
+	subclass := self builder newClassNamed: #MySubclass
+]
+
+{ #category : #definition }
+FamixTest9Generator >> defineHierarchy [
+
+	subclass --|> superclass
+]
+
+{ #category : #definition }
+FamixTest9Generator >> defineRelations [
+
+	subclass *- subclass
+]

src/Famix-Traits/FamixTAssociation.trait.st

@@ -92,6 +92,14 @@ FamixTAssociation >> asAssociationTo: anEntity [
 	^ self
 ]
 
+{ #category : #printing }
+FamixTAssociation >> displayFullStringOn: aStream [
+
+	self source displayFullStringOn: aStream.
+	aStream nextPutAll: ' -> '.
+	self target displayFullStringOn: aStream
+]
+
 { #category : #printing }
 FamixTAssociation >> displayStringOn: aStream [
 

src/Famix-Traits/FamixTInvocation.trait.st

@@ -96,6 +96,23 @@ FamixTInvocation >> candidates: anObject [
 	candidates value: anObject
 ]
 
+{ #category : #printing }
+FamixTInvocation >> displayFullStringOn: aStream [
+
+	self sender
+		ifNotNil: [ self sender displayFullStringOn: aStream ]
+		ifNil: [ aStream nextPut: $? ].
+	aStream nextPutAll: ' -> '.
+	self receiver
+		ifNotNil: [ :rcvr | self receiver displayFullStringOn: aStream ]
+		ifNil: [ aStream nextPut: $? ].
+	aStream nextPutAll: '.'.
+
+	self signature
+		ifNotNil: [ aStream nextPutAll: (self signature truncateWithElipsisTo: 40) ]
+		ifNil: [ aStream nextPutAll: ' ? ' ]
+]
+
 { #category : #printing }
 FamixTInvocation >> displayStringOn: aStream [
 

src/Moose-Core/MooseAbstractGroup.class.st

@@ -253,6 +253,13 @@ MooseAbstractGroup >> collectAsSet: aBlock [
 	^ self entities collectAsSet: aBlock
 ]
 
+{ #category : #enumerating }
+MooseAbstractGroup >> collectWithIndex: aBlock [
+
+	^ self entities
+		collectWithIndex:  aBlock
+]
+
 { #category : #accessing }
 MooseAbstractGroup >> commonSuperclass [ 
 	^ self entityStorage commonSuperclass
@@ -301,12 +308,29 @@ MooseAbstractGroup >> detect: aBlock ifFound: anotherBlock [
 	^ self entities detect: aBlock ifFound: anotherBlock
 ]
 
+{ #category : #enumerating }
+MooseAbstractGroup >> detect: aBlock ifFound: foundBlock ifNone: noneBlock [
+
+	^ self entities 
+		detect:  aBlock
+		ifFound: foundBlock
+		ifNone:  noneBlock
+]
+
 { #category : #enumerating }
 MooseAbstractGroup >> detect: aBlock ifNone: anotherBlock [
 
 	^ self entities detect: aBlock ifNone: anotherBlock
 ]
 
+{ #category : #enumerating }
+MooseAbstractGroup >> detect: aBlock ifOne: anotherBlock [
+
+	^ self entities
+		detect: aBlock
+		ifOne:  anotherBlock
+]
+
 { #category : #enumerating }
 MooseAbstractGroup >> detectMax: aString [
 

src/Moose-Core/MooseObject.class.st

@@ -288,6 +288,18 @@ MooseObject >> description: text [
 	self attributeAt: #privateDescription put: text
 ]
 
+{ #category : #printing }
+MooseObject >> displayFullString [
+	"Return a name corresponding to the moose name but also for the associations instead of returning #noname"
+
+	^ String streamContents: [ :stream | self displayFullStringOn: stream ]
+]
+
+{ #category : #printing }
+MooseObject >> displayFullStringOn: aStream [
+	self mooseNameOn: aStream
+]
+
 { #category : #printing }
 MooseObject >> displayStringOn: aStream [
 	self mooseNameOn: aStream

src/Moose-SmalltalkImporter-Core-Tests/FamixReferenceModelImporterTest.class.st

@@ -392,6 +392,15 @@ FamixReferenceModelImporterTest >> testConstantMethodAnnotation [
 	self assert: method isConstant
 ]
 
+{ #category : #tests }
+FamixReferenceModelImporterTest >> testDisplayFullString [
+	"Smoke test for #displayFullString"
+
+	self shouldnt: [ self model entities do: [ :entity | entity displayFullString ] ] raise: Error.
+
+	self assertEmpty: ((self model entities select: [ :entity | entity isAssociation ]) select: [ :asso | asso displayFullString = #noname ])
+]
+
 { #category : #tests }
 FamixReferenceModelImporterTest >> testExtendedClasses [
 	| subRootModelTwo p1 p2 subRootModelThree extensionMethod |