Merge pull request #25 from enwiro/24-Impossible-to-call-descriptionO…

…f-on-an-FM3Trait Possible to call FMMetaModel>>descriptionOf: on an FM3Trait
moosetechnology · May 28, 2021 · 6e8414d · 6e8414d
2 parents 2fe80d3 + 056dc64
commit 6e8414d
Show file tree

Hide file tree

Showing 10 changed files with 47 additions and 13 deletions.
diff --git a/src/Fame-Core/FM3Type.class.st b/src/Fame-Core/FM3Type.class.st
@@ -101,3 +101,9 @@ FM3Type >> traits [
 	<multivalued>
 	^ traits
 ]
+
+{ #category : #accessing }
+FM3Type >> traits: anObject [
+
+	traits := anObject
+]
diff --git a/src/Fame-Core/FMMetaModel.class.st b/src/Fame-Core/FMMetaModel.class.st
@@ -34,7 +34,7 @@ Class {
 	#name : #FMMetaModel,
 	#superclass : #FMModel,
 	#instVars : [
-		'classDict',
+		'typeDict',
 		'nameDict'
 	],
 	#category : #'Fame-Core-Models'
@@ -69,12 +69,12 @@ FMMetaModel >> descriptionOf: smalltalkClass [
 
 { #category : #accessing }
 FMMetaModel >> descriptionOf: smalltalkClass ifAbsent: elseBlock [
-	^ classDict at: smalltalkClass ifAbsent: elseBlock
+	^ typeDict at: smalltalkClass ifAbsent: elseBlock
 ]
 
 { #category : #accessing }
 FMMetaModel >> descriptionOf: smalltalkClass ifPresent: aBlock ifAbsent: elseBlock [
-	^ classDict at: smalltalkClass ifPresent: aBlock ifAbsent: elseBlock
+	^ typeDict at: smalltalkClass ifPresent: aBlock ifAbsent: elseBlock
 ]
 
 { #category : #accessing }
@@ -138,12 +138,16 @@ FMMetaModel >> traits [
 { #category : #private }
 FMMetaModel >> updateCache [
 	nameDict := (FM3Constant constants collect: [ :const | const name asString -> const ]) asDictionary.
-	classDict := (FM3Constant constants collect: [ :const | const class -> const ]) asDictionary.
+	typeDict := (FM3Constant constants collect: [ :const | const class -> const ]) asDictionary.
 	self elements do: [ :each | self updateCacheWith: each ]
 ]
 
 { #category : #private }
 FMMetaModel >> updateCacheWith: element [
-	element fullName ifNotNil: [ :fullName | nameDict at: fullName put: element ].
-	element isFM3Class ifTrue: [ element implementingClass ifNotNil: [ :class | classDict at: class put: element ] ]
+
+	element fullName ifNotNil: [ :fullName | 
+		nameDict at: fullName put: element ].
+	(element isFM3Class or: [ element isFM3Trait ]) ifTrue: [ 
+		element implementingClass ifNotNil: [ :class | 
+			typeDict at: class put: element ] ]
 ]
diff --git a/src/Fame-Example/LIBBook.class.st b/src/Fame-Example/LIBBook.class.st
@@ -1,6 +1,8 @@
 Class {
 	#name : #LIBBook,
 	#superclass : #LIBRoot,
+	#traits : 'LIBTNamed',
+	#classTraits : 'LIBTNamed classTrait',
 	#instVars : [
 		'title',
 		'authors'

diff --git a/src/Fame-Example/LIBLibrary.class.st b/src/Fame-Example/LIBLibrary.class.st
@@ -1,6 +1,8 @@
 Class {
 	#name : #LIBLibrary,
 	#superclass : #LIBRoot,
+	#traits : 'LIBTNamed',
+	#classTraits : 'LIBTNamed classTrait',
 	#instVars : [
 		'librarian',
 		'books'

diff --git a/src/Fame-Example/LIBPerson.class.st b/src/Fame-Example/LIBPerson.class.st
@@ -1,6 +1,8 @@
 Class {
 	#name : #LIBPerson,
 	#superclass : #LIBRoot,
+	#traits : 'LIBTNamed',
+	#classTraits : 'LIBTNamed classTrait',
 	#instVars : [
 		'books',
 		'name'

diff --git a/src/Fame-Example/LIBRoot.class.st b/src/Fame-Example/LIBRoot.class.st
@@ -21,7 +21,7 @@ LIBRoot class >> library [
 
 { #category : #examples }
 LIBRoot class >> libraryMetaModel [
-	^ FMMetaModelBuilder metamodelFrom: {LIBLibrary . LIBBook . LIBPerson}
+	^ FMMetaModelBuilder metamodelFrom: {LIBLibrary . LIBBook . LIBPerson. LIBTNamed }
 ]
 
 { #category : #examples }

diff --git a/src/Fame-Example/LIBTNamed.trait.st b/src/Fame-Example/LIBTNamed.trait.st
@@ -0,0 +1,10 @@
+Trait {
+	#name : #LIBTNamed,
+	#category : #'Fame-Example'
+}
+
+{ #category : #meta }
+LIBTNamed classSide >> annotation [
+	<FMClass: #TNamed super: #Object>
+	<package: #LIB>
+]
diff --git a/src/Fame-Tests/FMExporterTest.class.st b/src/Fame-Tests/FMExporterTest.class.st
@@ -8,7 +8,7 @@ Class {
 FMExporterTest >> testExportAsJSon [
 	| printer metamodel lines |
 	printer := FMJSONPrinter onString.
-	metamodel := FMMetaModelBuilder metamodelFrom: {LIBLibrary . LIBBook . LIBPerson}.
+	metamodel := FMMetaModelBuilder metamodelFrom: {LIBLibrary . LIBBook . LIBPerson . LIBTNamed}.
 	metamodel exportWithPrinter: printer.
 	lines := printer stream contents lines.
 	self assert: (lines first beginsWith: '[') .
@@ -22,12 +22,12 @@ FMExporterTest >> testExportAsJSon [
 FMExporterTest >> testExportAsMSE [
 	| printer metamodel lines |
 	printer := FMMSEPrinter onString.
-	metamodel := FMMetaModelBuilder metamodelFrom: {LIBLibrary . LIBBook . LIBPerson}.
+	metamodel := FMMetaModelBuilder metamodelFrom: {LIBLibrary . LIBBook . LIBPerson . LIBTNamed}.
 	metamodel exportWithPrinter: printer.
 	self assert: printer stream contents isString.
 	lines := printer stream contents lines.
 	self assert: lines first equals: '(' .
-	self assert: printer stream contents lines size equals: 66.
+	self assert: printer stream contents lines size equals: 72.
 	self assert: (lines allButFirst allSatisfy: [ :l | l beginsWith: '	'] ) .
 	self assert: (lines anySatisfy: [ :l | l includesSubstring: 'FM3.Package'] ) .
 	self assert: (lines anySatisfy: [ :l | l includesSubstring: 'FM3.Class'] ) .
@@ -39,7 +39,7 @@ FMExporterTest >> testExportAsMSE [
 FMExporterTest >> testExportAsXML [
 	| printer metamodel lines |
 	printer := FMXMLPrinter onString.
-	metamodel := FMMetaModelBuilder metamodelFrom: {LIBLibrary . LIBBook . LIBPerson}.
+	metamodel := FMMetaModelBuilder metamodelFrom: {LIBLibrary . LIBBook . LIBPerson . LIBTNamed}.
 	metamodel exportWithPrinter: printer.
 	lines := printer stream contents lines.
 	self assert: (lines first beginsWith: '<') .
@@ -53,7 +53,7 @@ FMExporterTest >> testExportAsXML [
 { #category : #tests }
 FMExporterTest >> testExportedModelIsTheSameAsBeforeExport [
 	| metamodel printer |
-	metamodel := FMMetaModelBuilder metamodelFrom: {LIBLibrary . LIBBook . LIBPerson}.
+	metamodel := FMMetaModelBuilder metamodelFrom: {LIBLibrary . LIBBook . LIBPerson . LIBTNamed}.
 
 	self assert: metamodel packages size equals: 1.
 	self assert: metamodel classes size equals: 3.

diff --git a/src/Fame-Tests/FMLibraryExample.class.st b/src/Fame-Tests/FMLibraryExample.class.st
@@ -113,7 +113,7 @@ FMLibraryExample >> testMetamodelSmalltalkBinding [
 FMLibraryExample >> testPragmaProcessing [
 	| pragmaProcessor |
 	pragmaProcessor := FMMetaModelBuilder new
-		queue: {LIBBook . LIBLibrary . LIBPerson};
+		queue: {LIBBook . LIBLibrary . LIBPerson . LIBTNamed};
 		run.
 	self denyEmpty: pragmaProcessor elements.
 	self denyEmpty: pragmaProcessor packages.

diff --git a/src/Fame-Tests/FMMetaModelTest.class.st b/src/Fame-Tests/FMMetaModelTest.class.st
@@ -44,6 +44,14 @@ FMMetaModelTest >> testDescriptionOfIfPresentIfAbsent [
 	self deny: (metamodel descriptionOf: FMMetaMetaModelTest ifPresent: [ true ] ifAbsent: [ false ])
 ]
 
+{ #category : #tests }
+FMMetaModelTest >> testDescriptionOfTrait [
+	| metamodel tNamed |
+	metamodel := LIBRoot libraryMetaModel.
+	tNamed := (metamodel packageNamed: 'LIB') classNamed: 'TNamed'.
+	self assert: (metamodel descriptionOf: LIBTNamed) identicalTo: tNamed.
+]
+
 { #category : #tests }
 FMMetaModelTest >> testElementNamed [
 	| metamodel |