Fix class generation

Fame has a code generator based on the refactoring model. But the way to generate classes evolved in Pharo 12 to go from class definitions as string to the use of the ShiftClassBuilder. This adds a compatibility to P12 about that and also rename some things to go from the #category name to #package
moosetechnology · Dec 19, 2023 · 02fecae · 02fecae
1 parent 5ed3143
commit 02fecae
Show file tree

Hide file tree

Showing 2 changed files with 43 additions and 37 deletions.
diff --git a/src/Fame-ImportExport/FMAbstractCodeGenerator.class.st b/src/Fame-ImportExport/FMAbstractCodeGenerator.class.st
@@ -8,8 +8,8 @@ Class {
 		'classNamePrefix',
 		'instVarNames',
 		'initializeSource',
-		'defaultCategory',
-		'skipDerivedMethods'
+		'skipDerivedMethods',
+		'defaultPackage'
 	],
 	#category : #'Fame-ImportExport-CodeGeneration'
 }
@@ -62,11 +62,6 @@ FMAbstractCodeGenerator >> annotationStringForProperty: property [
 	^ ann
 ]
 
-{ #category : #'compiling-names' }
-FMAbstractCodeGenerator >> categoryNameFor: fameClass [
-	^ self defaultCategory ifNil: [ fameClass package name asString ]
-]
-
 { #category : #'compiling-names' }
 FMAbstractCodeGenerator >> classNameFor: fameClass [ 
 	^fameClass isBuiltIn 
@@ -85,31 +80,37 @@ FMAbstractCodeGenerator >> classNamePrefix: aString [
 ]
 
 { #category : #compiling }
-FMAbstractCodeGenerator >> compileClass: fameClass superclass: rbSuperclass [ 
-	^ model defineClass: ('<1s> subclass: #<2s>
+FMAbstractCodeGenerator >> compileClass: fameClass superclass: rbSuperclass [
+
+	| definition |
+	self flag: #todo. "The next part changed a lot in P12. Before the user had to give a string representing a class definition but in P12 this changed to use the ShiftClassBuilder to build the classes. 
+	For now I'll use an ugly if on the version and when P12 will be the minimal version used by moose we can remove it."
+
+	definition := SystemVersion current major < 12
+		              ifTrue: [
+			              '<1s> subclass: #<2s>
 		instanceVariableNames: ''''
 		classVariableNames: ''''
 		poolDictionaries: ''''
-		category: #<3p>' 
-			expandMacrosWith: rbSuperclass name
-			with: (self classNameFor: fameClass)
-			with: (self categoryNameFor: fameClass))
+		category: #<3p>' expandMacrosWith: rbSuperclass name with: (self classNameFor: fameClass) with: (self packageNameFor: fameClass) ]
+		              ifFalse: [
+			              [ :builder |
+			              builder
+				              superclassName: rbSuperclass name;
+				              name: (self classNameFor: fameClass);
+				              package: (self packageNameFor: fameClass) ] ].
+
+	^ model defineClass: definition
 ]
 
 { #category : #compiling }
 FMAbstractCodeGenerator >> compileClassAnnotation: fameClass [
+
 	| annotationString |
-	annotationString := ('annotation<n>',
-		'<t>%<FMClass: <1p>',
-		' super: <2p>><n>',
-		'<t>%<package: <3p>><n><t>',
-		(fameClass isAbstract ifTrue: [ '%<abstract><n><t>' ] ifFalse: ['']))
-		expandMacrosWith: fameClass name
-						with: fameClass superclass fullName
-						with: fameClass package name.
-	rbClass theMetaClass
-		compile: annotationString, '^self'
-		classified: 'initialize-release'
+	annotationString := 'annotation<n>' , '<t>%<FMClass: <1p>' , ' super: <2p>><n>' , '<t>%<package: <3p>><n><t>' , (fameClass isAbstract
+		                     ifTrue: [ '%<abstract><n><t>' ]
+		                     ifFalse: [ '' ]) expandMacrosWith: fameClass name with: fameClass superclass fullName with: fameClass package name.
+	rbClass classSide compile: annotationString , '^self' classified: 'initialize-release'
 ]
 
 { #category : #compiling }
@@ -128,13 +129,13 @@ FMAbstractCodeGenerator >> createRBModel [
 ]
 
 { #category : #accessing }
-FMAbstractCodeGenerator >> defaultCategory [
-	^defaultCategory
+FMAbstractCodeGenerator >> defaultPackage [
+	^defaultPackage
 ]
 
 { #category : #accessing }
-FMAbstractCodeGenerator >> defaultCategory: aString [
-	defaultCategory := aString
+FMAbstractCodeGenerator >> defaultPackage: aString [
+	defaultPackage := aString
 ]
 
 { #category : #accessing }
@@ -209,6 +210,11 @@ FMAbstractCodeGenerator >> oppositeNameFor: fameProperty [
 	^fameProperty opposite name asSymbol
 ]
 
+{ #category : #'compiling-names' }
+FMAbstractCodeGenerator >> packageNameFor: fameClass [
+	^ self defaultPackage ifNil: [ fameClass package name asString ]
+]
+
 { #category : #'compiling-names' }
 FMAbstractCodeGenerator >> parameterNameFor: fameProperty [
 	| name stream |

diff --git a/src/Fame-Tests/FMCodeGenerationTest.class.st b/src/Fame-Tests/FMCodeGenerationTest.class.st
@@ -26,21 +26,21 @@ FMCodeGenerationTest >> testComplexGeneration [
 ]
 
 { #category : #tests }
-FMCodeGenerationTest >> testDefaultCategory [
+FMCodeGenerationTest >> testDefaultClass [
 	| gen |
 	gen := FMDefaultCodeGenerator new.
-	self assert: gen defaultCategory isNil.
-	gen defaultCategory: 'Fame-Example'.
-	self assert: gen defaultCategory equals: 'Fame-Example'
+	self assert: gen defaultSuperclass name equals: #Object.
+	gen defaultSuperclass: LIBRoot.
+	self assert: gen defaultSuperclass name equals: #LIBRoot
 ]
 
 { #category : #tests }
-FMCodeGenerationTest >> testDefaultClass [
+FMCodeGenerationTest >> testDefaultPackage [
 	| gen |
 	gen := FMDefaultCodeGenerator new.
-	self assert: gen defaultSuperclass name equals: #Object.
-	gen defaultSuperclass: LIBRoot.
-	self assert: gen defaultSuperclass name equals: #LIBRoot
+	self assert: gen defaultPackage isNil.
+	gen defaultPackage: 'Fame-Example'.
+	self assert: gen defaultPackage equals: 'Fame-Example'
 ]
 
 { #category : #tests }
@@ -65,7 +65,7 @@ FMCodeGenerationTest >> testLIBGeneration [
 FMCodeGenerationTest >> testRPGGeneration [
 	| generator |
 	generator := FMDefaultCodeGenerator new.
-	generator defaultCategory: 'Fame-Example'.
+	generator defaultPackage: 'Fame-Example'.
 	generator visit: (FMMetaModel fromString: FMDungeonExample metamodelString).
 	generator previewChangesIfShiftPressed
 ]