Merge pull request #68 from moosetechnology/class-generation

Fix class generation
moosetechnology · Dec 19, 2023 · 48a7d50 · 48a7d50
2 parents 5ed3143 + 02fecae
commit 48a7d50
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
 ]