diff --git a/src/FAST-Core-Tools-Tests/FASTCopyVisitorCodeGeneratorTest.class.st b/src/FAST-Core-Tools-Tests/FASTCopyVisitorCodeGeneratorTest.class.st index 3d06594..88e26eb 100644 --- a/src/FAST-Core-Tools-Tests/FASTCopyVisitorCodeGeneratorTest.class.st +++ b/src/FAST-Core-Tools-Tests/FASTCopyVisitorCodeGeneratorTest.class.st @@ -2,17 +2,19 @@ A FASTCopyVisitorCodeGeneratorTest is a test class for testing the behavior of FASTCopyVisitorCodeGenerator " Class { - #name : #FASTCopyVisitorCodeGeneratorTest, - #superclass : #TestCase, + #name : 'FASTCopyVisitorCodeGeneratorTest', + #superclass : 'TestCase', #instVars : [ 'visitorClass', 'visitorMethods', 'generator' ], - #category : #'FAST-Core-Tools-Tests-VisitorGenerator' + #category : 'FAST-Core-Tools-Tests-VisitorGenerator', + #package : 'FAST-Core-Tools-Tests', + #tag : 'VisitorGenerator' } -{ #category : #running } +{ #category : 'running' } FASTCopyVisitorCodeGeneratorTest >> assertGeneratedMethod: aBlock [ visitorMethods @@ -20,7 +22,7 @@ FASTCopyVisitorCodeGeneratorTest >> assertGeneratedMethod: aBlock [ ifNone: [ self fail ] ] -{ #category : #running } +{ #category : 'running' } FASTCopyVisitorCodeGeneratorTest >> setUp [ super setUp. @@ -33,7 +35,7 @@ FASTCopyVisitorCodeGeneratorTest >> setUp [ visitorMethods add: method -> category ] ] -{ #category : #tests } +{ #category : 'tests' } FASTCopyVisitorCodeGeneratorTest >> testGenerateCopyMethod [ generator rootClass: FmxTraitsTestGenerateAccessorBEntity visitorClass: visitorClass. @@ -42,7 +44,7 @@ FASTCopyVisitorCodeGeneratorTest >> testGenerateCopyMethod [ methodCode beginsWith: 'copy: ' ] ] -{ #category : #tests } +{ #category : 'tests' } FASTCopyVisitorCodeGeneratorTest >> testShouldCopyPropertyFor [ | property | @@ -51,12 +53,12 @@ FASTCopyVisitorCodeGeneratorTest >> testShouldCopyPropertyFor [ allProperties detect: [ :prop | prop name = 'relationToB' ]. generator package: (FmxTraitsTestGenerateAccessorBClassA metamodel packages detect: [ :p | p name = 'Famix-MetamodelBuilder-TestsTraitsResources-A' ]). - self assert: (generator shouldCopyProperty: property for: FmxTraitsTestGenerateAccessorBClassA). + self assert: (generator shouldCopyProperty: property). ] -{ #category : #tests } +{ #category : 'tests' } FASTCopyVisitorCodeGeneratorTest >> testShouldNotCopyDerivedProperty [ | property | @@ -65,10 +67,10 @@ FASTCopyVisitorCodeGeneratorTest >> testShouldNotCopyDerivedProperty [ allProperties detect: [ :prop | prop name = 'relationToA' ]. self assert: property isDerived. - self deny: (generator shouldCopyProperty: property for: FmxTraitsTestGenerateAccessorBClassB) + self deny: (generator shouldCopyProperty: property) ] -{ #category : #tests } +{ #category : 'tests' } FASTCopyVisitorCodeGeneratorTest >> testShouldNotCopyPropertyFromOtherPackage [ | property | @@ -77,5 +79,5 @@ FASTCopyVisitorCodeGeneratorTest >> testShouldNotCopyPropertyFromOtherPackage [ allProperties detect: [ :prop | prop name = 'relationToA' ]. generator package: (FmxTraitsTestGenerateAccessorBClassA metamodel packages detect: [ :p | p name = 'Famix-MetamodelBuilder-TestsTraitsResources-B' ]). - self assert: (generator shouldCopyProperty: property for: FmxTraitsTestGenerateAccessorBClassA) + self assert: (generator shouldCopyProperty: property) ] diff --git a/src/FAST-Core-Tools-Tests/FASTLocalResolverScopingTest.class.st b/src/FAST-Core-Tools-Tests/FASTLocalResolverScopingTest.class.st index 2859a77..4ed6b6c 100644 --- a/src/FAST-Core-Tools-Tests/FASTLocalResolverScopingTest.class.st +++ b/src/FAST-Core-Tools-Tests/FASTLocalResolverScopingTest.class.st @@ -2,22 +2,24 @@ A FASTLocalResolverScopingTest is a test class for testing the behavior of FASTLocalResolverScoping " Class { - #name : #FASTLocalResolverScopingTest, - #superclass : #TestCase, + #name : 'FASTLocalResolverScopingTest', + #superclass : 'TestCase', #instVars : [ 'resolverScoping' ], - #category : #'FAST-Core-Tools-Tests-Resolver' + #category : 'FAST-Core-Tools-Tests-Resolver', + #package : 'FAST-Core-Tools-Tests', + #tag : 'Resolver' } -{ #category : #running } +{ #category : 'running' } FASTLocalResolverScopingTest >> setUp [ super setUp. resolverScoping := FASTLocalResolverScoping new ] -{ #category : #tests } +{ #category : 'tests' } FASTLocalResolverScopingTest >> testAddNonLocalDeclaration [ "testing helper method #addNonLocalDeclaration:" resolverScoping resetScopes. @@ -32,7 +34,7 @@ FASTLocalResolverScopingTest >> testAddNonLocalDeclaration [ self assert: (resolverScoping findDeclaration: 'blah') class equals: FASTNonLocalDeclaration ] -{ #category : #tests } +{ #category : 'tests' } FASTLocalResolverScopingTest >> testFindDeclarationInCurrentScope [ |node| node := FASTEntity new. @@ -42,14 +44,14 @@ FASTLocalResolverScopingTest >> testFindDeclarationInCurrentScope [ self assert: (resolverScoping findDeclaration: 'blah') equals: node ] -{ #category : #tests } +{ #category : 'tests' } FASTLocalResolverScopingTest >> testFindDeclarationInEmptyScope [ resolverScoping resetScopes. self assert: (resolverScoping findDeclaration: 'blah') equals: nil. ] -{ #category : #tests } +{ #category : 'tests' } FASTLocalResolverScopingTest >> testFindDeclarationInParentScope [ |node| node := FASTEntity new. @@ -60,7 +62,7 @@ FASTLocalResolverScopingTest >> testFindDeclarationInParentScope [ self assert: (resolverScoping findDeclaration: 'blah') equals: node ] -{ #category : #tests } +{ #category : 'tests' } FASTLocalResolverScopingTest >> testFindDeclarationNotInScope [ |node| node := FASTEntity new. @@ -71,14 +73,14 @@ FASTLocalResolverScopingTest >> testFindDeclarationNotInScope [ ] -{ #category : #tests } +{ #category : 'tests' } FASTLocalResolverScopingTest >> testHasScopes [ "initialization creates a scope" self assert: resolverScoping hasScopes ] -{ #category : #tests } +{ #category : 'tests' } FASTLocalResolverScopingTest >> testLocalDeclarationFor [ "testing helper method #localDeclaration:for:" | declNode refNode | @@ -94,14 +96,14 @@ FASTLocalResolverScopingTest >> testLocalDeclarationFor [ self assert: declNode localUses first equals: refNode ] -{ #category : #tests } +{ #category : 'tests' } FASTLocalResolverScopingTest >> testResetScopes [ resolverScoping resetScopes. self assert: resolverScoping hasScopes. ] -{ #category : #tests } +{ #category : 'tests' } FASTLocalResolverScopingTest >> testScopeAddDeclarationTwiceRaisesError [ |node| node := FASTEntity new. @@ -116,7 +118,7 @@ FASTLocalResolverScopingTest >> testScopeAddDeclarationTwiceRaisesError [ raise: DuplicatedVariableError ] -{ #category : #tests } +{ #category : 'tests' } FASTLocalResolverScopingTest >> testScopeAddNonLocalDeclarationTwiceRaisesError [ |node| node := FASTEntity new. diff --git a/src/FAST-Core-Tools-Tests/package.st b/src/FAST-Core-Tools-Tests/package.st index b0de5a0..3a340f6 100644 --- a/src/FAST-Core-Tools-Tests/package.st +++ b/src/FAST-Core-Tools-Tests/package.st @@ -1 +1 @@ -Package { #name : #'FAST-Core-Tools-Tests' } +Package { #name : 'FAST-Core-Tools-Tests' } diff --git a/src/FAST-Core-Tools/FASTAbstractDifferentialValidator.class.st b/src/FAST-Core-Tools/FASTAbstractDifferentialValidator.class.st index d232a12..0bf7d5e 100644 --- a/src/FAST-Core-Tools/FASTAbstractDifferentialValidator.class.st +++ b/src/FAST-Core-Tools/FASTAbstractDifferentialValidator.class.st @@ -24,57 +24,59 @@ For this, a suitable `acceptableAST:differentFrom:` method should be defined tha There is a `skipPaths` list to allow skiping some paths in the main file directory " Class { - #name : #FASTAbstractDifferentialValidator, - #superclass : #FASTAbstractValidator, + #name : 'FASTAbstractDifferentialValidator', + #superclass : 'FASTAbstractValidator', #instVars : [ 'comparator' ], - #category : #'FAST-Core-Tools-Validator' + #category : 'FAST-Core-Tools-Validator', + #package : 'FAST-Core-Tools', + #tag : 'Validator' } -{ #category : #accessing } +{ #category : 'accessing' } FASTAbstractDifferentialValidator >> comparator [ ^comparator ifNil: [ comparator := self comparatorClass new ] ] -{ #category : #accessing } +{ #category : 'accessing' } FASTAbstractDifferentialValidator >> comparatorClass [ ^FamixModelComparator ] -{ #category : #running } +{ #category : 'running' } FASTAbstractDifferentialValidator >> compare: node1 to: node2 [ self comparator compare: node1 to: node2 ] -{ #category : #utilities } +{ #category : 'utilities' } FASTAbstractDifferentialValidator >> getASTFromFileReference: aFileReference [ ^self getTopLevelNodes: (super getASTFromFileReference: aFileReference) ] -{ #category : #utilities } +{ #category : 'utilities' } FASTAbstractDifferentialValidator >> getRootNode: aModel [ ^aModel detect: [ : e | e allParents isEmpty ] ] -{ #category : #utilities } +{ #category : 'utilities' } FASTAbstractDifferentialValidator >> getTopLevelNodes: model [ self subclassResponsibility ] -{ #category : #utilities } +{ #category : 'utilities' } FASTAbstractDifferentialValidator >> reExportAST: ast [ self subclassResponsibility ] -{ #category : #running } +{ #category : 'running' } FASTAbstractDifferentialValidator >> runOnSourceFile: aFileReference [ | astOrig astBis topLevelNodes | diff --git a/src/FAST-Core-Tools/FASTAbstractValidator.class.st b/src/FAST-Core-Tools/FASTAbstractValidator.class.st index 38ea112..d1d4ef3 100644 --- a/src/FAST-Core-Tools/FASTAbstractValidator.class.st +++ b/src/FAST-Core-Tools/FASTAbstractValidator.class.st @@ -1,33 +1,35 @@ Class { - #name : #FASTAbstractValidator, - #superclass : #Object, + #name : 'FASTAbstractValidator', + #superclass : 'Object', #instVars : [ 'skipPaths', 'encoding' ], - #category : #'FAST-Core-Tools-Validator' + #category : 'FAST-Core-Tools-Validator', + #package : 'FAST-Core-Tools', + #tag : 'Validator' } -{ #category : #accessing } +{ #category : 'accessing' } FASTAbstractValidator >> defaultEncoding [ "other possibilities are 'latin1', 'utf8', ... see `ZnCharacterEncoder knownEncodingIdentifiers` for all possibilities" ^encoding ifNil: [ 'iso-8859-1' ] ] -{ #category : #accessing } +{ #category : 'accessing' } FASTAbstractValidator >> encoding [ ^encoding ] -{ #category : #accessing } +{ #category : 'accessing' } FASTAbstractValidator >> encoding: aString [ encoding := aString ] -{ #category : #utilities } +{ #category : 'utilities' } FASTAbstractValidator >> getASTFromFileReference: aFileReference [ ^aFileReference readStreamEncoded: self defaultEncoding do: [ :stream | @@ -35,13 +37,13 @@ FASTAbstractValidator >> getASTFromFileReference: aFileReference [ ] -{ #category : #utilities } +{ #category : 'utilities' } FASTAbstractValidator >> getASTFromString: stream [ self subclassResponsibility ] -{ #category : #initialization } +{ #category : 'initialization' } FASTAbstractValidator >> initialize [ super initialize. @@ -49,19 +51,19 @@ FASTAbstractValidator >> initialize [ skipPaths := #(). ] -{ #category : #testing } +{ #category : 'testing' } FASTAbstractValidator >> isSourceFile: aFileReference [ self subclassResponsibility ] -{ #category : #'instance creation' } +{ #category : 'instance creation' } FASTAbstractValidator >> on: aDirectoryName [ self runOnFileReference: aDirectoryName asFileReference ] -{ #category : #running } +{ #category : 'running' } FASTAbstractValidator >> runOnDirectory: aDirectory [ aDirectory isDirectory @@ -70,7 +72,7 @@ FASTAbstractValidator >> runOnDirectory: aDirectory [ aDirectory children do: [ :fileRef | self runOnFileReference: fileRef ] ] -{ #category : #running } +{ #category : 'running' } FASTAbstractValidator >> runOnFileReference: aFileReference [ (self skipPaths includes: aFileReference fullName) @@ -84,19 +86,19 @@ FASTAbstractValidator >> runOnFileReference: aFileReference [ ] -{ #category : #testing } +{ #category : 'testing' } FASTAbstractValidator >> runOnSourceFile: aFileReference [ self subclassResponsibility ] -{ #category : #accessing } +{ #category : 'accessing' } FASTAbstractValidator >> skipPaths [ ^ skipPaths ] -{ #category : #accessing } +{ #category : 'accessing' } FASTAbstractValidator >> skipPaths: anObject [ skipPaths := anObject diff --git a/src/FAST-Core-Tools/FASTCopyVisitorCodeGenerator.class.st b/src/FAST-Core-Tools/FASTCopyVisitorCodeGenerator.class.st index d1e204a..9e0ac6d 100644 --- a/src/FAST-Core-Tools/FASTCopyVisitorCodeGenerator.class.st +++ b/src/FAST-Core-Tools/FASTCopyVisitorCodeGenerator.class.st @@ -1,5 +1,5 @@ " -I am generating a CopyVisitor that will create adeep copy of an AST for any meta-model +I am generating a CopyVisitor that will create a deep copy of an AST for any meta-model I generate the #visitXYZ: methods in the visitor. I assume the meta-model entities already have #accept: methods (generated by my superclass) @@ -11,28 +11,23 @@ FASTCopyVisitorCodeGenerator new " Class { - #name : #FASTCopyVisitorCodeGenerator, - #superclass : #FASTVisitorCodeGenerator, + #name : 'FASTCopyVisitorCodeGenerator', + #superclass : 'FASTVisitorCodeGenerator', #instVars : [ - 'metamodel', - 'package' + 'metamodel' ], - #category : #'FAST-Core-Tools-VisitorGenerator' + #category : 'FAST-Core-Tools-VisitorGenerator', + #package : 'FAST-Core-Tools', + #tag : 'VisitorGenerator' } -{ #category : #Fame } +{ #category : 'Fame' } FASTCopyVisitorCodeGenerator >> fmDescription: aModelClass [ ^metamodel descriptionOf: aModelClass ifAbsent: [ nil ] ] -{ #category : #Fame } -FASTCopyVisitorCodeGenerator >> fmPackage: aModelClass [ - - ^(self fmDescription: aModelClass) package -] - -{ #category : #Fame } +{ #category : 'Fame' } FASTCopyVisitorCodeGenerator >> fmSuperclass: aModelClass [ | superclass | @@ -43,23 +38,23 @@ FASTCopyVisitorCodeGenerator >> fmSuperclass: aModelClass [ ] -{ #category : #'code generation' } +{ #category : 'code generation' } FASTCopyVisitorCodeGenerator >> generateCopyMethod: aFASTVisitorClass [ - | code | - code := 'copy: aNode + aFASTVisitorClass + compile: +'copy: aNode + "Note: Pharo isLiterals are not copied, but FAST isLiteral are" aNode ifNil: [ ^nil ]. - aNode isLiteral ifTrue: [ ^aNode ]. + (aNode isLiteral and: [aNode isMooseEntity not]) ifTrue: [ ^aNode ]. aNode isCollection ifFalse: [ ^aNode accept: self ]. - ^aNode collect: [ :each | self copy: each ] -'. - - aFASTVisitorClass compile: code classified: #copying + ^aNode collect: [ :each | self copy: each ]' + classified: #copying ] -{ #category : #'code generation' } -FASTCopyVisitorCodeGenerator >> generateObjectCopy: aModelClass in: stream [ +{ #category : 'code generation' } +FASTCopyVisitorCodeGenerator >> generateObjectCopy: aModelClass on: stream [ stream tab; @@ -69,20 +64,20 @@ FASTCopyVisitorCodeGenerator >> generateObjectCopy: aModelClass in: stream [ cr ] -{ #category : #'code generation' } -FASTCopyVisitorCodeGenerator >> generatePropertiesCopy: aModelClass in: stream [ +{ #category : 'run' } +FASTCopyVisitorCodeGenerator >> generatePropertiesCopy: aModelClass on: stream [ (self fmDescription: aModelClass) ifNotNil: [ :fmDescription | fmDescription allProperties do: [ :property | - (self shouldCopyProperty: property for: aModelClass) - ifTrue: [ self generatePropertyCopy: property for: aModelClass in: stream ] + (self shouldCopyProperty: property) + ifTrue: [ self generatePropertyCopy: property owningClass: aModelClass on: stream ] ] ] ] -{ #category : #'code generation' } -FASTCopyVisitorCodeGenerator >> generatePropertyCopy: property for: aModelClass in: stream [ +{ #category : 'code generation' } +FASTCopyVisitorCodeGenerator >> generatePropertyCopy: property owningClass: aModelClass on: stream [ stream tab ; @@ -97,26 +92,11 @@ FASTCopyVisitorCodeGenerator >> generatePropertyCopy: property for: aModelClass ] -{ #category : #'code generation' } -FASTCopyVisitorCodeGenerator >> generateVisit: aModelClass in: aVisitorClass [ - - | code | - code := String streamContents: [ :outputStream | - self generateVisitSelectorFor: aModelClass in: outputStream. - self generatePragmaIn: outputStream. - outputStream cr. - - self generateVisitBody: aModelClass in: outputStream. - ]. +{ #category : 'run' } +FASTCopyVisitorCodeGenerator >> generateVisitForBodyOf: aModelClass on: stream [ - aVisitorClass compile: code classified: #visiting -] - -{ #category : #'code generation' } -FASTCopyVisitorCodeGenerator >> generateVisitBody: aModelClass in: stream [ - - self generateObjectCopy: aModelClass in: stream. - self generatePropertiesCopy: aModelClass in: stream. + self generateObjectCopy: aModelClass on: stream. + self generatePropertiesCopy: aModelClass on: stream. stream tab; tab; @@ -124,64 +104,61 @@ FASTCopyVisitorCodeGenerator >> generateVisitBody: aModelClass in: stream [ cr ] -{ #category : #'code generation' } -FASTCopyVisitorCodeGenerator >> generateVisitSelectorFor: aModelClass in: outputStream [ +{ #category : 'code generation' } +FASTCopyVisitorCodeGenerator >> generateVisitSelectorFor: aModelClass on: outputStream [ - self generateVisitSelectorFor: aModelClass parameter: (self asParameterName: aModelClass) in: outputStream + self generateVisitSelectorFor: aModelClass parameter: (self asParameterName: aModelClass) on: outputStream ] -{ #category : #Fame } -FASTCopyVisitorCodeGenerator >> isSamePackage: aFMProperty [ - - ^package = aFMProperty mmClass package -] - -{ #category : #'accessing - private tests' } +{ #category : 'accessing - private tests' } FASTCopyVisitorCodeGenerator >> metamodel [ ^ metamodel ] -{ #category : #'accessing - private tests' } +{ #category : 'accessing - private tests' } FASTCopyVisitorCodeGenerator >> metamodel: anObject [ metamodel := anObject ] -{ #category : #'accessing - private tests' } -FASTCopyVisitorCodeGenerator >> package [ - - ^ package -] - -{ #category : #'accessing - private tests' } -FASTCopyVisitorCodeGenerator >> package: anObject [ - - package := anObject -] - -{ #category : #run } +{ #category : 'run' } FASTCopyVisitorCodeGenerator >> rootClass: aFASTEntityClass visitorClass: aFASTVisitorClass [ self generateCopyMethod: aFASTVisitorClass. metamodel := aFASTEntityClass metamodel. - package := (self fmPackage: aFASTEntityClass). - aFASTEntityClass withAllSubclassesDo: [ :modelClass | - self generateVisit: modelClass in: aFASTVisitorClass. - ]. + super rootClass: aFASTEntityClass visitorClass: aFASTVisitorClass + ] -{ #category : #'code generation' } -FASTCopyVisitorCodeGenerator >> shouldCopyProperty: property for: aModelClass [ +{ #category : 'Fame' } +FASTCopyVisitorCodeGenerator >> shouldCopyProperty: property [ + "because relationships are bi-directional, we must take care of not copying all relations otherwise + we would enter in an endless recursive loop (note order of the checks is important as properties + often match several of these cases) + - do not copy properties that are derived + - copy properties without opposite (they are kind of primitive type properties) + - for parent/children properties, we make a copy of the children but not of the parent + - for relation, we copy only if we are source of the association + - multivalued properties are not copied, we will copy the other side (in hope it is 1-to-n) + - for 1-to-1 relation we have to choose one side (in a reproducible way), + we arbitrarily chose to copy the side thats comes first in alphabetical order" - (#(startPos endPos) anySatisfy: [ :specialCase | property name = specialCase ]) + ( #(startPos endPos) includes: property name ) ifTrue: [ ^true ]. - (property hasOpposite and: [ property isTarget ]) ifTrue: [ ^false]. + property hasOpposite ifFalse: [ ^property isDerived not ]. + property isContainer ifTrue: [ ^false]. - (self isSamePackage: property) ifFalse: [ ^false ]. + property opposite isContainer ifTrue: [ ^true]. + + property isSource ifTrue: [ ^true]. + property isTarget ifTrue: [ ^false]. + + property isMultivalued ifFalse: [ ^true ]. + property isDerived ifTrue: [ ^false]. - ^true + ^property name < property opposite name ] diff --git a/src/FAST-Core-Tools/FASTDifferentialValidator.class.st b/src/FAST-Core-Tools/FASTDifferentialValidator.class.st index cc54f17..efba4e9 100644 --- a/src/FAST-Core-Tools/FASTDifferentialValidator.class.st +++ b/src/FAST-Core-Tools/FASTDifferentialValidator.class.st @@ -24,54 +24,56 @@ For this, a suitable `acceptableAST:differentFrom:` method should be defined tha There is a `skipPaths` list to allow skiping some paths in the main file directory " Class { - #name : #FASTDifferentialValidator, - #superclass : #Object, + #name : 'FASTDifferentialValidator', + #superclass : 'Object', #instVars : [ 'skipPaths', 'comparator', 'encoding' ], - #category : #'FAST-Core-Tools-Validator' + #category : 'FAST-Core-Tools-Validator', + #package : 'FAST-Core-Tools', + #tag : 'Validator' } -{ #category : #accessing } +{ #category : 'accessing' } FASTDifferentialValidator >> comparator [ ^comparator ifNil: [ comparator := self comparatorClass new ] ] -{ #category : #accessing } +{ #category : 'accessing' } FASTDifferentialValidator >> comparatorClass [ ^FamixModelComparator ] -{ #category : #running } +{ #category : 'running' } FASTDifferentialValidator >> compare: node1 to: node2 [ self comparator compare: node1 to: node2 ] -{ #category : #accessing } +{ #category : 'accessing' } FASTDifferentialValidator >> defaultEncoding [ "other possibilities are 'latin1', 'utf8', ... see `ZnCharacterEncoder knownEncodingIdentifiers` for all possibilities" ^encoding ifNil: [ 'iso-8859-1' ] ] -{ #category : #accessing } +{ #category : 'accessing' } FASTDifferentialValidator >> encoding [ ^encoding ] -{ #category : #accessing } +{ #category : 'accessing' } FASTDifferentialValidator >> encoding: aString [ encoding := aString ] -{ #category : #utilities } +{ #category : 'utilities' } FASTDifferentialValidator >> getASTFromFileReference: aFileReference [ | model | @@ -81,25 +83,25 @@ FASTDifferentialValidator >> getASTFromFileReference: aFileReference [ ^self getTopLevelNodes: model ] -{ #category : #utilities } +{ #category : 'utilities' } FASTDifferentialValidator >> getASTFromString: stream [ self subclassResponsibility ] -{ #category : #utilities } +{ #category : 'utilities' } FASTDifferentialValidator >> getRootNode: aModel [ ^aModel detect: [ : e | e allParents isEmpty ] ] -{ #category : #utilities } +{ #category : 'utilities' } FASTDifferentialValidator >> getTopLevelNodes: model [ self subclassResponsibility ] -{ #category : #initialization } +{ #category : 'initialization' } FASTDifferentialValidator >> initialize [ super initialize. @@ -107,25 +109,25 @@ FASTDifferentialValidator >> initialize [ skipPaths := #(). ] -{ #category : #testing } +{ #category : 'testing' } FASTDifferentialValidator >> isSourceFile: aFileReference [ self subclassResponsibility ] -{ #category : #'instance creation' } +{ #category : 'instance creation' } FASTDifferentialValidator >> on: aDirectoryName [ self runOnFileReference: aDirectoryName asFileReference ] -{ #category : #utilities } +{ #category : 'utilities' } FASTDifferentialValidator >> reExportAST: ast [ self subclassResponsibility ] -{ #category : #running } +{ #category : 'running' } FASTDifferentialValidator >> runOnDirectory: aDirectory [ aDirectory isDirectory @@ -134,7 +136,7 @@ FASTDifferentialValidator >> runOnDirectory: aDirectory [ aDirectory children do: [ :fileRef | self runOnFileReference: fileRef ] ] -{ #category : #running } +{ #category : 'running' } FASTDifferentialValidator >> runOnFileReference: aFileReference [ (self skipPaths includes: aFileReference fullName) @@ -148,7 +150,7 @@ FASTDifferentialValidator >> runOnFileReference: aFileReference [ ] -{ #category : #running } +{ #category : 'running' } FASTDifferentialValidator >> runOnSourceFile: aFileReference [ | astOrig astBis topLevelNodes | @@ -174,13 +176,13 @@ FASTDifferentialValidator >> runOnSourceFile: aFileReference [ ] ] -{ #category : #accessing } +{ #category : 'accessing' } FASTDifferentialValidator >> skipPaths [ ^ skipPaths ] -{ #category : #accessing } +{ #category : 'accessing' } FASTDifferentialValidator >> skipPaths: anObject [ skipPaths := anObject diff --git a/src/FAST-Core-Tools/FASTDumpVisitor.class.st b/src/FAST-Core-Tools/FASTDumpVisitor.class.st index bdd1cbe..d67ef5a 100644 --- a/src/FAST-Core-Tools/FASTDumpVisitor.class.st +++ b/src/FAST-Core-Tools/FASTDumpVisitor.class.st @@ -2,16 +2,18 @@ I'm a visitor who generates code that, when executed, recreates the visited FAST nodes (similarly to `RBDumpVisitor` and the `storeOn:` protocol). " Class { - #name : #FASTDumpVisitor, - #superclass : #Object, + #name : 'FASTDumpVisitor', + #superclass : 'Object', #instVars : [ 'propertyCache', 'stream' ], - #category : #'FAST-Core-Tools-Visitor' + #category : 'FAST-Core-Tools-Visitor', + #package : 'FAST-Core-Tools', + #tag : 'Visitor' } -{ #category : #visiting } +{ #category : 'visiting' } FASTDumpVisitor class >> visit: aFASTEntity [ ^ self new @@ -19,20 +21,20 @@ FASTDumpVisitor class >> visit: aFASTEntity [ contents ] -{ #category : #accessing } +{ #category : 'accessing' } FASTDumpVisitor >> contents [ ^ stream contents ] -{ #category : #initialization } +{ #category : 'initialization' } FASTDumpVisitor >> initialize [ stream := String new writeStream. propertyCache := IdentityDictionary new ] -{ #category : #enumerating } +{ #category : 'enumerating' } FASTDumpVisitor >> propertiesAndValuesOf: aFASTEntity do: twoArgsBlock [ "Iterate over the attributes and child relations of the given entity." @@ -48,7 +50,7 @@ FASTDumpVisitor >> propertiesAndValuesOf: aFASTEntity do: twoArgsBlock [ thenDo: [ :property | twoArgsBlock value: property value: value ] ] -{ #category : #enumerating } +{ #category : 'enumerating' } FASTDumpVisitor >> propertiesOf: aFASTEntity [ ^ propertyCache @@ -56,13 +58,13 @@ FASTDumpVisitor >> propertiesOf: aFASTEntity [ ifAbsentPut: [ aFASTEntity allDeclaredProperties ] ] -{ #category : #accessing } +{ #category : 'accessing' } FASTDumpVisitor >> stream [ ^ stream ] -{ #category : #visiting } +{ #category : 'visiting' } FASTDumpVisitor >> visit: aFASTEntity [ | beforeFirst | @@ -82,7 +84,7 @@ FASTDumpVisitor >> visit: aFASTEntity [ ifFalse: [ "attribute" value printOn: stream ] ] ] -{ #category : #visiting } +{ #category : 'visiting' } FASTDumpVisitor >> visitChildren: children [ stream nextPut: ${. @@ -92,7 +94,7 @@ FASTDumpVisitor >> visitChildren: children [ stream nextPut: $} ] -{ #category : #visiting } +{ #category : 'visiting' } FASTDumpVisitor >> visitOnlyChild: aFASTEntity [ stream nextPut: $(. diff --git a/src/FAST-Core-Tools/FASTLocalResolverScoping.class.st b/src/FAST-Core-Tools/FASTLocalResolverScoping.class.st index 0df537d..09a7620 100644 --- a/src/FAST-Core-Tools/FASTLocalResolverScoping.class.st +++ b/src/FAST-Core-Tools/FASTLocalResolverScoping.class.st @@ -6,15 +6,17 @@ I can: - link variable uses to their declaration " Class { - #name : #FASTLocalResolverScoping, - #superclass : #FASTCoreVisitor, + #name : 'FASTLocalResolverScoping', + #superclass : 'FASTCoreVisitor', #instVars : [ 'scopes' ], - #category : #'FAST-Core-Tools-Resolver' + #category : 'FAST-Core-Tools-Resolver', + #package : 'FAST-Core-Tools', + #tag : 'Resolver' } -{ #category : #api } +{ #category : 'api' } FASTLocalResolverScoping >> bind: aFASTNode toLocalDeclaration: aName [ "reference to aName by aFASTNode - assuming the identifier refers to a variable (structuralEntity) @@ -29,13 +31,13 @@ FASTLocalResolverScoping >> bind: aFASTNode toLocalDeclaration: aName [ for: aFASTNode ] -{ #category : #accessing } +{ #category : 'accessing' } FASTLocalResolverScoping >> currentScope [ ^ scopes top ] -{ #category : #api } +{ #category : 'api' } FASTLocalResolverScoping >> findDeclaration: aName [ "search for 'aName' in the current scope and its parent. Returns nil if not found" @@ -52,49 +54,49 @@ FASTLocalResolverScoping >> findDeclaration: aName [ ] ] -{ #category : #accessing } +{ #category : 'accessing' } FASTLocalResolverScoping >> hasScopes [ ^scopes isNotEmpty ] -{ #category : #initialization } +{ #category : 'initialization' } FASTLocalResolverScoping >> initialize [ super initialize. self resetScopes ] -{ #category : #api } +{ #category : 'api' } FASTLocalResolverScoping >> localDeclaration: declarationNode for: referingNode [ referingNode localDeclaration: declarationNode. declarationNode addLocalUse: referingNode ] -{ #category : #private } +{ #category : 'private' } FASTLocalResolverScoping >> nonLocalDeclaration: name [ ^ FASTNonLocalDeclaration new name: name ] -{ #category : #accessing } +{ #category : 'accessing' } FASTLocalResolverScoping >> popScope [ ^scopes pop ] -{ #category : #accessing } +{ #category : 'accessing' } FASTLocalResolverScoping >> pushScope [ self pushScope: Dictionary new ] -{ #category : #accessing } +{ #category : 'accessing' } FASTLocalResolverScoping >> pushScope: aScope [ scopes push: aScope ] -{ #category : #accessing } +{ #category : 'accessing' } FASTLocalResolverScoping >> resetScopes [ scopes := Stack new. @@ -102,7 +104,7 @@ FASTLocalResolverScoping >> resetScopes [ self pushScope ] -{ #category : #api } +{ #category : 'api' } FASTLocalResolverScoping >> scopeAdd: aName declaration: aFASTNode [ self currentScope @@ -116,7 +118,7 @@ FASTLocalResolverScoping >> scopeAdd: aName declaration: aFASTNode [ ] -{ #category : #api } +{ #category : 'api' } FASTLocalResolverScoping >> scopeAddNonLocalDeclaration: name [ "makes a non-local declaration kind of local by adding a FASTNonLocalDeclaration into the current scope" diff --git a/src/FAST-Core-Tools/FASTLocalResolverVisitor.class.st b/src/FAST-Core-Tools/FASTLocalResolverVisitor.class.st index 949cc8f..efef866 100644 --- a/src/FAST-Core-Tools/FASTLocalResolverVisitor.class.st +++ b/src/FAST-Core-Tools/FASTLocalResolverVisitor.class.st @@ -12,28 +12,30 @@ FASTLocalResolverVisitor new on: aFASTJavaMethodEntity ``` " Class { - #name : #FASTLocalResolverVisitor, - #superclass : #FASTCoreVisitor, + #name : 'FASTLocalResolverVisitor', + #superclass : 'FASTCoreVisitor', #instVars : [ 'scoper' ], - #category : #'FAST-Core-Tools-Resolver' + #category : 'FAST-Core-Tools-Resolver', + #package : 'FAST-Core-Tools', + #tag : 'Resolver' } -{ #category : #initialization } +{ #category : 'initialization' } FASTLocalResolverVisitor >> initialize [ super initialize. scoper := FASTLocalResolverScoping new ] -{ #category : #api } +{ #category : 'api' } FASTLocalResolverVisitor >> on: aFASTBehaviouralEntity [ aFASTBehaviouralEntity accept: self ] -{ #category : #visiting } +{ #category : 'visiting' } FASTLocalResolverVisitor >> visitFASTIdentifierExpression: aFASTIdentifier [ "reference to an identifier in the AST that must be bound to its declaration" @@ -41,7 +43,7 @@ FASTLocalResolverVisitor >> visitFASTIdentifierExpression: aFASTIdentifier [ ] -{ #category : #visiting } +{ #category : 'visiting' } FASTLocalResolverVisitor >> visitFASTTStatementBlock: aFASTJavaStatementBlock [ scoper pushScope. diff --git a/src/FAST-Core-Tools/FASTNonLocalDeclaration.class.st b/src/FAST-Core-Tools/FASTNonLocalDeclaration.class.st index a449329..6a22e2d 100644 --- a/src/FAST-Core-Tools/FASTNonLocalDeclaration.class.st +++ b/src/FAST-Core-Tools/FASTNonLocalDeclaration.class.st @@ -2,29 +2,31 @@ A ""null-object"" signaling the declaration of a 'name' was not found " Class { - #name : #FASTNonLocalDeclaration, - #superclass : #FASTEntity, + #name : 'FASTNonLocalDeclaration', + #superclass : 'FASTEntity', #traits : 'FASTTEntity', #classTraits : 'FASTTEntity classTrait', #instVars : [ 'name' ], - #category : #'FAST-Core-Tools-Resolver' + #category : 'FAST-Core-Tools-Resolver', + #package : 'FAST-Core-Tools', + #tag : 'Resolver' } -{ #category : #testing } +{ #category : 'testing' } FASTNonLocalDeclaration >> isNonLocalDeclaration [ ^true ] -{ #category : #accessing } +{ #category : 'accessing' } FASTNonLocalDeclaration >> name [ ^ name ] -{ #category : #accessing } +{ #category : 'accessing' } FASTNonLocalDeclaration >> name: anObject [ name := anObject diff --git a/src/FAST-Core-Tools/FASTTEntity.extension.st b/src/FAST-Core-Tools/FASTTEntity.extension.st index f44d90d..26b1d6f 100644 --- a/src/FAST-Core-Tools/FASTTEntity.extension.st +++ b/src/FAST-Core-Tools/FASTTEntity.extension.st @@ -1,6 +1,6 @@ -Extension { #name : #FASTTEntity } +Extension { #name : 'FASTTEntity' } -{ #category : #'*FAST-Core-Tools' } +{ #category : '*FAST-Core-Tools' } FASTTEntity >> addLocalUse: aFASTNode [ (self attributeAt: #localUses @@ -8,7 +8,7 @@ FASTTEntity >> addLocalUse: aFASTNode [ add: aFASTNode ] -{ #category : #'*FAST-Core-Tools' } +{ #category : '*FAST-Core-Tools' } FASTTEntity >> dump [ "Generate an expression that recreates the receiver" @@ -16,7 +16,7 @@ FASTTEntity >> dump [ ^ FASTDumpVisitor visit: self ] -{ #category : #'*FAST-Core-Tools' } +{ #category : '*FAST-Core-Tools' } FASTTEntity >> inspectionFASTDump [ @@ -26,31 +26,31 @@ FASTTEntity >> inspectionFASTDump [ yourself ] -{ #category : #'*FAST-Core-Tools' } +{ #category : '*FAST-Core-Tools' } FASTTEntity >> localDeclaration [ ^self attributeAt: #localDeclaration ifAbsent: [ Error signal: 'missing #localDeclaration attribute in ' , self asString ] ] -{ #category : #'*FAST-Core-Tools' } +{ #category : '*FAST-Core-Tools' } FASTTEntity >> localDeclaration: aDeclarationNode [ self attributeAt: #localDeclaration put: aDeclarationNode ] -{ #category : #'*FAST-Core-Tools' } +{ #category : '*FAST-Core-Tools' } FASTTEntity >> localUses [ ^self attributeAt: #localUses ifAbsent: [ Error signal: 'missing #localUses attribute in ' , self asString ] ] -{ #category : #'*FAST-Core-Tools' } +{ #category : '*FAST-Core-Tools' } FASTTEntity >> localUses: aCollection [ self attributeAt: #localUses put: aCollection ] -{ #category : #'*FAST-Core-Tools' } +{ #category : '*FAST-Core-Tools' } FASTTEntity >> resetLocalUses [ self attributeAt: #localUses put: OrderedCollection new ] diff --git a/src/FAST-Core-Tools/FASTTextHighlighter.class.st b/src/FAST-Core-Tools/FASTTextHighlighter.class.st index 1588dd3..52a356a 100644 --- a/src/FAST-Core-Tools/FASTTextHighlighter.class.st +++ b/src/FAST-Core-Tools/FASTTextHighlighter.class.st @@ -1,42 +1,44 @@ Class { - #name : #FASTTextHighlighter, - #superclass : #Object, + #name : 'FASTTextHighlighter', + #superclass : 'Object', #instVars : [ 'attributeMapper' ], - #category : #'FAST-Core-Tools-Highlighter' + #category : 'FAST-Core-Tools-Highlighter', + #package : 'FAST-Core-Tools', + #tag : 'Highlighter' } -{ #category : #public } +{ #category : 'public' } FASTTextHighlighter >> addAttribute: aTextAttribute for: anEntity [ | attributes | attributes := self attributeMapper at: anEntity ifAbsentPut: [ OrderedCollection new ]. attributes add: aTextAttribute ] -{ #category : #accessing } +{ #category : 'accessing' } FASTTextHighlighter >> attributeMapper [ "returns a dictionary with keys corresponding to parser names and values corresponding to a collection of TextAttributes" ^ attributeMapper ] -{ #category : #accessing } +{ #category : 'accessing' } FASTTextHighlighter >> attributeMapper: aDictionary [ attributeMapper := aDictionary ] -{ #category : #public } +{ #category : 'public' } FASTTextHighlighter >> bold: anElementString [ self addAttribute: TextEmphasis bold for: anElementString ] -{ #category : #public } +{ #category : 'public' } FASTTextHighlighter >> color: anElementString with: aColor [ self addAttribute: (TextColor new color: aColor) for: anElementString ] -{ #category : #public } +{ #category : 'public' } FASTTextHighlighter >> highlight: anFASTEntity [ | text | text := anFASTEntity sourceText asText. @@ -47,7 +49,7 @@ FASTTextHighlighter >> highlight: anFASTEntity [ ^ text ] -{ #category : #initialization } +{ #category : 'initialization' } FASTTextHighlighter >> initialize [ super initialize. attributeMapper := Dictionary new diff --git a/src/FAST-Core-Tools/FASTVisitorCodeGenerator.class.st b/src/FAST-Core-Tools/FASTVisitorCodeGenerator.class.st index cc75cef..0aa227e 100644 --- a/src/FAST-Core-Tools/FASTVisitorCodeGenerator.class.st +++ b/src/FAST-Core-Tools/FASTVisitorCodeGenerator.class.st @@ -1,16 +1,17 @@ " -I am a Pharo code generator to implement the basic infrastructure for FAST visitors +I am a Pharo code generator to implement the basic infrastructure for FAST visitors. +I only generate calls to superclass and used traits, I do not do anything with the properties of the visited nodes. -I generate the `#accept:` methods in the meta-model classes and the `#visitXYZ:` methods in the visitor. +I generate the `#accept:` methods in the meta-model classes and the `#visit:` methods in the visitor. To use: ``` FASTVisitorCodeGenerator new - rootClass: FASTXYZEntity visitorClass: FASTXYZVisitor + rootClass: FASTEntity visitorClass: FASTVisitor ``` Assumptions: -- Classes and traits of the meta-model are all gathered in one package (typically **FAST-XYZ-Entities**) where the root entity class (**FASTXYZEntity**) is also located -- The class **FASTXYZVisitor** should exist -- The `#accept:` methods are generated in the model entities (subclasses of **FASTXYZEntity**) as extension of the package owning **FASTXYZVisitor** +- Classes and traits of the meta-model are all gathered in one package (typically **FAST--Entities**) where the root entity class (**FASTEntity**) is also located +- The class **FASTVisitor** should exist +- The `#accept:` methods are generated in the model entities (subclasses of **FASTEntity**) as extension of the package owning **FASTVisitor** Thus for FAST-Java: - Meta-model classes and traits are located in one package (FAST-Java-entities) @@ -18,103 +19,191 @@ Thus for FAST-Java: - `#accept:` methods in the meta-model classes will be extension of the FAST-Java-Visitor package " Class { - #name : #FASTVisitorCodeGenerator, - #superclass : #Object, - #category : #'FAST-Core-Tools-VisitorGenerator' + #name : 'FASTVisitorCodeGenerator', + #superclass : 'Object', + #instVars : [ + 'rootClass', + 'visitorClass' + ], + #category : 'FAST-Core-Tools-VisitorGenerator', + #package : 'FAST-Core-Tools', + #tag : 'VisitorGenerator' } -{ #category : #'code generation' } +{ #category : 'code generation' } FASTVisitorCodeGenerator >> asParameterName: aModelClass [ + "generates a parameter name from a class name" ^'a' , aModelClass name ] -{ #category : #'code generation' } -FASTVisitorCodeGenerator >> generateAccept: modelClass extensionPackage: aPackageName [ +{ #category : 'run' } +FASTVisitorCodeGenerator >> compileCode: code into: aModelClass [ + + visitorClass compile: code classified: (aModelClass isTrait + ifTrue: [ 'visiting - traits' ] + ifFalse: [ 'visiting' ]) +] + +{ #category : 'code generation' } +FASTVisitorCodeGenerator >> generateAccept: modelClass [ + "generates and #accept: method in modelClass as extension of the package of the visitorClass. + Note the trick in calling #generateVisitCallFor:receiver:argument:on: where the 'receiver' + includes a return statement" | code | - code := String streamContents: [ :st | - self generateAcceptSelectorIn: st. - self generatePragmaIn: st. - st - cr ; - tab ; - << '^'. - self generateVisitCallFor: modelClass on: 'aVisitor' argument: 'self' in: st ]. - - modelClass compile: code classified: '*' , aPackageName + code := String streamContents: [ :stream | + self generateAcceptSelectorOn: stream. + self generatePragmaOn: stream. + self generateVisitCallFor: modelClass receiver: '^ aVisitor' argument: 'self' on: stream + ]. + + modelClass compile: code classified: '*' , visitorClass package name ] -{ #category : #private } -FASTVisitorCodeGenerator >> generateAcceptSelectorIn: st [ +{ #category : 'code generation' } +FASTVisitorCodeGenerator >> generateAcceptSelectorOn: stream [ - st << 'accept: aVisitor' + stream << 'accept: aVisitor' ] -{ #category : #private } -FASTVisitorCodeGenerator >> generatePragmaIn: st [ - st - cr ; +{ #category : 'code generation' } +FASTVisitorCodeGenerator >> generatePragmaOn: stream [ + + stream tab ; - << '' + << '' ; + cr ] -{ #category : #'code generation' } -FASTVisitorCodeGenerator >> generateVisit: aModelClass in: aVisitorClass [ - - | code category | - code := String streamContents: [ :st | - self - generateVisitSelectorFor: aModelClass - parameter: (self asParameterName: aModelClass) - in: st. - self generatePragmaIn: st. - - aModelClass traits do: [ :aTrait | - st - cr; - tab. - self - generateVisitCallFor: aTrait - on: 'self' - argument: (self asParameterName: aModelClass) - in: st ] ]. - - category := aModelClass isTrait - ifTrue: [ 'visiting - traits' ] - ifFalse: [ 'visiting' ]. - - aVisitorClass compile: code classified: category -] +{ #category : 'code generation' } +FASTVisitorCodeGenerator >> generateVisitCallFor: modelClass receiver: receiver argument: argument on: stream [ + "generates an invocation of a #visit: method, with an argument of type modelClass + reusing the method that generates the visit selector" -{ #category : #private } -FASTVisitorCodeGenerator >> generateVisitCallFor: modelClass on: receiver argument: argument in: st [ - st + stream + tab ; << receiver ; - << ' visit'; - << modelClass name; - << ': ' ; - << argument ; - << '.' + space. + + self generateVisitSelectorFor: modelClass parameter: argument on: stream. + stream + << '.' ; + cr ] -{ #category : #private } -FASTVisitorCodeGenerator >> generateVisitSelectorFor: aModelClass parameter: parameter in: st [ +{ #category : 'run' } +FASTVisitorCodeGenerator >> generateVisitFor: aModelClass [ + "main method: generates a default visit method for instances of aModelClass and put it in visitorClass + - first generates the selector and put a 'generated' pragma + - then generates calls to #visitSomeTrait: for used traits + - then generates a call to #visit: + - then compiles the method" + + | code | + code := String streamContents: [ :stream | + self generateVisitMethodHeader: aModelClass on: stream. + self generateVisitForBodyOf: aModelClass on: stream ]. + + self compileCode: code into: aModelClass +] + +{ #category : 'run' } +FASTVisitorCodeGenerator >> generateVisitForBodyOf: aModelClass on: stream [ + + self generateVisitToTraits: aModelClass on: stream. + self generateVisitToSuperclass: aModelClass on: stream +] + +{ #category : 'run' } +FASTVisitorCodeGenerator >> generateVisitMethodHeader: aModelClass on: stream [ + + self + generateVisitSelectorFor: aModelClass + parameter: (self asParameterName: aModelClass) + on: stream. + stream cr. + self generatePragmaOn: stream +] - st +{ #category : 'code generation' } +FASTVisitorCodeGenerator >> generateVisitSelectorFor: aModelClass parameter: parameter on: stream [ + + stream << 'visit'; << aModelClass name; << ': '; << parameter ] -{ #category : #run } +{ #category : 'run' } +FASTVisitorCodeGenerator >> generateVisitToSuperclass: aModelClass on: stream [ + + aModelClass superclass ifNotNil: [ :superclass | + superclass = rootClass ifFalse: [ + self + generateVisitCallFor: superclass + receiver: 'self' + argument: (self asParameterName: aModelClass) + on: stream + ] + ] +] + +{ #category : 'run' } +FASTVisitorCodeGenerator >> generateVisitToTraits: aModelClass on: stream [ + "generates calls to traits used by aModelClass and not used by its super-classes + (because they will alreay have a class to visit that trait)" + + (self traitsToVisitFor: aModelClass) do: [ :aTrait | + self + generateVisitCallFor: aTrait + receiver: 'self' + argument: (self asParameterName: aModelClass) + on: stream ]. +] + +{ #category : 'run' } FASTVisitorCodeGenerator >> rootClass: aFASTEntityClass visitorClass: aFASTVisitorClass [ + "entry point for the generation. + For all subclasses of aFASTEntityClass will generate an #accept: method in that class and + a #visit: method in aFASTVisitorClass + Then do the same for all traits in the package of aFASTEntityClass" + + rootClass := aFASTEntityClass. + visitorClass := aFASTVisitorClass. + aFASTEntityClass withAllSubclassesDo: [ :modelClass | - self generateAccept: modelClass extensionPackage: aFASTVisitorClass package name. - self generateVisit: modelClass in: aFASTVisitorClass. + self generateAccept: modelClass. + self generateVisitFor: modelClass. ]. - (aFASTEntityClass package classes select: #isTrait) do: [ :modelTrait | - self generateVisit: modelTrait in: aFASTVisitorClass. + + aFASTEntityClass package classes do: [ :modelClass | + modelClass isTrait + ifTrue: [ self generateVisitFor: modelClass ] ]. ] + +{ #category : 'private' } +FASTVisitorCodeGenerator >> trait: aTrait usedBySuperClassOf: aModelClass [ + + | superclass | + (aModelClass = rootClass) ifTrue: [ ^false ]. + + superclass := aModelClass superclass. + superclass ifNil: [ ^false ]. + + (superclass traits includes: aTrait) ifTrue: [ ^true ]. + + ^self trait: aTrait usedBySuperClassOf: aModelClass superclass +] + +{ #category : 'private' } +FASTVisitorCodeGenerator >> traitsToVisitFor: aModelClass [ + "gather the traits used by aModelClass that are not used by any of its super-classes + The root class is assumed to not use any trait" + + (aModelClass = rootClass) ifTrue: [ ^#() ]. + + ^aModelClass traits reject: [ :aTrait | self trait: aTrait usedBySuperClassOf: aModelClass ] +] diff --git a/src/FAST-Core-Tools/FamixModelComparator.class.st b/src/FAST-Core-Tools/FamixModelComparator.class.st index b575061..b0f90ef 100644 --- a/src/FAST-Core-Tools/FamixModelComparator.class.st +++ b/src/FAST-Core-Tools/FamixModelComparator.class.st @@ -1,20 +1,22 @@ Class { - #name : #FamixModelComparator, - #superclass : #Object, + #name : 'FamixModelComparator', + #superclass : 'Object', #instVars : [ 'strict' ], - #category : #'FAST-Core-Tools-Validator' + #category : 'FAST-Core-Tools-Validator', + #package : 'FAST-Core-Tools', + #tag : 'Validator' } -{ #category : #comparison } +{ #category : 'comparison' } FamixModelComparator >> ast: node1 acceptableDifferenceTo: node2 [ "In non strict mode, some differences could be accepted" ^false ] -{ #category : #comparison } +{ #category : 'comparison' } FamixModelComparator >> ast: node1 acceptableDifferenceTo: node2 property: property [ "returns nil if the difference is not acceptable otherwise, must return a block testing where the comparison process might resume" @@ -22,7 +24,7 @@ FamixModelComparator >> ast: node1 acceptableDifferenceTo: node2 property: prope ^nil ] -{ #category : #comparison } +{ #category : 'comparison' } FamixModelComparator >> ast: node1 differ: node2 [ self strict ifTrue: [ self differenceNotResumable ]. @@ -32,7 +34,7 @@ FamixModelComparator >> ast: node1 differ: node2 [ ifFalse: [ self differenceNotResumable ] ] -{ #category : #comparison } +{ #category : 'comparison' } FamixModelComparator >> ast: node1 differ: node2 property: property [ self strict ifTrue: [ self differenceNotResumable ]. @@ -42,13 +44,13 @@ FamixModelComparator >> ast: node1 differ: node2 property: property [ ifNotNil: [ :recovery | self differenceResumableOncondition: recovery ] ] -{ #category : #configuration } +{ #category : 'configuration' } FamixModelComparator >> beStrict [ self strict: true ] -{ #category : #utilities } +{ #category : 'utilities' } FamixModelComparator >> childrenNodes: astNode [ ^OrderedCollection withAll: @@ -56,7 +58,7 @@ FamixModelComparator >> childrenNodes: astNode [ ] -{ #category : #comparison } +{ #category : 'comparison' } FamixModelComparator >> compare: node1 to: node2 [ "check the two nodes have the same class then check they have the same properties (attributes with primitive types) @@ -78,7 +80,7 @@ FamixModelComparator >> compare: node1 to: node2 [ ] ] -{ #category : #comparison } +{ #category : 'comparison' } FamixModelComparator >> compareChildren: node1 to: node2 [ "comparing the two lists of children may seem a bit complicate, but it is trying to give more info when the children starts to differ @@ -101,14 +103,14 @@ FamixModelComparator >> compareChildren: node1 to: node2 [ self ast: nil differ: (children2 at: children1 size + 1) ] ] -{ #category : #comparison } +{ #category : 'comparison' } FamixModelComparator >> compareClasses: node1 to: node2 [ node1 class = node2 class ifFalse: [ self ast: node1 differ: node2 ] ] -{ #category : #comparison } +{ #category : 'comparison' } FamixModelComparator >> compareProperties: node1 to: node2 [ "compare the values of the 'properties' (attributes with primitive types) of the two nodes since the two nodes should be the same class, they have the same properties" @@ -126,14 +128,14 @@ FamixModelComparator >> compareProperties: node1 to: node2 [ ] -{ #category : #exceptionbuilder } +{ #category : 'exceptionbuilder' } FamixModelComparator >> differenceNotResumable [ FamixModelComparatorRecoveryException signal: 'ASTs differ' ] -{ #category : #exceptionbuilder } +{ #category : 'exceptionbuilder' } FamixModelComparator >> differenceResumableInParent [ "raises an exception with a 'true' condition. Process will resume in immediate parent" @@ -143,7 +145,7 @@ FamixModelComparator >> differenceResumableInParent [ signal: 'Overlooking difference in AST' ] -{ #category : #exceptionbuilder } +{ #category : 'exceptionbuilder' } FamixModelComparator >> differenceResumableOncondition: aBlock [ FamixModelComparatorRecoveryException new @@ -151,7 +153,7 @@ FamixModelComparator >> differenceResumableOncondition: aBlock [ signal: 'Overlooking difference in AST' ] -{ #category : #initialization } +{ #category : 'initialization' } FamixModelComparator >> initialize [ super initialize. @@ -159,7 +161,7 @@ FamixModelComparator >> initialize [ strict := false. ] -{ #category : #testing } +{ #category : 'testing' } FamixModelComparator >> propertyToCompare: aFMProperty [ "do not compare on derived (ie. computed) properties, only those with a stored value do not compare on startPos/endPos as they are not meaningfull" @@ -169,13 +171,13 @@ FamixModelComparator >> propertyToCompare: aFMProperty [ ^true ] -{ #category : #accessing } +{ #category : 'accessing' } FamixModelComparator >> strict [ ^ strict ] -{ #category : #accessing } +{ #category : 'accessing' } FamixModelComparator >> strict: anObject [ strict := anObject diff --git a/src/FAST-Core-Tools/FamixModelComparatorForTesting.class.st b/src/FAST-Core-Tools/FamixModelComparatorForTesting.class.st index 6854ea0..4116609 100644 --- a/src/FAST-Core-Tools/FamixModelComparatorForTesting.class.st +++ b/src/FAST-Core-Tools/FamixModelComparatorForTesting.class.st @@ -1,10 +1,12 @@ Class { - #name : #FamixModelComparatorForTesting, - #superclass : #FamixModelComparator, - #category : #'FAST-Core-Tools-Validator' + #name : 'FamixModelComparatorForTesting', + #superclass : 'FamixModelComparator', + #category : 'FAST-Core-Tools-Validator', + #package : 'FAST-Core-Tools', + #tag : 'Validator' } -{ #category : #comparison } +{ #category : 'comparison' } FamixModelComparatorForTesting >> ast: node1 acceptableDifferenceTo: node2 property: property [ | recoveryBlock | diff --git a/src/FAST-Core-Tools/FamixModelComparatorRecoveryException.class.st b/src/FAST-Core-Tools/FamixModelComparatorRecoveryException.class.st index 1c6245f..82c65d3 100644 --- a/src/FAST-Core-Tools/FamixModelComparatorRecoveryException.class.st +++ b/src/FAST-Core-Tools/FamixModelComparatorRecoveryException.class.st @@ -13,27 +13,29 @@ From example, comparing if-condition could fail and the recovery would occur fro One must be specific enough in the condition so that another ancestor does not accept to recover when it was not expected. A possible way to do this is to specify the exact file and position of the node intended " Class { - #name : #FamixModelComparatorRecoveryException, - #superclass : #Exception, + #name : 'FamixModelComparatorRecoveryException', + #superclass : 'Exception', #instVars : [ 'condition' ], - #category : #'FAST-Core-Tools-Validator' + #category : 'FAST-Core-Tools-Validator', + #package : 'FAST-Core-Tools', + #tag : 'Validator' } -{ #category : #accessing } +{ #category : 'accessing' } FamixModelComparatorRecoveryException >> condition [ ^ condition ] -{ #category : #accessing } +{ #category : 'accessing' } FamixModelComparatorRecoveryException >> condition: anObject [ condition := anObject ] -{ #category : #initialization } +{ #category : 'initialization' } FamixModelComparatorRecoveryException >> initialize [ "if no condition is specified, no recovery is possible" diff --git a/src/FAST-Core-Tools/FamixModelComparatorTest.class.st b/src/FAST-Core-Tools/FamixModelComparatorTest.class.st index fdd39d3..b385605 100644 --- a/src/FAST-Core-Tools/FamixModelComparatorTest.class.st +++ b/src/FAST-Core-Tools/FamixModelComparatorTest.class.st @@ -1,19 +1,21 @@ Class { - #name : #FamixModelComparatorTest, - #superclass : #TestCase, + #name : 'FamixModelComparatorTest', + #superclass : 'TestCase', #instVars : [ 'validator' ], - #category : #'FAST-Core-Tools-Validator' + #category : 'FAST-Core-Tools-Validator', + #package : 'FAST-Core-Tools', + #tag : 'Validator' } -{ #category : #running } +{ #category : 'running' } FamixModelComparatorTest >> setUp [ validator := FamixModelComparatorForTesting new ] -{ #category : #tests } +{ #category : 'tests' } FamixModelComparatorTest >> testClassDifference [ | node1 node2 | @@ -25,7 +27,7 @@ FamixModelComparatorTest >> testClassDifference [ raise: FamixModelComparatorRecoveryException ] -{ #category : #tests } +{ #category : 'tests' } FamixModelComparatorTest >> testClassNoDifference [ | node1 node2 | @@ -37,7 +39,7 @@ FamixModelComparatorTest >> testClassNoDifference [ raise: FamixModelComparatorRecoveryException ] -{ #category : #tests } +{ #category : 'tests' } FamixModelComparatorTest >> testPropertyAcceptableDifference [ | node1 node2 | @@ -49,7 +51,7 @@ FamixModelComparatorTest >> testPropertyAcceptableDifference [ raise: FamixModelComparatorRecoveryException ] -{ #category : #tests } +{ #category : 'tests' } FamixModelComparatorTest >> testPropertyDifference [ | node1 node2 | @@ -61,7 +63,7 @@ FamixModelComparatorTest >> testPropertyDifference [ raise: FamixModelComparatorRecoveryException ] -{ #category : #tests } +{ #category : 'tests' } FamixModelComparatorTest >> testPropertyNoDifference [ | node1 node2 | diff --git a/src/FAST-Core-Tools/MooseModel.extension.st b/src/FAST-Core-Tools/MooseModel.extension.st index affb278..95b3f04 100644 --- a/src/FAST-Core-Tools/MooseModel.extension.st +++ b/src/FAST-Core-Tools/MooseModel.extension.st @@ -1,6 +1,6 @@ -Extension { #name : #MooseModel } +Extension { #name : 'MooseModel' } -{ #category : #'*FAST-Core-Tools' } +{ #category : '*FAST-Core-Tools' } MooseModel >> fastHighligther [ ^ FASTTextHighlighter ] diff --git a/src/FAST-Core-Tools/package.st b/src/FAST-Core-Tools/package.st index 61c1832..5293e2c 100644 --- a/src/FAST-Core-Tools/package.st +++ b/src/FAST-Core-Tools/package.st @@ -1 +1 @@ -Package { #name : #'FAST-Core-Tools' } +Package { #name : 'FAST-Core-Tools' }