From 3ed418c6e44357471b5a74b7638545488512215b Mon Sep 17 00:00:00 2001 From: CyrilFerlicot Date: Sat, 15 Jun 2024 17:34:42 +0200 Subject: [PATCH 01/11] Smalltalk: Ensure all stubs are in the model Currently the parents of the stubs are not in the MooseModel which causes some inconsistances. Here is a fix. Related to #552 --- .../ImportStubMethodSpecialTest.class.st | 14 ++++++++++++++ .../CandidateListOperator.class.st | 9 +++++---- 2 files changed, 19 insertions(+), 4 deletions(-) diff --git a/src/Moose-SmalltalkImporter-LAN-Tests/ImportStubMethodSpecialTest.class.st b/src/Moose-SmalltalkImporter-LAN-Tests/ImportStubMethodSpecialTest.class.st index 7f0c1448..c9bdc20a 100644 --- a/src/Moose-SmalltalkImporter-LAN-Tests/ImportStubMethodSpecialTest.class.st +++ b/src/Moose-SmalltalkImporter-LAN-Tests/ImportStubMethodSpecialTest.class.st @@ -29,3 +29,17 @@ ImportStubMethodSpecialTest >> testStubMethodCreation [ self denyEmpty: (model allMethods select: #isStub). self denyEmpty: model allModelMethods ] + +{ #category : #tests } +ImportStubMethodSpecialTest >> testStubParentsAreInMooseModel [ + + | method class | + method := model entityNamed: #'Smalltalk::False.ifTrue:(Object)'. + self assert: method mooseModel isNotNil. + self assert: method isStub. + + class := method parentType. + self assert: class name equals: 'False'. + self assert: class mooseModel isNotNil. + self assert: class isStub +] diff --git a/src/Moose-SmalltalkImporter/CandidateListOperator.class.st b/src/Moose-SmalltalkImporter/CandidateListOperator.class.st index 8cf5b874..b996efd5 100644 --- a/src/Moose-SmalltalkImporter/CandidateListOperator.class.st +++ b/src/Moose-SmalltalkImporter/CandidateListOperator.class.st @@ -14,12 +14,13 @@ Class { { #category : #running } CandidateListOperator >> allCandidatesFor: invocation [ - ^ Array withAll: (groups at: invocation signature ifAbsent: [ + ^ Array withAll: (groups at: invocation signature ifAbsent: [ | stubs | - stubs := self importer ensureSmalltalkStubMethodsFor: - invocation signature. + stubs := self importer ensureSmalltalkStubMethodsFor: invocation signature. groups at: invocation signature put: stubs. - stubs do: [ :each | model add: each ]. + stubs do: [ :each | + model add: each. + each allParents do: [ :parent | parent mooseModel = model ifFalse: [ model add: parent ] ] ]. stubs ]) ] From a6ee96c5bd835bc49ae4adf768dd1c62382ce0ca Mon Sep 17 00:00:00 2001 From: CyrilFerlicot Date: Tue, 18 Jun 2024 12:12:43 +0200 Subject: [PATCH 02/11] Improve importers API Allow to either import or import and install models --- .../FamixAbstractFileImporter.class.st | 2 +- .../FamixJSONFileImporter.class.st | 2 +- .../FamixJavaFoldersImporter.class.st | 51 ++++++++++++++++--- .../FamixMSEFileImporter.class.st | 2 +- .../MooseFileStructureImporter.class.st | 2 +- 5 files changed, 47 insertions(+), 12 deletions(-) diff --git a/src/Moose-Importers/FamixAbstractFileImporter.class.st b/src/Moose-Importers/FamixAbstractFileImporter.class.st index b58c4966..8a5f33cb 100644 --- a/src/Moose-Importers/FamixAbstractFileImporter.class.st +++ b/src/Moose-Importers/FamixAbstractFileImporter.class.st @@ -13,7 +13,7 @@ Class { 'model', 'inputStream' ], - #category : #'Moose-Importers' + #category : #'Moose-Importers-FromPersistedFiles' } { #category : #testing } diff --git a/src/Moose-Importers/FamixJSONFileImporter.class.st b/src/Moose-Importers/FamixJSONFileImporter.class.st index ebab71d0..2edd725e 100644 --- a/src/Moose-Importers/FamixJSONFileImporter.class.st +++ b/src/Moose-Importers/FamixJSONFileImporter.class.st @@ -5,7 +5,7 @@ Importer for JSON file Class { #name : #FamixJSONFileImporter, #superclass : #FamixAbstractFileImporter, - #category : #'Moose-Importers' + #category : #'Moose-Importers-FromPersistedFiles' } { #category : #executing } diff --git a/src/Moose-Importers/FamixJavaFoldersImporter.class.st b/src/Moose-Importers/FamixJavaFoldersImporter.class.st index c4ee6e77..41c73aaa 100644 --- a/src/Moose-Importers/FamixJavaFoldersImporter.class.st +++ b/src/Moose-Importers/FamixJavaFoldersImporter.class.st @@ -24,12 +24,13 @@ Class { #name : #FamixJavaFoldersImporter, #superclass : #Object, #instVars : [ - 'folders' + 'folders', + 'models' ], #classVars : [ 'VerveineJPath' ], - #category : #'Moose-Importers' + #category : #'Moose-Importers-ParseFolders' } { #category : #accessing } @@ -39,13 +40,23 @@ FamixJavaFoldersImporter class >> defaultVerveineJDirectory [ ] { #category : #actions } -FamixJavaFoldersImporter class >> importFolder: aFileReference [ +FamixJavaFoldersImporter class >> importAndInstallFolder: aFileReference [ - ^ self importFolders: { aFileReference } + ^ self importAndInstallFolders: { aFileReference } +] + +{ #category : #actions } +FamixJavaFoldersImporter class >> importAndInstallFolders: aCollection [ + "I'll parse, import in a moose model and install the models for each folder in the collection." + + ^ self new + folders: aCollection; + importAndInstall ] { #category : #actions } FamixJavaFoldersImporter class >> importFolders: aCollection [ + "I'll parse and import in a moose model for each folder in the collection." ^ self new folders: aCollection; @@ -124,7 +135,19 @@ FamixJavaFoldersImporter >> import [ self generateJsonOfProjects. - self importModels + self importModels. + + ^ models +] + +{ #category : #actions } +FamixJavaFoldersImporter >> importAndInstall [ + + self import. + + self installModels. + + ^ models ] { #category : #actions } @@ -143,12 +166,24 @@ FamixJavaFoldersImporter >> importModels [ inputFile: json; run. - model - name: folder basename; - install ] + model name: folder basename. + models add: model ] displayingProgress: [ :folder | folder basename ] ] +{ #category : #initialization } +FamixJavaFoldersImporter >> initialize [ + + super initialize. + models := OrderedCollection new +] + +{ #category : #actions } +FamixJavaFoldersImporter >> installModels [ + + models do: [ :model | model install ] +] + { #category : #actions } FamixJavaFoldersImporter >> jsonForFolder: folder [ diff --git a/src/Moose-Importers/FamixMSEFileImporter.class.st b/src/Moose-Importers/FamixMSEFileImporter.class.st index 8901cbe0..b8563dc7 100644 --- a/src/Moose-Importers/FamixMSEFileImporter.class.st +++ b/src/Moose-Importers/FamixMSEFileImporter.class.st @@ -4,7 +4,7 @@ Importer for MSE files Class { #name : #FamixMSEFileImporter, #superclass : #FamixAbstractFileImporter, - #category : #'Moose-Importers' + #category : #'Moose-Importers-FromPersistedFiles' } { #category : #executing } diff --git a/src/Moose-Importers/MooseFileStructureImporter.class.st b/src/Moose-Importers/MooseFileStructureImporter.class.st index 84c2a36a..242a4fef 100644 --- a/src/Moose-Importers/MooseFileStructureImporter.class.st +++ b/src/Moose-Importers/MooseFileStructureImporter.class.st @@ -8,7 +8,7 @@ Class { 'mooseModel', 'factory' ], - #category : #'Moose-Importers-Importers' + #category : #'Moose-Importers-FileSystem' } { #category : #accessing } From ee5ee06c7188e40ff94b45023367d24f22ade9cc Mon Sep 17 00:00:00 2001 From: CyrilFerlicot Date: Tue, 18 Jun 2024 15:19:09 +0200 Subject: [PATCH 03/11] Shared variable properties should be persisted Smalltalk attributes can be shared variable and we have a way to declare this. The problem is that this info can be lost when we flush the caches. This change fix this bug. I also declared this as a property in the MM so that we can query it in the query browser --- .../FamixStAttribute.class.st | 11 +++++++---- .../FamixPharoAttributeTest.class.st | 17 ++++++++++++++++- 2 files changed, 23 insertions(+), 5 deletions(-) diff --git a/src/Famix-PharoSmalltalk-Entities/FamixStAttribute.class.st b/src/Famix-PharoSmalltalk-Entities/FamixStAttribute.class.st index e4d5b987..14af2af1 100644 --- a/src/Famix-PharoSmalltalk-Entities/FamixStAttribute.class.st +++ b/src/Famix-PharoSmalltalk-Entities/FamixStAttribute.class.st @@ -47,13 +47,16 @@ FamixStAttribute class >> annotation [ ^ self ] -{ #category : #'Famix-Implementation' } +{ #category : #properties } FamixStAttribute >> beSharedVariable [ - self propertyNamed: #sharedVariable put: true + ^ self attributeAt: #isSharedVariable put: true ] -{ #category : #'Famix-Implementation' } +{ #category : #testing } FamixStAttribute >> isSharedVariable [ - ^ self propertyNamed: #sharedVariable ifNil: [ false ] + + + + ^ self attributeAt: #isSharedVariable ifAbsent: [ false ] ] diff --git a/src/Famix-PharoSmalltalk-Tests/FamixPharoAttributeTest.class.st b/src/Famix-PharoSmalltalk-Tests/FamixPharoAttributeTest.class.st index e10f987e..527b9efe 100644 --- a/src/Famix-PharoSmalltalk-Tests/FamixPharoAttributeTest.class.st +++ b/src/Famix-PharoSmalltalk-Tests/FamixPharoAttributeTest.class.st @@ -6,8 +6,23 @@ Class { { #category : #tests } FamixPharoAttributeTest >> testIsClassSide [ + | attribute | attribute := FamixStAttribute new. attribute isClassSide: true. - self assert: attribute isClassSide . + self assert: attribute isClassSide +] + +{ #category : #tests } +FamixPharoAttributeTest >> testSharedVariableArePersisted [ + + | attribute | + attribute := FamixStAttribute new. + attribute + isClassSide: true; + beSharedVariable. + self assert: attribute isSharedVariable. + + attribute flush. + self assert: attribute isSharedVariable ] From a0a3f2d6e84288d6580a140bcc14e76b6c9f8034 Mon Sep 17 00:00:00 2001 From: CyrilFerlicot Date: Tue, 18 Jun 2024 17:51:33 +0200 Subject: [PATCH 04/11] Remove unused properties The Smalltalk importer is adding some properties to the methods but those are flushable. So either we need to make them permanent or to remove them. Since I've never seen anyone use those 2 propoerties I propose to remove them. --- .../RBVisitorForFAMIXMetrics.class.st | 27 +++++-------------- 1 file changed, 7 insertions(+), 20 deletions(-) diff --git a/src/Famix-Smalltalk-Utils/RBVisitorForFAMIXMetrics.class.st b/src/Famix-Smalltalk-Utils/RBVisitorForFAMIXMetrics.class.st index ac6e2867..e56380a8 100644 --- a/src/Famix-Smalltalk-Utils/RBVisitorForFAMIXMetrics.class.st +++ b/src/Famix-Smalltalk-Utils/RBVisitorForFAMIXMetrics.class.st @@ -92,18 +92,6 @@ RBVisitorForFamixMetrics >> initialize [ self resetMetricValues ] -{ #category : #private } -RBVisitorForFamixMetrics >> isDirtySuperInMethod: selector withReceiver: receiver [ - - ^ selector ~~ self methodEntity name and: [ receiver isSuperVariable ] -] - -{ #category : #private } -RBVisitorForFamixMetrics >> isSuperInMethod: selector withReceiver: receiver [ - - ^ selector == self methodEntity name and: [ receiver isSuperVariable ] -] - { #category : #'source access' } RBVisitorForFamixMetrics >> methodBodyOn: aReadStream [ | aux | @@ -192,32 +180,31 @@ RBVisitorForFamixMetrics >> resetMetricValues [ cyclomaticNumber := 1 ] -{ #category : #enumerating } +{ #category : #visiting } RBVisitorForFamixMetrics >> visitBlockNode: aBlockNode [ super visitBlockNode: aBlockNode. numberOfStatements := numberOfStatements + aBlockNode body size ] -{ #category : #enumerating } +{ #category : #visiting } RBVisitorForFamixMetrics >> visitCascadeNode: aCascadeNode [ numberOfStatements := numberOfStatements + aCascadeNode messages size. ^ super visitCascadeNode: aCascadeNode ] -{ #category : #enumerating } +{ #category : #visiting } RBVisitorForFamixMetrics >> visitMessageNode: aMessageNode [ + | receiver selector | receiver := aMessageNode receiver. selector := aMessageNode selector. super visitMessageNode: aMessageNode. numberOfMessageSends := numberOfMessageSends + 1. self countConditionals: selector. - self computeCyclomaticNumber: selector. - (self isSuperInMethod: selector withReceiver: receiver) ifTrue: [ self methodEntity propertyNamed: #cleanSuperSend put: true ]. - (self isDirtySuperInMethod: selector withReceiver: receiver) ifTrue: [ self methodEntity propertyNamed: #dirtySuperSend put: true ] + self computeCyclomaticNumber: selector ] -{ #category : #enumerating } +{ #category : #visiting } RBVisitorForFamixMetrics >> visitMethodNode: aMethodNode [ " I do not know where this block came from" @@ -227,7 +214,7 @@ RBVisitorForFamixMetrics >> visitMethodNode: aMethodNode [ ^ super visitMethodNode: aMethodNode ] -{ #category : #enumerating } +{ #category : #visiting } RBVisitorForFamixMetrics >> visitSequenceNode: aSequenceNode [ super visitSequenceNode: aSequenceNode. numberOfStatements := numberOfStatements + aSequenceNode statements size From d7f67c905e97359575a96e4aef4a9539361b01c9 Mon Sep 17 00:00:00 2001 From: CyrilFerlicot Date: Tue, 18 Jun 2024 18:14:00 +0200 Subject: [PATCH 05/11] Clean SmalltalkMethodVisitor Remove unused MonticelloMethodVisitor. Merge AbstractSmalltalkMethodVisitor and SmalltalkMethodVisitor since there is now only one subclass. Some factorization of code --- .../AbstractSmalltalkMethodVisitor.class.st | 354 ------------------ .../MonticelloMethodVisitor.class.st | 17 - .../SmalltalkMethodVisitor.class.st | 308 ++++++++++++++- 3 files changed, 307 insertions(+), 372 deletions(-) delete mode 100644 src/Moose-SmalltalkImporter/AbstractSmalltalkMethodVisitor.class.st delete mode 100644 src/Moose-SmalltalkImporter/MonticelloMethodVisitor.class.st diff --git a/src/Moose-SmalltalkImporter/AbstractSmalltalkMethodVisitor.class.st b/src/Moose-SmalltalkImporter/AbstractSmalltalkMethodVisitor.class.st deleted file mode 100644 index ceac1550..00000000 --- a/src/Moose-SmalltalkImporter/AbstractSmalltalkMethodVisitor.class.st +++ /dev/null @@ -1,354 +0,0 @@ -Class { - #name : #AbstractSmalltalkMethodVisitor, - #superclass : #RBProgramNodeVisitor, - #instVars : [ - 'methodScope', - 'importer', - 'famixMethod', - 'theClass' - ], - #category : #'Moose-SmalltalkImporter' -} - -{ #category : #'instance creation' } -AbstractSmalltalkMethodVisitor class >> on: importer [ - - ^(self new) - importer: importer; - yourself -] - -{ #category : #'method-classifying' } -AbstractSmalltalkMethodVisitor >> classifyMethodNode: aMethodNode [ - - self matchGetter: aMethodNode. - self matchSetter: aMethodNode. - self matchConstructor: aMethodNode. - self matchConstant: aMethodNode -] - -{ #category : #'visitor-double dispatching' } -AbstractSmalltalkMethodVisitor >> createAccessTo: aNamedEntity writing: isWriteAccess [ - | access | - - access := self importer factory access new. - access isWrite: isWriteAccess ; variable: aNamedEntity ; accessor: self methodEntity. - ^ access -] - -{ #category : #'visitor-double dispatching' } -AbstractSmalltalkMethodVisitor >> createReferenceTo: aNamedEntity [ - - | referenceClass | - - referenceClass := self importer factory reference. - - ^ referenceClass source: self methodEntity target: (self resolveInstanceSide: aNamedEntity) - - -] - -{ #category : #'method-classifying' } -AbstractSmalltalkMethodVisitor >> extractCommentsFromNode: aSequenceNode [ - - | comment | - importer importingContext shouldImportComment ifTrue: [ - aSequenceNode comments do: [ :eachComment | - comment := self importer factory comment new. - comment content: - (aSequenceNode source - copyFrom: eachComment start - to: eachComment stop) asString. - comment commentedEntity: self methodEntity. - importer addEntity: comment ] ] -] - -{ #category : #accessing } -AbstractSmalltalkMethodVisitor >> importer [ - - ^importer -] - -{ #category : #accessing } -AbstractSmalltalkMethodVisitor >> importer: anObject [ - - importer := anObject -] - -{ #category : #initialization } -AbstractSmalltalkMethodVisitor >> initializeForMethod: aMethod inClass: aClass [ - theClass := aClass. - famixMethod := aMethod. - methodScope := SmalltalkScope extend: (importer scopeOfClass: aClass). - -] - -{ #category : #'method-classifying' } -AbstractSmalltalkMethodVisitor >> matchConstant: aMethodNode [ - - aMethodNode body isSequence ifTrue: [ - aMethodNode body statements ifNotEmpty: [ :statements | - statements last isReturn ifTrue: [ - statements last value isLiteralNode ifTrue: [ - famixMethod beConstant ] ] ] ] -] - -{ #category : #'method-classifying' } -AbstractSmalltalkMethodVisitor >> matchConstructor: aMethodNode [ - - famixMethod protocol ifNotNil: [ - ('*instance*creation*' match: famixMethod protocol asLowercase) - ifTrue: [ famixMethod beConstructor ] ] -] - -{ #category : #'method-classifying' } -AbstractSmalltalkMethodVisitor >> matchGetter: aMethodNode [ - - aMethodNode arguments ifNotEmpty: [ ^ self ]. - aMethodNode body isSequence ifTrue: [ - aMethodNode body statements size = 1 ifTrue: [ - | return | - return := aMethodNode body statements first. - return isReturn ifTrue: [ - return value isVariable ifTrue: [ - (methodScope resolve: return value name ifAbsent: nil) ifNotNil: [ - :attribute | - attribute class = self importer factory attribute ifTrue: [ - famixMethod beGetter ] ] ] ] ] ] -] - -{ #category : #'method-classifying' } -AbstractSmalltalkMethodVisitor >> matchSetter: aMethodNode [ - - | assignment | - aMethodNode arguments size = 1 ifTrue: [ - aMethodNode body isSequence ifTrue: [ - aMethodNode body statements size = 1 ifTrue: [ - assignment := aMethodNode body statements first. - assignment isReturn ifTrue: [ assignment := assignment value ]. - assignment isAssignment ifTrue: [ - (methodScope resolve: assignment variable name ifAbsent: nil) - ifNotNil: [ :attribute | - attribute class = self importer factory attribute ifTrue: [ - assignment value isVariable ifTrue: [ - assignment value name = aMethodNode arguments first name - ifTrue: [ famixMethod beSetter ] ] ] ] ] ] ] ] -] - -{ #category : #accessing } -AbstractSmalltalkMethodVisitor >> methodEntity [ - - ^famixMethod -] - -{ #category : #private } -AbstractSmalltalkMethodVisitor >> parseTreeForSource: methodSourceString [ - ^ RBParser parseMethod: methodSourceString - onError: [:aString :pos | ^nil] -] - -{ #category : #private } -AbstractSmalltalkMethodVisitor >> resolve: name [ - "Return a famix entity that correspond to the reference 'name' contained in a source code. It does the lookup according to the Smalltalk semantics" - - self subclassResponsibility -] - -{ #category : #'visitor-double dispatching' } -AbstractSmalltalkMethodVisitor >> resolveInstanceSide: aNamedEntity [ - "We ensure that a reference to a metaclass is considered as a reference to the class itself" - - ^ ((aNamedEntity isKindOf: self importer factory classEntity) and: [ '*_class' match: aNamedEntity name ]) - ifTrue: [ | className | - className := aNamedEntity name removeSuffix: '_class'. - importer ensureClass: (Smalltalk at: className asSymbol) ] - ifFalse: [ aNamedEntity ] -] - -{ #category : #accessing } -AbstractSmalltalkMethodVisitor >> runWith: aCompiledMethod and: anEntity [ - - | parseTree | - self - initializeForMethod: anEntity - inClass: aCompiledMethod methodClass. - - parseTree := theClass parseTreeForSelector: aCompiledMethod selector. - parseTree ifNotNil: [ - self visitMethodNode: parseTree "sourceCodeAt:" ] -] - -{ #category : #accessing } -AbstractSmalltalkMethodVisitor >> runWithSource: sourceAsString and: aFamixMethod [ - | parseTree | - self initializeForMethod: aFamixMethod inClass: aFamixMethod parentType. - - parseTree := self parseTreeForSource: sourceAsString. - parseTree ifNotNil: [self visitMethodNode: parseTree] "sourceCodeAt:" -] - -{ #category : #'visitor-double dispatching' } -AbstractSmalltalkMethodVisitor >> visitArgument: each [ - "Here to allow subclasses to detect arguments or temporaries." - - ^self visitNode: each -] - -{ #category : #'visitor-double dispatching' } -AbstractSmalltalkMethodVisitor >> visitAssignmentNode: anAssignmentNode [ - - | access | - importer importingContext shouldImportAccess - ifTrue: - [access := self importer factory access new. - access isWrite: true. - access variable: (self resolve: anAssignmentNode variable name). - access accessor: self methodEntity. - importer addEntity: access]. - self extractCommentsFromNode: anAssignmentNode. - self visitNode: anAssignmentNode value -] - -{ #category : #'visitor-double dispatching' } -AbstractSmalltalkMethodVisitor >> visitBlockNode: aBlockNode [ - - | local | - importer importingContext shouldImportLocalVariable - ifTrue: - [aBlockNode arguments - do: - [:aVariableNode | - local := self importer factory localVariable new. - local name: aVariableNode name asSymbol. - local parentBehaviouralEntity: self methodEntity. - importer addEntity: local. - methodScope - at: aVariableNode name - bind: local]]. - self extractCommentsFromNode: aBlockNode. "self visitArguments: aBlockNode arguments." - self visitNode: aBlockNode body -] - -{ #category : #'visitor-double dispatching' } -AbstractSmalltalkMethodVisitor >> visitCascadeNode: aCascadeNode [ - aCascadeNode messages ifNotEmpty: [ :messages | messages do: [ :each | self visitNode: each ] ]. - self extractCommentsFromNode: aCascadeNode -] - -{ #category : #'visitor-double dispatching' } -AbstractSmalltalkMethodVisitor >> visitMessageNode: aMessageNode [ - - | invocation | - importer importingContext shouldImportInvocation - ifTrue: - [invocation := self importer factory invocation new. - invocation sender: self methodEntity. - - invocation signature: (FamixSmalltalkNameResolver signatureFromSmalltalkSelectorOn: aMessageNode selector). - "invocation - setInvokes: - (FAMIXNameResolver signatureFromSmalltalkSelector: aMessageNode selector)." - aMessageNode receiver isVariable - ifTrue: - [invocation - receiver: (self resolve: aMessageNode receiver name asString)]. - "aMessageNode receiver isVariable - ifTrue: - [invocation - setReceivingVariable: (self resolve: aMessageNode receiver name)]. " - aMessageNode selector == #subclassResponsibility - ifTrue: [self methodEntity isAbstract: true]. - importer addEntity: invocation]. - (aMessageNode isCascaded not or: [aMessageNode isFirstCascaded]) - ifTrue: [self visitNode: aMessageNode receiver]. - importer importingContext shouldImportArgument - ifTrue: [aMessageNode arguments do: [:each | self visitNode: each]]. - self extractCommentsFromNode: aMessageNode -] - -{ #category : #'visitor-double dispatching' } -AbstractSmalltalkMethodVisitor >> visitMethodNode: aMethodNode [ - - importer importingContext shouldImportArgument - ifTrue: - [aMethodNode arguments - do: - [:aVariableNode | | argument | - argument := self importer factory parameter new. - argument name: aVariableNode name asSymbol. - argument parentBehaviouralEntity: self methodEntity. - importer addEntity: argument. - methodScope - at: aVariableNode name - bind: argument]]. - self extractCommentsFromNode: aMethodNode. - self visitNode: aMethodNode body. - aMethodNode pragmas - do: [ :each | self visitNode: each ]. - - "recognize getters/setters/constructors/..." - self classifyMethodNode: aMethodNode -] - -{ #category : #'visitor-double dispatching' } -AbstractSmalltalkMethodVisitor >> visitPragmaNode: aPragmaNode [ - | annotationInstance annotationType | - annotationType := self importer ensureAnnotationType: aPragmaNode. - annotationInstance := self importer factory annotationInstance new. - annotationInstance annotationType: annotationType. - self importer addEntity: annotationInstance. - annotationInstance annotatedEntity: self methodEntity. - aPragmaNode arguments doWithIndex: [:each :i | - | attribute | - attribute := self importer factory annotationInstanceAttribute new. - attribute value: each value. - attribute parentAnnotationInstance: annotationInstance. - attribute annotationTypeAttribute: (annotationInstance annotationType attributes at: i). - self importer addEntity: attribute ] -] - -{ #category : #'visitor-double dispatching' } -AbstractSmalltalkMethodVisitor >> visitReturnNode: aReturnNode [ - - self visitNode: aReturnNode value. - self extractCommentsFromNode: aReturnNode -] - -{ #category : #'visitor-double dispatching' } -AbstractSmalltalkMethodVisitor >> visitSequenceNode: aSequenceNode [ - "self visitArguments: aSequenceNode temporaries." - - | local | - importer importingContext shouldImportLocalVariable - ifTrue: - [aSequenceNode temporaries - do: - [:aVariableNode | - local := self importer factory localVariable new. - local name: aVariableNode name asSymbol. - local parentBehaviouralEntity: self methodEntity. - importer addEntity: local. - methodScope - at: aVariableNode name - bind: local]]. - self extractCommentsFromNode: aSequenceNode. - aSequenceNode statements do: [:each | self visitNode: each] -] - -{ #category : #'visitor-double dispatching' } -AbstractSmalltalkMethodVisitor >> visitVariableNode: aVariableNode [ - importer importingContext shouldImportAccess - ifTrue: [ | access namedEntity global | - "Warning! Smalltalk is both a Namespace and a GlobalVariable. - By default the importer resolves Smalltalk to the namespace (for class and namespace creation). - When we access Smalltalk as a variable, we create an access to the SmalltalkGlobalVariable instead" - access := aVariableNode name = 'Smalltalk' - ifTrue: [ global := importer ensureGlobalVariable: #SmalltalkGlobalVariable value: Smalltalk. - self createAccessTo: global writing: false ] - ifFalse: [ namedEntity := self resolve: aVariableNode name. - (namedEntity isKindOf: self importer factory classEntity) - ifTrue: [ self createReferenceTo: namedEntity ] - ifFalse: [ self createAccessTo: namedEntity writing: false ] ]. - importer addEntity: access ]. - self extractCommentsFromNode: aVariableNode -] diff --git a/src/Moose-SmalltalkImporter/MonticelloMethodVisitor.class.st b/src/Moose-SmalltalkImporter/MonticelloMethodVisitor.class.st deleted file mode 100644 index 8254d0fd..00000000 --- a/src/Moose-SmalltalkImporter/MonticelloMethodVisitor.class.st +++ /dev/null @@ -1,17 +0,0 @@ -Class { - #name : #MonticelloMethodVisitor, - #superclass : #AbstractSmalltalkMethodVisitor, - #category : #'Moose-SmalltalkImporter' -} - -{ #category : #private } -MonticelloMethodVisitor >> resolve: name [ - "Return a famix entity that correspond to the reference 'name' contained in a source code. It does the lookup according to the Smalltalk semantics" - - | object | - (name = 'self' or: [ name = 'super' or: [ name = 'thisContext' ] ]) ifTrue: [ ^ importer ensureImplicitVariable: name asSymbol inFamixMethod: famixMethod ]. - object := methodScope resolve: name ifAbsent: nil. - object ifNotNil: [ ^ object ]. - - ^ importer ensureClass: name asSymbol -] diff --git a/src/Moose-SmalltalkImporter/SmalltalkMethodVisitor.class.st b/src/Moose-SmalltalkImporter/SmalltalkMethodVisitor.class.st index 31c37a46..33c72580 100644 --- a/src/Moose-SmalltalkImporter/SmalltalkMethodVisitor.class.st +++ b/src/Moose-SmalltalkImporter/SmalltalkMethodVisitor.class.st @@ -1,14 +1,147 @@ Class { #name : #SmalltalkMethodVisitor, - #superclass : #AbstractSmalltalkMethodVisitor, + #superclass : #RBProgramNodeVisitor, + #instVars : [ + 'theClass', + 'importer', + 'methodScope', + 'famixMethod' + ], #category : #'Moose-SmalltalkImporter' } +{ #category : #'instance creation' } +SmalltalkMethodVisitor class >> on: importer [ + + ^ self new + importer: importer; + yourself +] + { #category : #private } SmalltalkMethodVisitor >> CIVString [ ^ FamixStImporter CIVString ] +{ #category : #'method-classifying' } +SmalltalkMethodVisitor >> classifyMethodNode: aMethodNode [ + + self matchGetter: aMethodNode. + self matchSetter: aMethodNode. + self matchConstructor: aMethodNode. + self matchConstant: aMethodNode +] + +{ #category : #visiting } +SmalltalkMethodVisitor >> createAccessTo: aNamedEntity writing: isWriteAccess [ + + ^ self factory access new + isWrite: isWriteAccess; + variable: aNamedEntity; + accessor: self methodEntity; + yourself +] + +{ #category : #visiting } +SmalltalkMethodVisitor >> createReferenceTo: aNamedEntity [ + + ^ self factory reference source: self methodEntity target: (self resolveInstanceSide: aNamedEntity) +] + +{ #category : #'method-classifying' } +SmalltalkMethodVisitor >> extractCommentsFromNode: aSequenceNode [ + + importer importingContext shouldImportComment ifTrue: [ + aSequenceNode comments do: [ :comment | + importer addEntity: (self factory comment new + content: (aSequenceNode source copyFrom: comment start to: comment stop) asString; + commentedEntity: self methodEntity; + yourself) ] ] +] + +{ #category : #accessing } +SmalltalkMethodVisitor >> factory [ + + ^ self importer factory +] + +{ #category : #accessing } +SmalltalkMethodVisitor >> importer [ + + ^importer +] + +{ #category : #accessing } +SmalltalkMethodVisitor >> importer: anObject [ + + importer := anObject +] + +{ #category : #initialization } +SmalltalkMethodVisitor >> initializeForMethod: aMethod inClass: aClass [ + theClass := aClass. + famixMethod := aMethod. + methodScope := SmalltalkScope extend: (importer scopeOfClass: aClass). + +] + +{ #category : #'method-classifying' } +SmalltalkMethodVisitor >> matchConstant: aMethodNode [ + + aMethodNode body isSequence ifTrue: [ + aMethodNode body statements ifNotEmpty: [ :statements | + statements last isReturn ifTrue: [ statements last value isLiteralNode ifTrue: [ famixMethod beConstant ] ] ] ] +] + +{ #category : #'method-classifying' } +SmalltalkMethodVisitor >> matchConstructor: aMethodNode [ + + famixMethod protocol ifNotNil: [ + ('*instance*creation*' match: famixMethod protocol asLowercase) + ifTrue: [ famixMethod beConstructor ] ] +] + +{ #category : #'method-classifying' } +SmalltalkMethodVisitor >> matchGetter: aMethodNode [ + + aMethodNode arguments ifNotEmpty: [ ^ self ]. + aMethodNode body isSequence ifTrue: [ + aMethodNode body statements size = 1 ifTrue: [ + | return | + return := aMethodNode body statements first. + return isReturn ifTrue: [ + return value isVariable ifTrue: [ + (methodScope resolve: return value name ifAbsent: [ nil ]) ifNotNil: [ :attribute | + attribute class = self importer factory attribute ifTrue: [ famixMethod beGetter ] ] ] ] ] ] +] + +{ #category : #'method-classifying' } +SmalltalkMethodVisitor >> matchSetter: aMethodNode [ + + | assignment | + aMethodNode arguments size = 1 ifTrue: [ + aMethodNode body isSequence ifTrue: [ + aMethodNode body statements size = 1 ifTrue: [ + assignment := aMethodNode body statements first. + assignment isReturn ifTrue: [ assignment := assignment value ]. + assignment isAssignment ifTrue: [ + (methodScope resolve: assignment variable name ifAbsent: [ nil ]) ifNotNil: [ :attribute | + attribute class = self importer factory attribute ifTrue: [ + assignment value isVariable ifTrue: [ assignment value name = aMethodNode arguments first name ifTrue: [ famixMethod beSetter ] ] ] ] ] ] ] ] +] + +{ #category : #accessing } +SmalltalkMethodVisitor >> methodEntity [ + + ^famixMethod +] + +{ #category : #private } +SmalltalkMethodVisitor >> parseTreeForSource: methodSourceString [ + + ^ RBParser parseMethod: methodSourceString onError: [ :aString :pos | ^ nil ] +] + { #category : #private } SmalltalkMethodVisitor >> resolve: name [ "Return a famix entity that correspond to the reference 'name' contained in a source code. It does the lookup according to the Smalltalk semantics" @@ -30,3 +163,176 @@ SmalltalkMethodVisitor >> resolve: name [ object isBehavior ifTrue: [ ^ importer ensureClass: object class ]. ^ importer ensureGlobalVariable: name asSymbol value: object ] + +{ #category : #visiting } +SmalltalkMethodVisitor >> resolveInstanceSide: aNamedEntity [ + "We ensure that a reference to a metaclass is considered as a reference to the class itself" + + ^ ((aNamedEntity isKindOf: self importer factory classEntity) and: [ '*_class' match: aNamedEntity name ]) + ifTrue: [ | className | + className := aNamedEntity name removeSuffix: '_class'. + importer ensureClass: (Smalltalk at: className asSymbol) ] + ifFalse: [ aNamedEntity ] +] + +{ #category : #accessing } +SmalltalkMethodVisitor >> runWith: aCompiledMethod and: anEntity [ + + | parseTree | + self + initializeForMethod: anEntity + inClass: aCompiledMethod methodClass. + + parseTree := theClass parseTreeForSelector: aCompiledMethod selector. + parseTree ifNotNil: [ + self visitMethodNode: parseTree "sourceCodeAt:" ] +] + +{ #category : #accessing } +SmalltalkMethodVisitor >> runWithSource: sourceAsString and: aFamixMethod [ + | parseTree | + self initializeForMethod: aFamixMethod inClass: aFamixMethod parentType. + + parseTree := self parseTreeForSource: sourceAsString. + parseTree ifNotNil: [self visitMethodNode: parseTree] "sourceCodeAt:" +] + +{ #category : #visiting } +SmalltalkMethodVisitor >> visitAssignmentNode: anAssignmentNode [ + + | access | + importer importingContext shouldImportAccess ifTrue: [ + access := self factory access new. + access isWrite: true. + access variable: (self resolve: anAssignmentNode variable name). + access accessor: self methodEntity. + importer addEntity: access ]. + self extractCommentsFromNode: anAssignmentNode. + self visitNode: anAssignmentNode value +] + +{ #category : #visiting } +SmalltalkMethodVisitor >> visitBlockNode: aBlockNode [ + + | local | + importer importingContext shouldImportLocalVariable ifTrue: [ + aBlockNode arguments do: [ :aVariableNode | + local := self factory localVariable new. + local name: aVariableNode name asSymbol. + local parentBehaviouralEntity: self methodEntity. + importer addEntity: local. + methodScope at: aVariableNode name bind: local ] ]. + self extractCommentsFromNode: aBlockNode. "self visitArguments: aBlockNode arguments." + self visitNode: aBlockNode body +] + +{ #category : #visiting } +SmalltalkMethodVisitor >> visitCascadeNode: aCascadeNode [ + aCascadeNode messages ifNotEmpty: [ :messages | messages do: [ :each | self visitNode: each ] ]. + self extractCommentsFromNode: aCascadeNode +] + +{ #category : #visiting } +SmalltalkMethodVisitor >> visitMessageNode: aMessageNode [ + + | invocation | + importer importingContext shouldImportInvocation ifTrue: [ + invocation := self factory invocation new. + invocation sender: self methodEntity. + + invocation signature: (FamixSmalltalkNameResolver signatureFromSmalltalkSelectorOn: aMessageNode selector). + "invocation + setInvokes: + (FAMIXNameResolver signatureFromSmalltalkSelector: aMessageNode selector)." + aMessageNode receiver isVariable ifTrue: [ invocation receiver: (self resolve: aMessageNode receiver name asString) ]. + "aMessageNode receiver isVariable + ifTrue: + [invocation + setReceivingVariable: (self resolve: aMessageNode receiver name)]. " + aMessageNode selector == #subclassResponsibility ifTrue: [ self methodEntity isAbstract: true ]. + importer addEntity: invocation ]. + (aMessageNode isCascaded not or: [ aMessageNode isFirstCascaded ]) ifTrue: [ self visitNode: aMessageNode receiver ]. + importer importingContext shouldImportArgument ifTrue: [ aMessageNode arguments do: [ :each | self visitNode: each ] ]. + self extractCommentsFromNode: aMessageNode +] + +{ #category : #visiting } +SmalltalkMethodVisitor >> visitMethodNode: aMethodNode [ + + importer importingContext shouldImportArgument ifTrue: [ + aMethodNode arguments do: [ :aVariableNode | + | argument | + argument := self factory parameter new. + argument name: aVariableNode name asSymbol. + argument parentBehaviouralEntity: self methodEntity. + importer addEntity: argument. + methodScope at: aVariableNode name bind: argument ] ]. + self extractCommentsFromNode: aMethodNode. + self visitNode: aMethodNode body. + aMethodNode pragmas do: [ :each | self visitNode: each ]. + + "recognize getters/setters/constructors/..." + self classifyMethodNode: aMethodNode +] + +{ #category : #visiting } +SmalltalkMethodVisitor >> visitPragmaNode: aPragmaNode [ + + | annotationInstance annotationType | + annotationType := self importer ensureAnnotationType: aPragmaNode. + annotationInstance := self importer factory annotationInstance new. + annotationInstance annotationType: annotationType. + self importer addEntity: annotationInstance. + annotationInstance annotatedEntity: self methodEntity. + aPragmaNode arguments doWithIndex: [ :each :i | + | attribute | + attribute := self factory annotationInstanceAttribute new. + attribute value: each value. + attribute parentAnnotationInstance: annotationInstance. + attribute annotationTypeAttribute: (annotationInstance annotationType attributes at: i). + self importer addEntity: attribute ] +] + +{ #category : #visiting } +SmalltalkMethodVisitor >> visitReturnNode: aReturnNode [ + + self visitNode: aReturnNode value. + self extractCommentsFromNode: aReturnNode +] + +{ #category : #visiting } +SmalltalkMethodVisitor >> visitSequenceNode: aSequenceNode [ + "self visitArguments: aSequenceNode temporaries." + + | local | + importer importingContext shouldImportLocalVariable ifTrue: [ + aSequenceNode temporaries do: [ :aVariableNode | + local := self factory localVariable new. + local name: aVariableNode name asSymbol. + local parentBehaviouralEntity: self methodEntity. + importer addEntity: local. + methodScope at: aVariableNode name bind: local ] ]. + self extractCommentsFromNode: aSequenceNode. + aSequenceNode statements do: [ :each | self visitNode: each ] +] + +{ #category : #visiting } +SmalltalkMethodVisitor >> visitVariableNode: aVariableNode [ + + importer importingContext shouldImportAccess ifTrue: [ + | access namedEntity global | + "Warning! Smalltalk is both a Namespace and a GlobalVariable. + By default the importer resolves Smalltalk to the namespace (for class and namespace creation). + When we access Smalltalk as a variable, we create an access to the SmalltalkGlobalVariable instead" + access := aVariableNode name = 'Smalltalk' + ifTrue: [ + global := importer ensureGlobalVariable: #SmalltalkGlobalVariable value: Smalltalk. + self createAccessTo: global writing: false ] + ifFalse: [ + namedEntity := self resolve: aVariableNode name. + (namedEntity isKindOf: self factory classEntity) + ifTrue: [ self createReferenceTo: namedEntity ] + ifFalse: [ self createAccessTo: namedEntity writing: false ] ]. + importer addEntity: access ]. + self extractCommentsFromNode: aVariableNode +] From 3b8916f704cf0617a224c790b8b607acd03d7b91 Mon Sep 17 00:00:00 2001 From: uNouss Date: Fri, 28 Jun 2024 11:43:16 +0200 Subject: [PATCH 06/11] Fix #784 --- .../FamixMetamodelGenerator.class.st | 30 +++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/src/Famix-MetamodelBuilder-Core/FamixMetamodelGenerator.class.st b/src/Famix-MetamodelBuilder-Core/FamixMetamodelGenerator.class.st index bb22e8b8..d53beaee 100644 --- a/src/Famix-MetamodelBuilder-Core/FamixMetamodelGenerator.class.st +++ b/src/Famix-MetamodelBuilder-Core/FamixMetamodelGenerator.class.st @@ -336,11 +336,41 @@ FamixMetamodelGenerator >> mooseModelName [ ^ self class mooseModelName ] +{ #category : #definition } +FamixMetamodelGenerator >> newAbstractClassNamed: aClassName [ + + ^ builder newAbstractClassNamed: aClassName +] + { #category : #definition } FamixMetamodelGenerator >> newBuilder [ ^ FamixMetamodelBuilder forGenerator: self ] +{ #category : #definition } +FamixMetamodelGenerator >> newClassNamed: aClassName [ + + ^ builder newClassNamed: aClassName +] + +{ #category : #definition } +FamixMetamodelGenerator >> newClassNamed: aClassName comment: aComment [ + + ^ builder newClassNamed: aClassName comment: aComment +] + +{ #category : #definition } +FamixMetamodelGenerator >> newTraitNamed: aTraitName [ + + ^ builder newTraitNamed: aTraitName +] + +{ #category : #definition } +FamixMetamodelGenerator >> newTraitNamed: aClassName comment: aString [ + + ^ builder newTraitNamed: aClassName comment: aString +] + { #category : #definition } FamixMetamodelGenerator >> packageName [ From 0d2ea00280f69baed59555b1c4d0ddcc27a5faad Mon Sep 17 00:00:00 2001 From: uNouss Date: Fri, 28 Jun 2024 13:53:48 +0200 Subject: [PATCH 07/11] Fix #784 Add missing method --- .../FamixMetamodelGenerator.class.st | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/src/Famix-MetamodelBuilder-Core/FamixMetamodelGenerator.class.st b/src/Famix-MetamodelBuilder-Core/FamixMetamodelGenerator.class.st index d53beaee..4cefda83 100644 --- a/src/Famix-MetamodelBuilder-Core/FamixMetamodelGenerator.class.st +++ b/src/Famix-MetamodelBuilder-Core/FamixMetamodelGenerator.class.st @@ -342,6 +342,12 @@ FamixMetamodelGenerator >> newAbstractClassNamed: aClassName [ ^ builder newAbstractClassNamed: aClassName ] +{ #category : #definition } +FamixMetamodelGenerator >> newAbstractClassNamed: aClassName comment: aComment [ + + ^ builder newAbstractClassNamed: aClassName comment: aComment +] + { #category : #definition } FamixMetamodelGenerator >> newBuilder [ ^ FamixMetamodelBuilder forGenerator: self From 40eefbca9c7b85b27dc6b4aab8b41c756f66d55c Mon Sep 17 00:00:00 2001 From: uNouss Date: Fri, 28 Jun 2024 13:54:45 +0200 Subject: [PATCH 08/11] Regeneration of metamodel for Famix java --- .../FamixJavaGenerator.class.st | 80 +++++++++---------- 1 file changed, 40 insertions(+), 40 deletions(-) diff --git a/src/Famix-Java-Generator/FamixJavaGenerator.class.st b/src/Famix-Java-Generator/FamixJavaGenerator.class.st index f0a9c694..9f8a2966 100644 --- a/src/Famix-Java-Generator/FamixJavaGenerator.class.st +++ b/src/Famix-Java-Generator/FamixJavaGenerator.class.st @@ -134,43 +134,43 @@ FamixJavaGenerator >> defineClasses [ super defineClasses. - access := builder newClassNamed: #Access. - annotationInstance := builder newClassNamed: #AnnotationInstance. - annotationInstanceAttribute := builder newClassNamed: #AnnotationInstanceAttribute. - annotationType := builder newClassNamed: #AnnotationType. - annotationTypeAttribute := builder newClassNamed: #AnnotationTypeAttribute. - attribute := builder newClassNamed: #Attribute. - class := builder newClassNamed: #Class. - interface := builder newClassNamed: #Interface. + access := self newClassNamed: #Access. + annotationInstance := self newClassNamed: #AnnotationInstance. + annotationInstanceAttribute := self newClassNamed: #AnnotationInstanceAttribute. + annotationType := self newClassNamed: #AnnotationType. + annotationTypeAttribute := self newClassNamed: #AnnotationTypeAttribute. + attribute := self newClassNamed: #Attribute. + class := self newClassNamed: #Class. + interface := self newClassNamed: #Interface. interface withTesting. - implementation := builder newClassNamed: #Implementation. - containerEntity := builder newAbstractClassNamed: #ContainerEntity. - enum := builder newClassNamed: #Enum. - enumValue := builder newClassNamed: #EnumValue. - exception := builder newClassNamed: #Exception. - implicitVariable := builder newClassNamed: #ImplicitVariable. - import := builder newClassNamed: #Import. - indexedFileAnchor := builder newClassNamed: #IndexedFileAnchor. - inheritance := builder newClassNamed: #Inheritance. - invocation := builder newClassNamed: #Invocation. - localVariable := builder newClassNamed: #LocalVariable. - method := builder newClassNamed: #Method. - package := builder newClassNamed: #Package. - parameter := builder newClassNamed: #Parameter. - parameterType := builder newClassNamed: #ParameterType. - primitiveType := builder newClassNamed: #PrimitiveType. + implementation := self newClassNamed: #Implementation. + containerEntity := self newAbstractClassNamed: #ContainerEntity. + enum := self newClassNamed: #Enum. + enumValue := self newClassNamed: #EnumValue. + exception := self newClassNamed: #Exception. + implicitVariable := self newClassNamed: #ImplicitVariable. + import := self newClassNamed: #Import. + indexedFileAnchor := self newClassNamed: #IndexedFileAnchor. + inheritance := self newClassNamed: #Inheritance. + invocation := self newClassNamed: #Invocation. + localVariable := self newClassNamed: #LocalVariable. + method := self newClassNamed: #Method. + package := self newClassNamed: #Package. + parameter := self newClassNamed: #Parameter. + parameterType := self newClassNamed: #ParameterType. + primitiveType := self newClassNamed: #PrimitiveType. primitiveType withTesting. - reference := builder newClassNamed: #Reference. - type := builder newClassNamed: #Type. - unknownVariable := builder newClassNamed: #UnknownVariable. + reference := self newClassNamed: #Reference. + type := self newClassNamed: #Type. + unknownVariable := self newClassNamed: #UnknownVariable. - parametricClass := builder newClassNamed: #ParametricClass. - parametricMethod := builder newClassNamed: #ParametricMethod. - parametricInterface := builder newClassNamed: #ParametricInterface. - parameterConcretization := builder newClassNamed: #ParameterConcretization. + parametricClass := self newClassNamed: #ParametricClass. + parametricMethod := self newClassNamed: #ParametricMethod. + parametricInterface := self newClassNamed: #ParametricInterface. + parameterConcretization := self newClassNamed: #ParameterConcretization. - concretization := builder newClassNamed: #Concretization. - wildcard := builder newClassNamed: #Wildcard. + concretization := self newClassNamed: #Concretization. + wildcard := self newClassNamed: #Wildcard. ] { #category : #definition } @@ -392,22 +392,22 @@ FamixJavaGenerator >> defineRelations [ FamixJavaGenerator >> defineTraits [ super defineTraits. - tCanBeVolatile := builder newTraitNamed: #TCanBeVolatile. + tCanBeVolatile := self newTraitNamed: #TCanBeVolatile. tCanBeVolatile comment: self commentForTCanBeVolatile. - tCanBeTransient := builder newTraitNamed: #TCanBeTransient. + tCanBeTransient := self newTraitNamed: #TCanBeTransient. tCanBeTransient comment: self commentForTCanBeTransient. - tCanBeSynchronized := builder newTraitNamed: #TCanBeSynchronized. + tCanBeSynchronized := self newTraitNamed: #TCanBeSynchronized. tCanBeSynchronized comment: self commentForTCanBeSynchronized. - tWithInterfaces := builder newTraitNamed: #TWithInterfaces. + tWithInterfaces := self newTraitNamed: #TWithInterfaces. tWithInterfaces comment: self commentForTWithInterfaces. - tJavaClassMetrics := builder newTraitNamed: #TClassMetrics. + tJavaClassMetrics := self newTraitNamed: #TClassMetrics. - tBounded := builder newTraitNamed: #TBounded comment: self commentForTBounded. - tBound := builder newTraitNamed: #TBound comment: self commentForTBound. + tBounded := self newTraitNamed: #TBounded comment: self commentForTBounded. + tBound := self newTraitNamed: #TBound comment: self commentForTBound. ] { #category : #definition } From 798b4a499256be2b1a4445c36110040d2970e000 Mon Sep 17 00:00:00 2001 From: uNouss Date: Fri, 28 Jun 2024 13:55:11 +0200 Subject: [PATCH 09/11] Regeneration of metamodel for Famix pharo --- .../FamixPharoSmalltalkGenerator.class.st | 38 +++++++++---------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/src/Famix-PharoSmalltalk-Generator/FamixPharoSmalltalkGenerator.class.st b/src/Famix-PharoSmalltalk-Generator/FamixPharoSmalltalkGenerator.class.st index ce9c0292..2bdcbb1f 100644 --- a/src/Famix-PharoSmalltalk-Generator/FamixPharoSmalltalkGenerator.class.st +++ b/src/Famix-PharoSmalltalk-Generator/FamixPharoSmalltalkGenerator.class.st @@ -41,25 +41,25 @@ FamixPharoSmalltalkGenerator class >> prefix [ FamixPharoSmalltalkGenerator >> defineClasses [ super defineClasses. - access := builder newClassNamed: #Access. - annotationInstance := builder newClassNamed: #AnnotationInstance. - annotationInstanceAttribute := builder newClassNamed: #AnnotationInstanceAttribute. - annotationType := builder newClassNamed: #AnnotationType. - annotationTypeAttribute := builder newClassNamed: #AnnotationTypeAttribute. - attribute := builder newClassNamed: #Attribute. - class := builder newClassNamed: #Class. - globalVariable := builder newClassNamed: #GlobalVariable. - implicitVariable := builder newClassNamed: #ImplicitVariable. - inheritance := builder newClassNamed: #Inheritance. - invocation := builder newClassNamed: #Invocation. - localVariable := builder newClassNamed: #LocalVariable. - pharoEntitySourceAnchor := builder newClassNamed: #PharoEntitySourceAnchor. - method := builder newClassNamed: #Method. - namespace := builder newClassNamed: #Namespace. - package := builder newClassNamed: #Package. - parameter := builder newClassNamed: #Parameter. - reference := builder newClassNamed: #Reference. - unknownVariable := builder newClassNamed: #UnknownVariable. + access := self newClassNamed: #Access. + annotationInstance := self newClassNamed: #AnnotationInstance. + annotationInstanceAttribute := self newClassNamed: #AnnotationInstanceAttribute. + annotationType := self newClassNamed: #AnnotationType. + annotationTypeAttribute := self newClassNamed: #AnnotationTypeAttribute. + attribute := self newClassNamed: #Attribute. + class := self newClassNamed: #Class. + globalVariable := self newClassNamed: #GlobalVariable. + implicitVariable := self newClassNamed: #ImplicitVariable. + inheritance := self newClassNamed: #Inheritance. + invocation := self newClassNamed: #Invocation. + localVariable := self newClassNamed: #LocalVariable. + pharoEntitySourceAnchor := self newClassNamed: #PharoEntitySourceAnchor. + method := self newClassNamed: #Method. + namespace := self newClassNamed: #Namespace. + package := self newClassNamed: #Package. + parameter := self newClassNamed: #Parameter. + reference := self newClassNamed: #Reference. + unknownVariable := self newClassNamed: #UnknownVariable. ] From 8589e36119c407fdfad7098039a32a27b1b98ffe Mon Sep 17 00:00:00 2001 From: Benoit Verhaeghe Date: Fri, 28 Jun 2024 15:19:59 +0200 Subject: [PATCH 10/11] add tests equalitycheck --- .../FmxMBClass.class.st | 74 ++++++++++++++++++- .../FamixTest4Book.class.st | 35 +++++++++ .../FamixTest4Person.class.st | 51 +++++++++++++ .../FamixTest4School.class.st | 4 +- .../FamixTest4TEntityCreator.trait.st | 2 +- src/Famix-Test4-Tests/FamixTest4Test.class.st | 16 ++++ .../FamixTest4Generator.class.st | 10 ++- 7 files changed, 186 insertions(+), 6 deletions(-) diff --git a/src/Famix-MetamodelBuilder-Core/FmxMBClass.class.st b/src/Famix-MetamodelBuilder-Core/FmxMBClass.class.st index 8b629cff..ef13293f 100644 --- a/src/Famix-MetamodelBuilder-Core/FmxMBClass.class.st +++ b/src/Famix-MetamodelBuilder-Core/FmxMBClass.class.st @@ -3,7 +3,8 @@ Class { #superclass : #FmxMBBehavior, #instVars : [ 'classGeneralization', - 'isAbstractClass' + 'isAbstractClass', + 'propertiesForEqualityCheck' ], #category : #'Famix-MetamodelBuilder-Core-Implementation' } @@ -80,7 +81,70 @@ FmxMBClass >> generate [ self generatePrecedenceInTraitComposition: aClass. self generateNavigationGroupsFor: aClass. - self generateAddToCollectionFor: aClass + self generateAddToCollectionFor: aClass. + + self generateEqualsMethodFor: aClass. + self generateHashMethodFor: aClass. +] + +{ #category : #'generating-methods' } +FmxMBClass >> generateEqualsMethodFor: aClass [ + + propertiesForEqualityCheck ifNotNil: [ + | variableName | + variableName := 'a' , aClass name. + self builder environment + compile: (String streamContents: [ :stream | + stream << '= '. + stream << variableName. + stream << ' + + + ^ '. + stream + << variableName; + << ' '; + << propertiesForEqualityCheck first; + << ' = self '; + << propertiesForEqualityCheck first. + propertiesForEqualityCheck size > 1 ifTrue: [ + 2 to: propertiesForEqualityCheck size do: [ :idx | + stream << ' and: [ '. + stream + << variableName; + << ' '; + << (propertiesForEqualityCheck at: idx); + << ' = self '; + << (propertiesForEqualityCheck at: idx) ]. + 2 to: propertiesForEqualityCheck size do: [ :idx | + stream << '] ' ] ] ]) + in: aClass instanceSide + classified: #comparing ] +] + +{ #category : #'generating-methods' } +FmxMBClass >> generateHashMethodFor: aClass [ + + propertiesForEqualityCheck ifNotNil: [ + self builder environment + compile: (String streamContents: [ :stream | + stream << 'hash'. + stream << ' + + + ^ '. + stream + << 'self '; + << propertiesForEqualityCheck first; + << ' hash '. + propertiesForEqualityCheck size > 1 ifTrue: [ + 2 to: propertiesForEqualityCheck size do: [ :idx | + stream + << 'bitXor: self '; + << (propertiesForEqualityCheck at: idx); + << ' hash ' ] ] ]) + in: aClass instanceSide + classified: #comparing ] ] { #category : #generating } @@ -183,3 +247,9 @@ FmxMBClass >> traitsFromRelations [ ^ (self relations collect: [ :each | each side trait ] thenSelect: #isNotNil) asSet ] + +{ #category : #generalization } +FmxMBClass >> withEqualityCheckOn: aCollectionOfPropertySymbol [ + + propertiesForEqualityCheck := aCollectionOfPropertySymbol +] diff --git a/src/Famix-Test4-Entities/FamixTest4Book.class.st b/src/Famix-Test4-Entities/FamixTest4Book.class.st index 056b5e3c..08e29686 100644 --- a/src/Famix-Test4-Entities/FamixTest4Book.class.st +++ b/src/Famix-Test4-Entities/FamixTest4Book.class.st @@ -8,12 +8,19 @@ | `person` | `FamixTest4Book` | `books` | `FamixTest4Person` | | +## Properties +====================== + +| Name | Type | Default value | Comment | +|---| +| `id` | `Number` | nil | | " Class { #name : #FamixTest4Book, #superclass : #FamixTest4Entity, #instVars : [ + '#id => FMProperty', '#person => FMOne type: #FamixTest4Person opposite: #books' ], #category : #'Famix-Test4-Entities-Entities' @@ -28,6 +35,34 @@ FamixTest4Book class >> annotation [ ^ self ] +{ #category : #comparing } +FamixTest4Book >> = aFamixTest4Book [ + + + ^ aFamixTest4Book id = self id +] + +{ #category : #comparing } +FamixTest4Book >> hash [ + + + ^ self id hash +] + +{ #category : #accessing } +FamixTest4Book >> id [ + + + + ^ id +] + +{ #category : #accessing } +FamixTest4Book >> id: anObject [ + + id := anObject +] + { #category : #accessing } FamixTest4Book >> person [ "Relation named: #person type: #FamixTest4Person opposite: #books" diff --git a/src/Famix-Test4-Entities/FamixTest4Person.class.st b/src/Famix-Test4-Entities/FamixTest4Person.class.st index 8c838d3b..700c15d6 100644 --- a/src/Famix-Test4-Entities/FamixTest4Person.class.st +++ b/src/Famix-Test4-Entities/FamixTest4Person.class.st @@ -8,12 +8,21 @@ | `books` | `FamixTest4Person` | `person` | `FamixTest4Book` | | +## Properties +====================== + +| Name | Type | Default value | Comment | +|---| +| `firstName` | `String` | nil | | +| `lastName` | `String` | nil | | " Class { #name : #FamixTest4Person, #superclass : #FamixTest4Entity, #instVars : [ + '#firstName => FMProperty', + '#lastName => FMProperty', '#books => FMMany type: #FamixTest4Book opposite: #person' ], #category : #'Famix-Test4-Entities-Entities' @@ -36,6 +45,13 @@ FamixTest4Person class >> isAbstract [ ^ self == FamixTest4Person ] +{ #category : #comparing } +FamixTest4Person >> = aFamixTest4Person [ + + + ^ aFamixTest4Person firstName = self firstName and: [ aFamixTest4Person lastName = self lastName] +] + { #category : #adding } FamixTest4Person >> addBook: anObject [ @@ -64,3 +80,38 @@ FamixTest4Person >> booksGroup [ ^ MooseSpecializedGroup withAll: self books asSet ] + +{ #category : #accessing } +FamixTest4Person >> firstName [ + + + + ^ firstName +] + +{ #category : #accessing } +FamixTest4Person >> firstName: anObject [ + + firstName := anObject +] + +{ #category : #comparing } +FamixTest4Person >> hash [ + + + ^ self firstName hash bitXor: self lastName hash +] + +{ #category : #accessing } +FamixTest4Person >> lastName [ + + + + ^ lastName +] + +{ #category : #accessing } +FamixTest4Person >> lastName: anObject [ + + lastName := anObject +] diff --git a/src/Famix-Test4-Entities/FamixTest4School.class.st b/src/Famix-Test4-Entities/FamixTest4School.class.st index 78201eb2..a2bd008f 100644 --- a/src/Famix-Test4-Entities/FamixTest4School.class.st +++ b/src/Famix-Test4-Entities/FamixTest4School.class.st @@ -18,9 +18,9 @@ Class { #superclass : #FamixTest4Entity, #instVars : [ '#principal => FMOne type: #FamixTest4Principal opposite: #school', - '#rooms => FMMany type: #FamixTest4Room opposite: #school', '#students => FMMany type: #FamixTest4Student opposite: #school', - '#teachers => FMMany type: #FamixTest4Teacher opposite: #school' + '#teachers => FMMany type: #FamixTest4Teacher opposite: #school', + '#rooms => FMMany type: #FamixTest4Room opposite: #school' ], #category : #'Famix-Test4-Entities-Entities' } diff --git a/src/Famix-Test4-Entities/FamixTest4TEntityCreator.trait.st b/src/Famix-Test4-Entities/FamixTest4TEntityCreator.trait.st index 48ebb316..a1250005 100644 --- a/src/Famix-Test4-Entities/FamixTest4TEntityCreator.trait.st +++ b/src/Famix-Test4-Entities/FamixTest4TEntityCreator.trait.st @@ -6,7 +6,7 @@ It provides an API for creating entities and adding them to the model. " Trait { #name : #FamixTest4TEntityCreator, - #category : #'Famix-Test4-Entities-Traits' + #category : #'Famix-Test4-Entities-Model' } { #category : #meta } diff --git a/src/Famix-Test4-Tests/FamixTest4Test.class.st b/src/Famix-Test4-Tests/FamixTest4Test.class.st index 40a1f62a..e7f44246 100644 --- a/src/Famix-Test4-Tests/FamixTest4Test.class.st +++ b/src/Famix-Test4-Tests/FamixTest4Test.class.st @@ -33,9 +33,13 @@ FamixTest4Test >> setUp [ student1 := FamixTest4Student new. student1 := FamixTest4Student new. student2 := FamixTest4Student new. + student2 firstName: 'firstname'. + student2 lastName: 'lastName'. student3 := FamixTest4Student new. teacher1 := FamixTest4Teacher new. + teacher1 firstName: 'John'. teacher2 := FamixTest4Teacher new. + teacher2 firstName: 'Bob'. book1 := FamixTest4Book new. book2 := FamixTest4Book new. @@ -58,6 +62,18 @@ FamixTest4Test >> testAbstractClasses [ self assert: FamixTest4Person isAbstract ] +{ #category : #tests } +FamixTest4Test >> testEqualityStudent [ + + | sameStudent | + "A copy of student2 to test same" + sameStudent := FamixTest4Student new. + sameStudent firstName: 'firstname'. + sameStudent lastName: 'lastName'. + + self assert: student2 equals: sameStudent +] + { #category : #tests } FamixTest4Test >> testRelations [ self assert: (principal books includes: book2). diff --git a/src/Famix-TestGenerators/FamixTest4Generator.class.st b/src/Famix-TestGenerators/FamixTest4Generator.class.st index 1e310751..8de96885 100644 --- a/src/Famix-TestGenerators/FamixTest4Generator.class.st +++ b/src/Famix-TestGenerators/FamixTest4Generator.class.st @@ -69,9 +69,17 @@ FamixTest4Generator >> defineHierarchy [ { #category : #definition } FamixTest4Generator >> defineProperties [ + super defineProperties. - (builder ensureClassNamed: #Entity) property: #name type: #String + (builder ensureClassNamed: #Entity) property: #name type: #String. + + person property: #firstName type: #String. + person property: #lastName type: #String. + person withEqualityCheckOn: { #firstName. #lastName }. + + book property: #id type: #Number. + book withEqualityCheckOn: { #id } ] { #category : #definition } From 527523944d416b4ab306553718100bae985bcfbd Mon Sep 17 00:00:00 2001 From: Benoit Verhaeghe Date: Fri, 28 Jun 2024 15:32:43 +0200 Subject: [PATCH 11/11] more than two properties (for recursive and: in = check) --- .../FamixTest4Person.class.st | 20 +++++++++++++++++-- .../FamixTest4Generator.class.st | 3 ++- 2 files changed, 20 insertions(+), 3 deletions(-) diff --git a/src/Famix-Test4-Entities/FamixTest4Person.class.st b/src/Famix-Test4-Entities/FamixTest4Person.class.st index 700c15d6..d212e06e 100644 --- a/src/Famix-Test4-Entities/FamixTest4Person.class.st +++ b/src/Famix-Test4-Entities/FamixTest4Person.class.st @@ -13,6 +13,7 @@ | Name | Type | Default value | Comment | |---| +| `age` | `Number` | nil | | | `firstName` | `String` | nil | | | `lastName` | `String` | nil | | @@ -23,6 +24,7 @@ Class { #instVars : [ '#firstName => FMProperty', '#lastName => FMProperty', + '#age => FMProperty', '#books => FMMany type: #FamixTest4Book opposite: #person' ], #category : #'Famix-Test4-Entities-Entities' @@ -49,7 +51,7 @@ FamixTest4Person class >> isAbstract [ FamixTest4Person >> = aFamixTest4Person [ - ^ aFamixTest4Person firstName = self firstName and: [ aFamixTest4Person lastName = self lastName] + ^ aFamixTest4Person firstName = self firstName and: [ aFamixTest4Person lastName = self lastName and: [ aFamixTest4Person age = self age] ] ] { #category : #adding } @@ -58,6 +60,20 @@ FamixTest4Person >> addBook: anObject [ ^ self books add: anObject ] +{ #category : #accessing } +FamixTest4Person >> age [ + + + + ^ age +] + +{ #category : #accessing } +FamixTest4Person >> age: anObject [ + + age := anObject +] + { #category : #accessing } FamixTest4Person >> books [ "Relation named: #books type: #FamixTest4Book opposite: #person" @@ -99,7 +115,7 @@ FamixTest4Person >> firstName: anObject [ FamixTest4Person >> hash [ - ^ self firstName hash bitXor: self lastName hash + ^ self firstName hash bitXor: self lastName hash bitXor: self age hash ] { #category : #accessing } diff --git a/src/Famix-TestGenerators/FamixTest4Generator.class.st b/src/Famix-TestGenerators/FamixTest4Generator.class.st index 8de96885..b0cc9647 100644 --- a/src/Famix-TestGenerators/FamixTest4Generator.class.st +++ b/src/Famix-TestGenerators/FamixTest4Generator.class.st @@ -76,7 +76,8 @@ FamixTest4Generator >> defineProperties [ person property: #firstName type: #String. person property: #lastName type: #String. - person withEqualityCheckOn: { #firstName. #lastName }. + person property: #age type: #Number. + person withEqualityCheckOn: { #firstName. #lastName. #age }. book property: #id type: #Number. book withEqualityCheckOn: { #id }