diff --git a/src/MooseIDE-CoUsageMap-Tests/MiCoHighlightManagerTest.class.st b/src/MooseIDE-CoUsageMap-Tests/MiCoHighlightManagerTest.class.st index adade8ad0..7cb76c07a 100644 --- a/src/MooseIDE-CoUsageMap-Tests/MiCoHighlightManagerTest.class.st +++ b/src/MooseIDE-CoUsageMap-Tests/MiCoHighlightManagerTest.class.st @@ -9,8 +9,8 @@ Class { { #category : 'tests' } MiCoHighlightManagerTest >> testDeselectGoesToModel [ | mooseEntity attribute1 shape1 | - mooseEntity := self specModel currentMooseModel entityNamed: #var1. - attribute1 := self specModel getInnerBoxNamed: #var1. + mooseEntity := self specModel currentMooseModel entityNamed: #att1. + attribute1 := self specModel getInnerBoxNamed: #att1. shape1 := builder canvas deepShapeFromModel: attribute1. self specModel selectedEntity: mooseEntity. @@ -27,7 +27,7 @@ MiCoHighlightManagerTest >> testDeselectInnerBox [ | attribute1 shape1 default selected | self tagsWithPalette: { 'Frame'. 'Connection' }. - attribute1 := self specModel getInnerBoxNamed: #var1. + attribute1 := self specModel getInnerBoxNamed: #att1. shape1 := builder canvas deepShapeFromModel: attribute1. default := builder highlightManager defaultBoxBorder color. @@ -46,7 +46,7 @@ MiCoHighlightManagerTest >> testHighlight [ | attribute1 shape1 default selected | self tagsWithPalette: { 'Frame'. 'Connection' }. - attribute1 := self specModel getInnerBoxNamed: #var1. + attribute1 := self specModel getInnerBoxNamed: #att1. shape1 := builder canvas deepShapeFromModel: attribute1. default := builder highlightManager defaultBoxBorder color. @@ -64,36 +64,36 @@ MiCoHighlightManagerTest >> testHighlight [ { #category : 'tests' } MiCoHighlightManagerTest >> testNoHighlightWhenSelectedInnerBox [ - | attribute1 shape1 default selected attribute2 shape2 | + | attribute3 shape3 default selected attribute4 shape4 | self tagsWithPalette: { 'Frame'. 'Connection' }. - attribute1 := self specModel getInnerBoxNamed: #var1. - attribute2 := self specModel getInnerBoxNamed: #var2. - shape1 := builder canvas deepShapeFromModel: attribute1. - shape2 := builder canvas deepShapeFromModel: attribute2. + attribute3 := self specModel getInnerBoxNamed: #att3. + attribute4 := self specModel getInnerBoxNamed: #att4. + shape3 := builder canvas deepShapeFromModel: attribute3. + shape4 := builder canvas deepShapeFromModel: attribute4. default := builder highlightManager defaultBoxBorder color. selected := builder highlightManager selectedBoxBorder color. - self assert: shape2 border color equals: default. + self assert: shape4 border color equals: default. - shape1 announce: (RSMouseLeftClick new shape: shape1). - shape2 announce: (RSMouseEnter new shape: shape2). + shape3 announce: (RSMouseLeftClick new shape: shape3). + shape4 announce: (RSMouseEnter new shape: shape4). - self assert: shape2 border color equals: default. + self assert: shape4 border color equals: default. ] { #category : 'tests' } MiCoHighlightManagerTest >> testSelectGoesToModel [ | attribute1 shape1 | - attribute1 := self specModel getInnerBoxNamed: #var1. + attribute1 := self specModel getInnerBoxNamed: #att1. shape1 := builder canvas deepShapeFromModel: attribute1. shape1 announce: (RSMouseLeftClick new shape: shape1). self assert: self specModel selectedEntity - equals: (self specModel currentMooseModel entityNamed: #var1) + equals: (self specModel currentMooseModel entityNamed: #att1) ] @@ -102,7 +102,7 @@ MiCoHighlightManagerTest >> testSelectInnerBox [ | attribute1 shape1 default selected | self tagsWithPalette: { 'Frame'. 'Connection' }. - attribute1 := self specModel getInnerBoxNamed: #var1. + attribute1 := self specModel getInnerBoxNamed: #att1. shape1 := builder canvas deepShapeFromModel: attribute1. default := builder highlightManager defaultBoxBorder color. diff --git a/src/MooseIDE-CoUsageMap-Tests/MiCoAttributeTest.class.st b/src/MooseIDE-CoUsageMap-Tests/MiCoInnerBoxTest.class.st similarity index 85% rename from src/MooseIDE-CoUsageMap-Tests/MiCoAttributeTest.class.st rename to src/MooseIDE-CoUsageMap-Tests/MiCoInnerBoxTest.class.st index 17c79703a..55780ddd8 100644 --- a/src/MooseIDE-CoUsageMap-Tests/MiCoAttributeTest.class.st +++ b/src/MooseIDE-CoUsageMap-Tests/MiCoInnerBoxTest.class.st @@ -1,23 +1,23 @@ Class { - #name : 'MiCoAttributeTest', + #name : 'MiCoInnerBoxTest', #superclass : 'TestCase', - #category : 'MooseIDE-CoUsageMap-Tests-Browser', + #category : 'MooseIDE-CoUsageMap-Tests-Model', #package : 'MooseIDE-CoUsageMap-Tests', - #tag : 'Browser' + #tag : 'Model' } { #category : 'tests' } -MiCoAttributeTest >> containerBoxOn: aName [ +MiCoInnerBoxTest >> containerBoxOn: aName [ ^MiCoContainerBox new mooseEntity: (FamixStMethod new name: aName) ] { #category : 'tests' } -MiCoAttributeTest >> innerBoxOn: aName [ +MiCoInnerBoxTest >> innerBoxOn: aName [ ^MiCoInnerBox new mooseEntity: (FamixStAttribute new name: aName) ] { #category : 'tests' } -MiCoAttributeTest >> test01ContainerBox [ +MiCoInnerBoxTest >> test01ContainerBox [ | container | container := self containerBoxOn: 'method1'. @@ -25,7 +25,7 @@ MiCoAttributeTest >> test01ContainerBox [ ] { #category : 'tests' } -MiCoAttributeTest >> test02InnerBox [ +MiCoInnerBoxTest >> test02InnerBox [ | innerBox | innerBox := self innerBoxOn: 'aVar'. @@ -33,7 +33,7 @@ MiCoAttributeTest >> test02InnerBox [ ] { #category : 'tests' } -MiCoAttributeTest >> test03PopupMessage [ +MiCoInnerBoxTest >> test03PopupMessage [ | innerBox containerBox | containerBox := self containerBoxOn: 'method1'. diff --git a/src/MooseIDE-CoUsageMap-Tests/MiCoInnerEntitiesAttributeAccessExtractorTest.class.st b/src/MooseIDE-CoUsageMap-Tests/MiCoInnerEntitiesAttributeAccessExtractorTest.class.st new file mode 100644 index 000000000..7c1cd4742 --- /dev/null +++ b/src/MooseIDE-CoUsageMap-Tests/MiCoInnerEntitiesAttributeAccessExtractorTest.class.st @@ -0,0 +1,73 @@ +Class { + #name : 'MiCoInnerEntitiesAttributeAccessExtractorTest', + #superclass : 'TestCase', + #instVars : [ + 'mooseModel', + 'extractor' + ], + #category : 'MooseIDE-CoUsageMap-Tests-Model', + #package : 'MooseIDE-CoUsageMap-Tests', + #tag : 'Model' +} + +{ #category : 'running' } +MiCoInnerEntitiesAttributeAccessExtractorTest >> setUp [ + super setUp. + + mooseModel := MiCoUsageTestFamixModel new. + extractor := MiCoInnerEntitiesAttributeAccessExtractor new +] + +{ #category : 'tests' } +MiCoInnerEntitiesAttributeAccessExtractorTest >> testAttributeAccessorInvocationsNone [ + + self assert: (extractor attributeAccessorInvocations: mooseModel method5) size equals: 0 +] + +{ #category : 'tests' } +MiCoInnerEntitiesAttributeAccessExtractorTest >> testAttributeAccessorInvocationsOne [ + + self assert: (extractor attributeAccessorInvocations: mooseModel method2) size equals: 1. + + self + assertCollection: (extractor attributeAccessorInvocations: mooseModel method2) + hasSameElements: { mooseModel att6 }. +] + +{ #category : 'tests' } +MiCoInnerEntitiesAttributeAccessExtractorTest >> testDirectAttributeAccessesMultipleAccesses [ + + self assert: (extractor directAttributeAccesses: mooseModel method1) size equals: 3. + + self + assertCollection: (extractor directAttributeAccesses: mooseModel method1) + hasSameElements: { mooseModel att1 . mooseModel att1 . mooseModel att1 }. +] + +{ #category : 'tests' } +MiCoInnerEntitiesAttributeAccessExtractorTest >> testDirectAttributeAccessesMultipleAttributes [ + + self assert: (extractor directAttributeAccesses: mooseModel method3) size equals: 3. + + self + assertCollection: (extractor directAttributeAccesses: mooseModel method3) + hasSameElements: { mooseModel att3 . mooseModel att4 . mooseModel att5 }. +] + +{ #category : 'tests' } +MiCoInnerEntitiesAttributeAccessExtractorTest >> testDirectAttributeAccessesNone [ + + self assert: (extractor directAttributeAccesses: mooseModel method2) size equals: 0 +] + +{ #category : 'tests' } +MiCoInnerEntitiesAttributeAccessExtractorTest >> testInnerEntitiesFor [ + + self + assertCollection: (extractor innerEntitiesFor: mooseModel method2) + hasSameElements: { mooseModel att6 }. + + self + assertCollection: (extractor innerEntitiesFor: mooseModel method3) + hasSameElements: { mooseModel att3 . mooseModel att4 . mooseModel att5 }. +] diff --git a/src/MooseIDE-CoUsageMap-Tests/MiCoMenuManagerTest.class.st b/src/MooseIDE-CoUsageMap-Tests/MiCoMenuManagerTest.class.st index e11393347..9444d4a16 100644 --- a/src/MooseIDE-CoUsageMap-Tests/MiCoMenuManagerTest.class.st +++ b/src/MooseIDE-CoUsageMap-Tests/MiCoMenuManagerTest.class.st @@ -10,8 +10,8 @@ Class { MiCoMenuManagerTest >> testOpenMenu [ | attribute method | - attribute := self specModel getInnerBoxNamed: #var2. - method := self specModel containerBoxNamed: #method1. + attribute := self specModel getInnerBoxNamed: #att3. + method := self specModel containerBoxNamed: #method3. builder menuManager createMenu: MenuMorph new onBox: attribute. builder menuManager createMenu: MenuMorph new onBox: method. builder menuManager diff --git a/src/MooseIDE-CoUsageMap-Tests/MiCoUsageAbstractTest.class.st b/src/MooseIDE-CoUsageMap-Tests/MiCoUsageAbstractTest.class.st index eb74bce25..50b301a39 100644 --- a/src/MooseIDE-CoUsageMap-Tests/MiCoUsageAbstractTest.class.st +++ b/src/MooseIDE-CoUsageMap-Tests/MiCoUsageAbstractTest.class.st @@ -1,18 +1,28 @@ Class { #name : 'MiCoUsageAbstractTest', - #superclass : 'TestCase', + #superclass : 'MiAbstractApplicationTest', #instVars : [ 'visualization', 'builder', - 'browser', - 'application', - 'previousApplication' + 'mooseModel', + 'browser' ], #category : 'MooseIDE-CoUsageMap-Tests-Browser', #package : 'MooseIDE-CoUsageMap-Tests', #tag : 'Browser' } +{ #category : 'testing' } +MiCoUsageAbstractTest class >> isAbstract [ + ^self name includesSubstring: 'Abstract' +] + +{ #category : 'running' } +MiCoUsageAbstractTest >> browserClass [ + + ^MiCoUsageMapBrowser +] + { #category : 'running' } MiCoUsageAbstractTest >> createTag: aName [ @@ -25,21 +35,13 @@ MiCoUsageAbstractTest >> createTag: aName [ MiCoUsageAbstractTest >> setUp [ super setUp. - previousApplication := MiApplication current. - - application := MiTestApplication new. - MiApplication current: application. - browser := MiCoUsageMapBrowser - newApplication: application - model: MiCoUsageMapModel new. + mooseModel := MiCoUsageTestFamixModel new. - browser specModel followEntity: - MiCoUsageTestFamixModel new allMethods. + browser := self browserClass openForTests: application. + browser followEntity: mooseModel allMethods. visualization := browser mapVisualization. - visualization buildInCanvas: visualization canvas. - builder := visualization mapBuilder ] @@ -59,7 +61,7 @@ MiCoUsageAbstractTest >> tagsWithPalette: aCollection [ { #category : 'running' } MiCoUsageAbstractTest >> tearDown [ - MiApplication reset. - MiApplication current: previousApplication. + browser ifNotNil: [ browser withWindowDo: [ :window | window close ] ]. + super tearDown ] diff --git a/src/MooseIDE-CoUsageMap-Tests/MiCoUsageMapBrowserTest.class.st b/src/MooseIDE-CoUsageMap-Tests/MiCoUsageMapBrowserTest.class.st index b6e55c535..449a0f9d5 100644 --- a/src/MooseIDE-CoUsageMap-Tests/MiCoUsageMapBrowserTest.class.st +++ b/src/MooseIDE-CoUsageMap-Tests/MiCoUsageMapBrowserTest.class.st @@ -1,28 +1,28 @@ Class { #name : 'MiCoUsageMapBrowserTest', #superclass : 'MiAbstractBrowserTest', + #instVars : [ + 'mooseModel' + ], #category : 'MooseIDE-CoUsageMap-Tests-Browser', #package : 'MooseIDE-CoUsageMap-Tests', #tag : 'Browser' } { #category : 'running' } -MiCoUsageMapBrowserTest >> blockSettingsPresenter [ +MiCoUsageMapBrowserTest >> browserClass [ - ^settingsWindow presenter presenterAt: #blockSettings + ^MiCoUsageMapBrowser ] { #category : 'running' } -MiCoUsageMapBrowserTest >> browserClass [ - ^ MiCoUsageMapBrowser -] +MiCoUsageMapBrowserTest >> populateBrowser: anotherMooseModel [ + "necessary for inherited #testTagMenuListsTags + unfortunatelly it uses its own MooseModel" -{ #category : 'running' } -MiCoUsageMapBrowserTest >> populateBrowser: mooseModel [ + anotherMooseModel newMethodNamed: 'method'. - mooseModel add: (FamixStClass new name: 'AClass'). - mooseModel add: (FamixStClass new name: 'AnotherClass'). - browser followEntity: mooseModel entities. + browser followEntity: anotherMooseModel allModelMethods. ] @@ -33,113 +33,39 @@ MiCoUsageMapBrowserTest >> receiveEntityToSelect [ ] { #category : 'running' } -MiCoUsageMapBrowserTest >> settingsApplyButtonPresenter [ +MiCoUsageMapBrowserTest >> setUp [ - ^self blockSettingsPresenter - presenterAt: #applyButton -] + super setUp. -{ #category : 'running' } -MiCoUsageMapBrowserTest >> settingsChildrenTextInputPresenter [ + mooseModel := MiCoUsageTestFamixModel new. - ^self blockSettingsPresenter - presenterAt: #childrenTextInput -] + browser followEntity: mooseModel allMethods. -{ #category : 'running' } -MiCoUsageMapBrowserTest >> settingsCloseButtonPresenter [ - - ^self blockSettingsPresenter - presenterAt: #closeButton ] { #category : 'running' } -MiCoUsageMapBrowserTest >> settingsResetButtonPresenter [ +MiCoUsageMapBrowserTest >> settingsApplyButtonPresenter [ - ^self blockSettingsPresenter - presenterAt: #resetButton + ^settingsWindow buttons detect: [ :btn | btn label = 'Apply' ] ] { #category : 'running' } -MiCoUsageMapBrowserTest >> settingsSortInnerBoxTextInputPresenter [ - - ^self blockSettingsPresenter - presenterAt: #sortInnerBoxTextInput -] - -{ #category : 'tests' } -MiCoUsageMapBrowserTest >> testBlockSettingsApplyButton [ - "Apply button should close the block setting window" - - settingsWindow := browser openSettings. - - self assert: settingsWindow isOpen. - - self settingsApplyButtonPresenter click. - - self assert: settingsWindow isClosed. - -] - -{ #category : 'tests' } -MiCoUsageMapBrowserTest >> testBlockSettingsChangeValue [ - - settingsWindow := browser specModel openSettings. - - self settingsSortInnerBoxTextInputPresenter text: '[ ]'. - self settingsApplyButtonPresenter click. - - self assert: browser specModel settings innerBoxSortBlockText equals: '[ ]'. - -] - -{ #category : 'tests' } -MiCoUsageMapBrowserTest >> testBlockSettingsClickClose [ - - self - assert: browser specModel settings childrenBlockText - equals: browser specModel settings defaultChildrenBlockText. - - settingsWindow := browser specModel openSettings. - self settingsChildrenTextInputPresenter text: 'Blah'. - - self settingsCloseButtonPresenter click. - - self - assert: browser specModel settings childrenBlockText - equals: browser specModel settings defaultChildrenBlockText. +MiCoUsageMapBrowserTest >> settingsCloseButtonPresenter [ + ^settingsWindow buttons detect: [ :btn | btn label = 'Cancel' ] ] -{ #category : 'tests' } -MiCoUsageMapBrowserTest >> testBlockSettingsDefaultValues [ - - settingsWindow := browser specModel openSettings. - - self assert: browser specModel settings childrenBlockText isNotEmpty. - self assert: browser specModel settings innerBoxSortBlockText isNotEmpty. - self assert: browser specModel settings outerBoxSortBlockText isNotEmpty. +{ #category : 'running' } +MiCoUsageMapBrowserTest >> settingsInnerBoxExtractorListPresenter [ + ^settingsWindow presenter + presenterAt: #lstInnerBoxExtractor ] -{ #category : 'tests' } -MiCoUsageMapBrowserTest >> testBlockSettingsResetValues [ - - browser specModel settings childrenBlockText: 'Blah'. - - settingsWindow := browser specModel openSettings. - - self - assert: self settingsChildrenTextInputPresenter text - equals: 'Blah'. - - self settingsResetButtonPresenter click. - - self - deny: self settingsChildrenTextInputPresenter text - equals: 'Blah'. - self deny: self settingsChildrenTextInputPresenter text isEmpty. +{ #category : 'running' } +MiCoUsageMapBrowserTest >> settingsResetButtonPresenter [ + ^nil ] { #category : 'tests' } @@ -194,23 +120,76 @@ MiCoUsageMapBrowserTest >> testSettingsAction [ self assert: browser hasSettings ] +{ #category : 'tests' } +MiCoUsageMapBrowserTest >> testSettingsChangeValue [ + + settingsWindow := browser specModel openSettings. + + self settingsInnerBoxExtractorListPresenter selectItem: MiCoInnerEntitiesClientClassesExtractor. + self settingsApplyButtonPresenter click. + + self assert: browser specModel settings innerBoxExtractor equals: MiCoInnerEntitiesClientClassesExtractor . + +] + { #category : 'tests' } MiCoUsageMapBrowserTest >> testSettingsClickCancel [ - "skipping for now because settings are handled in a very special way" - self flag: 'should test settings'. - self skip. + + self skip: 'until settings are made standard'. + + self + assert: browser specModel settings innerBoxExtractor + equals: browser specModel settings defaultInnerBoxExtractor. + + settingsWindow := browser specModel openSettings. + self settingsInnerBoxExtractorListPresenter selectItem: MiCoInnerEntitiesClientClassesExtractor. + + self settingsCloseButtonPresenter click. + + self assert: browser specModel settings innerBoxExtractor equals: MiCoInnerEntitiesAttributeAccessExtractor. + ] { #category : 'tests' } MiCoUsageMapBrowserTest >> testSettingsClickOK [ - "overrind and skipping for now because settings are handled in a very special way" - self flag: 'should test settings'. - self skip. + "Apply button should close the block setting window" + + settingsWindow := browser openSettings. + + self assert: settingsWindow isOpen. + + self settingsApplyButtonPresenter click. + + self assert: settingsWindow isClosed. + ] { #category : 'tests' } MiCoUsageMapBrowserTest >> testSettingsClickReset [ - "overrind and skipping for now because settings are handled in a very special way" - self flag: 'should test settings'. - self skip. + + self skip: 'until settings are made standard'. + + browser specModel settings innerBoxExtractor: 'Blah'. + + settingsWindow := browser specModel openSettings. + + self + assert: self settingsInnerBoxExtractorListPresenter text + equals: 'Blah'. + + self settingsResetButtonPresenter click. + + self + deny: self settingsInnerBoxExtractorListPresenter text + equals: 'Blah'. + self deny: self settingsInnerBoxExtractorListPresenter text isEmpty. + +] + +{ #category : 'tests' } +MiCoUsageMapBrowserTest >> testSettingsDefaultValues [ + + settingsWindow := browser specModel openSettings. + + self assert: browser specModel settings innerBoxExtractor equals: MiCoInnerEntitiesAttributeAccessExtractor. ] diff --git a/src/MooseIDE-CoUsageMap-Tests/MiCoUsageMapBuilderTest.class.st b/src/MooseIDE-CoUsageMap-Tests/MiCoUsageMapBuilderTest.class.st index 73603e337..96b781817 100644 --- a/src/MooseIDE-CoUsageMap-Tests/MiCoUsageMapBuilderTest.class.st +++ b/src/MooseIDE-CoUsageMap-Tests/MiCoUsageMapBuilderTest.class.st @@ -6,11 +6,6 @@ Class { #tag : 'Browser' } -{ #category : 'running' } -MiCoUsageMapBuilderTest >> browserClass [ - ^ MiCoUsageMapBrowser -] - { #category : 'tests' } MiCoUsageMapBuilderTest >> testLastTagInitialization [ @@ -25,7 +20,7 @@ MiCoUsageMapBuilderTest >> testQuickTaggingWithoutLastTag [ | innerBox shapes tagColor event | self createTag: 'aTag'. - innerBox := self specModel getInnerBoxNamed: #var1. + innerBox := self specModel getInnerBoxNamed: #att1. shapes := builder canvas deepShapesFromModel: innerBox. tagColor := builder colorFromTags: nil. event := RSMouseClick new shape: shapes first. @@ -41,7 +36,7 @@ MiCoUsageMapBuilderTest >> testQuickTaggingWithoutLastTag [ MiCoUsageMapBuilderTest >> testQuickTaggingWithoutMetaKey [ | innerBox shapes event tag | tag := self createTag: 'aTag'. - innerBox := self specModel getInnerBoxNamed: #var1. + innerBox := self specModel getInnerBoxNamed: #att1. shapes := builder canvas deepShapesFromModel: innerBox. event := RSMouseClick new shape: shapes first ; @@ -60,7 +55,7 @@ MiCoUsageMapBuilderTest >> testQuickTaggingWithoutMetaKey [ MiCoUsageMapBuilderTest >> testSeveralInnerBoxesColorWithTag [ | attribute shapes tag | - attribute := self specModel getInnerBoxNamed: #var6. + attribute := self specModel getInnerBoxNamed: #att6. shapes := builder canvas deepShapesFromModel: attribute. tag := self createTag: 'aTag'. self specModel setTag: tag onInnerBox: attribute. @@ -74,7 +69,7 @@ MiCoUsageMapBuilderTest >> testSeveralInnerBoxesColorWithoutTag [ | attribute shapes tagColor | - attribute := self specModel getInnerBoxNamed: #var6. + attribute := self specModel getInnerBoxNamed: #att6. shapes := builder canvas deepShapesFromModel: attribute. tagColor := builder colorFromTags: nil. @@ -86,8 +81,8 @@ MiCoUsageMapBuilderTest >> testSeveralInnerBoxesColorWithoutTag [ MiCoUsageMapBuilderTest >> testSeveralInnerBoxesForOneEntity [ | attribute shapes | - attribute := self specModel getInnerBoxNamed: #var6. + attribute := self specModel getInnerBoxNamed: #att6. shapes := builder canvas deepShapesFromModel: attribute. - self assert: shapes size equals: 2. + self assert: shapes size equals: 3. "method2, method4, method5" ] diff --git a/src/MooseIDE-CoUsageMap-Tests/MiCoUsageModelTest.class.st b/src/MooseIDE-CoUsageMap-Tests/MiCoUsageModelTest.class.st index 6fada8049..129646390 100644 --- a/src/MooseIDE-CoUsageMap-Tests/MiCoUsageModelTest.class.st +++ b/src/MooseIDE-CoUsageMap-Tests/MiCoUsageModelTest.class.st @@ -2,13 +2,13 @@ Class { #name : 'MiCoUsageModelTest', #superclass : 'TestCase', #instVars : [ - 'model', 'previousApplication', - 'application' + 'application', + 'specModel' ], - #category : 'MooseIDE-CoUsageMap-Tests-Browser', + #category : 'MooseIDE-CoUsageMap-Tests-Model', #package : 'MooseIDE-CoUsageMap-Tests', - #tag : 'Browser' + #tag : 'Model' } { #category : 'running' } @@ -16,14 +16,14 @@ MiCoUsageModelTest >> setUp [ super setUp. - model := MiCoUsageMapModel new. + specModel := MiCoUsageMapModel new. previousApplication := MiApplication current. application := MiTestApplication new. MiApplication current: application. - MiCoUsageMapBrowser newApplication: application model: model. - model followEntity: MiCoUsageTestFamixModel new allMethods + MiCoUsageMapBrowser newApplication: application model: specModel. + specModel followEntity: MiCoUsageTestFamixModel new allMethods ] { #category : 'initialization' } @@ -38,8 +38,8 @@ MiCoUsageModelTest >> tearDown [ { #category : 'tests' } MiCoUsageModelTest >> test01Basic [ - self assert: model containerBoxes size equals: 5. - self assert: model innerBoxes size equals: 5. "var5 is not used" + self assert: specModel containerBoxes size equals: 5. + self assert: specModel innerBoxes size equals: 5. "var2 is not used" ] { #category : 'tests' } @@ -47,27 +47,29 @@ MiCoUsageModelTest >> test02MethodsAttributes [ | method | - method := model containerBoxNamed: #method1. + method := specModel containerBoxNamed: #method1. self assert: method class equals: MiCoContainerBox. - self assert: method innerBoxes size equals: 2. - self assert: method innerBoxes first class equals: MiCoInnerBox. - - self assert: (model containerBoxNamed: #method2) innerBoxes size equals: 0. - self assert: (model containerBoxNamed: #method3) innerBoxes size equals: 3. - self assert: (model getInnerBoxNamed: #var2) numberOfUses equals: 2. - self assert: (model getInnerBoxNamed: #var4) numberOfUses equals: 1. - self should: [model getInnerBoxNamed: #var5] raise: Error. + self assert: method innerBoxes size equals: 1. + self assert: method innerBoxes anyOne class equals: MiCoInnerBox. + + self assert: (specModel containerBoxNamed: #method2) innerBoxes size equals: 1. + self assert: (specModel containerBoxNamed: #method3) innerBoxes size equals: 3. + + self assert: (specModel getInnerBoxNamed: #att1) numberOfUses equals: 1. + self assert: (specModel getInnerBoxNamed: #att6) numberOfUses equals: 3. + + self should: [specModel getInnerBoxNamed: #var2] raise: Error. ] { #category : 'tests' } MiCoUsageModelTest >> test03AttributeWidth [ | method | - method := model containerBoxNamed: #method1. - self assert: ((model getInnerBoxNamed: #var1) numberOfUsesOn: method) equals: 3. + method := specModel containerBoxNamed: #method1. + self assert: ((specModel getInnerBoxNamed: #att1) numberOfUsesOn: method) equals: 3. - method := model containerBoxNamed: #method3. - self assert: ((model getInnerBoxNamed: #var4) numberOfUsesOn: method) equals: 1 + method := specModel containerBoxNamed: #method3. + self assert: ((specModel getInnerBoxNamed: #att4) numberOfUsesOn: method) equals: 1 ] { #category : 'tests' } @@ -75,16 +77,16 @@ MiCoUsageModelTest >> testAutomaticColorOneTaggedInnerBox [ | tag | - tag := model currentMooseModel tagNamed: 'aTag'. - model setTag: tag onInnerBox: (model getInnerBoxNamed: #var6). + tag := specModel currentMooseModel tagNamed: 'aTag'. + specModel setTag: tag onInnerBox: (specModel getInnerBoxNamed: #att6). - model automaticColor. + specModel automaticColor. self - assertCollection: (model containerBoxNamed: #method4) mooseEntity allTags + assertCollection: (specModel containerBoxNamed: #method4) mooseEntity allTags hasSameElements: {tag}. self - assertCollection: (model containerBoxNamed: #method5) mooseEntity allTags + assertCollection: (specModel containerBoxNamed: #method5) mooseEntity allTags hasSameElements: {tag}. ] @@ -94,15 +96,15 @@ MiCoUsageModelTest >> testAutomaticColorSeveralInnerBoxAllTagged [ | tag | - tag := model currentMooseModel tagNamed: 'aTag'. - model setTag: tag onInnerBox: (model getInnerBoxNamed: #var2). - model setTag: tag onInnerBox: (model getInnerBoxNamed: #var3). - model setTag: tag onInnerBox: (model getInnerBoxNamed: #var4). + tag := specModel currentMooseModel tagNamed: 'aTag'. + specModel setTag: tag onInnerBox: (specModel getInnerBoxNamed: #att3). + specModel setTag: tag onInnerBox: (specModel getInnerBoxNamed: #att4). + specModel setTag: tag onInnerBox: (specModel getInnerBoxNamed: #att5). - model automaticColor. + specModel automaticColor. self - assertCollection: (model containerBoxNamed: #method3) mooseEntity allTags + assertCollection: (specModel containerBoxNamed: #method3) mooseEntity allTags hasSameElements: {tag}. ] @@ -112,15 +114,15 @@ MiCoUsageModelTest >> testAutomaticColorSeveralInnerBoxAndAboveThreshold [ | tag | - tag := model currentMooseModel tagNamed: 'aTag'. - model setTag: tag onInnerBox: (model getInnerBoxNamed: #var2). - model setTag: tag onInnerBox: (model getInnerBoxNamed: #var3). + tag := specModel currentMooseModel tagNamed: 'aTag'. + specModel setTag: tag onInnerBox: (specModel getInnerBoxNamed: #att3). + specModel setTag: tag onInnerBox: (specModel getInnerBoxNamed: #att4). - model settings threshold75PercentGroup: 65. - model automaticColor. + specModel settings threshold75PercentGroup: 65. + specModel automaticColor. self - assertCollection: (model containerBoxNamed: #method3) mooseEntity allTags + assertCollection: (specModel containerBoxNamed: #method3) mooseEntity allTags hasSameElements: {tag}. ] @@ -130,20 +132,20 @@ MiCoUsageModelTest >> testAutomaticColorSeveralInnerBoxAndBelowThreshold [ | tag | - tag := model currentMooseModel tagNamed: 'aTag'. - model setTag: tag onInnerBox: (model getInnerBoxNamed: #var2). - model setTag: tag onInnerBox: (model getInnerBoxNamed: #var3). + tag := specModel currentMooseModel tagNamed: 'aTag'. + specModel setTag: tag onInnerBox: (specModel getInnerBoxNamed: #att3). - model automaticColor. + specModel settings threshold75PercentGroup: 65. + specModel automaticColor. - self assert: (model containerBoxNamed: #method3) mooseEntity allTags isEmpty + self assert: (specModel containerBoxNamed: #method3) mooseEntity allTags isEmpty ] { #category : 'tests' } MiCoUsageModelTest >> testLastTagInitialization [ - self assert: model selectedTag isNil. + self assert: specModel selectedTag isNil. ] @@ -151,10 +153,10 @@ MiCoUsageModelTest >> testLastTagInitialization [ MiCoUsageModelTest >> testLastTagWithTag [ | tag | - tag := model currentMooseModel tagNamed: 'aTag'. + tag := specModel currentMooseModel tagNamed: 'aTag'. - model setTag: tag onInnerBox: (model getInnerBoxNamed: #var2). + specModel setTag: tag onInnerBox: (specModel getInnerBoxNamed: #att3). - self assert: model selectedTag equals: tag. + self assert: specModel selectedTag equals: tag. ] diff --git a/src/MooseIDE-CoUsageMap-Tests/MiCoUsageTestFamixModel.class.st b/src/MooseIDE-CoUsageMap-Tests/MiCoUsageTestFamixModel.class.st index 6d2732b8a..34d77f8a2 100644 --- a/src/MooseIDE-CoUsageMap-Tests/MiCoUsageTestFamixModel.class.st +++ b/src/MooseIDE-CoUsageMap-Tests/MiCoUsageTestFamixModel.class.st @@ -1,5 +1,20 @@ " -A FamixStModel prebuilt with 6 attributes, 5 methods, and some accesses between them +A FamixStModel prebuilt with 6 variables/attributes, 5 methods, and some accesses between them + +- method1 -> att1 +- method1 -> att1 +- method1 -> att1 +- method1 -> var2 + +- method3 -> var2 +- method3 -> att3 +- method3 -> att4 +- method3 -> att5 + +- method4 -> att6 +- method4 -> att6 + +- method5 -> att6 " Class { #name : 'MiCoUsageTestFamixModel', @@ -15,6 +30,36 @@ MiCoUsageTestFamixModel class >> canBeImportedFromFile [ ^ false ] +{ #category : 'accessing' } +MiCoUsageTestFamixModel >> att1 [ + + ^self entityNamed: 'att1' +] + +{ #category : 'accessing' } +MiCoUsageTestFamixModel >> att3 [ + + ^self entityNamed: 'att3' +] + +{ #category : 'accessing' } +MiCoUsageTestFamixModel >> att4 [ + + ^self entityNamed: 'att4' +] + +{ #category : 'accessing' } +MiCoUsageTestFamixModel >> att5 [ + + ^self entityNamed: 'att5' +] + +{ #category : 'accessing' } +MiCoUsageTestFamixModel >> att6 [ + + ^self entityNamed: 'att6' +] + { #category : 'initialization' } MiCoUsageTestFamixModel >> initialize [ @@ -29,40 +74,34 @@ MiCoUsageTestFamixModel >> initialize [ { #category : 'initialization' } MiCoUsageTestFamixModel >> initializeAccesses [ - (self entityNamed: 'method1') addAccess: - (FamixStAccess new variable: (self entityNamed: 'var1')). - (self entityNamed: 'method1') addAccess: - (FamixStAccess new variable: (self entityNamed: 'var1')). - (self entityNamed: 'method1') addAccess: - (FamixStAccess new variable: (self entityNamed: 'var1')). - (self entityNamed: 'method1') addAccess: - (FamixStAccess new variable: (self entityNamed: 'var2')). - (self entityNamed: 'method3') addAccess: - (FamixStAccess new variable: (self entityNamed: 'var2')). - (self entityNamed: 'method3') addAccess: - (FamixStAccess new variable: (self entityNamed: 'var3')). - (self entityNamed: 'method3') addAccess: - (FamixStAccess new variable: (self entityNamed: 'var4')). + self newAccess accessor: self method1 ; variable: self att1. + self newAccess accessor: self method1 ; variable: self att1. + self newAccess accessor: self method1 ; variable: self att1. + self newAccess accessor: self method1 ; variable: self var2. - (self entityNamed: 'method4') addAccess: - (FamixStAccess new variable: (self entityNamed: 'var6')). - (self entityNamed: 'method4') addAccess: - (FamixStAccess new variable: (self entityNamed: 'var6')). + self newInvocation sender: self method2 ; candidates: {self method5}. + + self newAccess accessor: self method3 ; variable: self var2. + self newAccess accessor: self method3 ; variable: self att3. + self newAccess accessor: self method3 ; variable: self att4. + self newAccess accessor: self method3 ; variable: self att5. - (self entityNamed: 'method5') addAccess: - (FamixStAccess new variable: (self entityNamed: 'var6')) + self newAccess accessor: self method4 ; variable: self att6. + self newAccess accessor: self method4 ; variable: self att6. + + self newAccess accessor: self method5 ; variable: self att6. ] { #category : 'initialization' } MiCoUsageTestFamixModel >> initializeAttributes [ - self newAttributeNamed: 'var1'. - self newAttributeNamed: 'var2'. - self newAttributeNamed: 'var3'. - self newAttributeNamed: 'var4'. - self newAttributeNamed: 'var5'. - self newAttributeNamed: 'var6' + self newAttributeNamed: 'att1'. + self newLocalVariableNamed: 'var2'. + self newAttributeNamed: 'att3'. + self newAttributeNamed: 'att4'. + self newAttributeNamed: 'att5'. + self newAttributeNamed: 'att6' ] { #category : 'initialization' } @@ -72,5 +111,41 @@ MiCoUsageTestFamixModel >> initializeMethods [ self newMethodNamed: 'method2'. self newMethodNamed: 'method3'. self newMethodNamed: 'method4'. - self newMethodNamed: 'method5' + (self newMethodNamed: 'method5') beGetter +] + +{ #category : 'accessing' } +MiCoUsageTestFamixModel >> method1 [ + + ^self entityNamed: 'method1' +] + +{ #category : 'accessing' } +MiCoUsageTestFamixModel >> method2 [ + + ^self entityNamed: 'method2' +] + +{ #category : 'accessing' } +MiCoUsageTestFamixModel >> method3 [ + + ^self entityNamed: 'method3' +] + +{ #category : 'accessing' } +MiCoUsageTestFamixModel >> method4 [ + + ^self entityNamed: 'method4' +] + +{ #category : 'accessing' } +MiCoUsageTestFamixModel >> method5 [ + + ^self entityNamed: 'method5' +] + +{ #category : 'accessing' } +MiCoUsageTestFamixModel >> var2 [ + + ^self entityNamed: 'var2' ] diff --git a/src/MooseIDE-CoUsageMap-Tests/MiCoUsageVisualizationTest.class.st b/src/MooseIDE-CoUsageMap-Tests/MiCoUsageVisualizationTest.class.st index 522271a02..b328378d5 100644 --- a/src/MooseIDE-CoUsageMap-Tests/MiCoUsageVisualizationTest.class.st +++ b/src/MooseIDE-CoUsageMap-Tests/MiCoUsageVisualizationTest.class.st @@ -16,7 +16,7 @@ MiCoUsageVisualizationTest >> test01Basic [ MiCoUsageVisualizationTest >> test03AttributeWidth [ | attribute shapes | - attribute := self specModel getInnerBoxNamed: #var1. + attribute := self specModel getInnerBoxNamed: #att1. shapes := builder canvas deepShapesFromModel: attribute. self assert: shapes size equals: 1. @@ -28,7 +28,7 @@ MiCoUsageVisualizationTest >> test04Highlight [ | attribute shapes border event | self tagsWithPalette: { 'Frame'. 'Connection' }. - attribute := self specModel getInnerBoxNamed: #var2. + attribute := self specModel getInnerBoxNamed: #att3. border := builder highlightManager selectedBoxBorder. shapes := builder canvas deepShapesFromModel: attribute. @@ -54,8 +54,8 @@ MiCoUsageVisualizationTest >> test05MethodAttributePopup [ | attribute method | self tagsWithPalette: { 'Frame'. 'Connection' }. - attribute := self specModel getInnerBoxNamed: #var2. - method := self specModel containerBoxNamed: #method1. + attribute := self specModel getInnerBoxNamed: #att3. + method := self specModel containerBoxNamed: #method3. builder createInnerBoxTextMorphFor: attribute containerBox: method; createContainerBoxTextMorphFor: method diff --git a/src/MooseIDE-CoUsageMap/MiCoFromSettingsMethodAttributeTester.class.st b/src/MooseIDE-CoUsageMap/MiCoFromSettingsMethodAttributeTester.class.st deleted file mode 100644 index 1aed24df4..000000000 --- a/src/MooseIDE-CoUsageMap/MiCoFromSettingsMethodAttributeTester.class.st +++ /dev/null @@ -1,17 +0,0 @@ -" -I use the block text from MiCoUsageMapSettingsPresenter, stored in MiCoUsageMapSettings -If there is an error with the user input, I will return an empy list -" -Class { - #name : 'MiCoFromSettingsMethodAttributeTester', - #superclass : 'MiCoMethodAttributeCounter', - #category : 'MooseIDE-CoUsageMap-Model', - #package : 'MooseIDE-CoUsageMap', - #tag : 'Model' -} - -{ #category : 'public' } -MiCoFromSettingsMethodAttributeTester >> allAttributesFor: aMiCoMethod [ - ^ [ self settings childrenBlockCompiled value: aMiCoMethod mooseEntity ] - onErrorDo: [ :ex | ex traceCr. #() ]. -] diff --git a/src/MooseIDE-CoUsageMap/MiCoInnerEntitiesAbstractExtractor.class.st b/src/MooseIDE-CoUsageMap/MiCoInnerEntitiesAbstractExtractor.class.st new file mode 100644 index 000000000..3367d2e19 --- /dev/null +++ b/src/MooseIDE-CoUsageMap/MiCoInnerEntitiesAbstractExtractor.class.st @@ -0,0 +1,28 @@ +" +An abstract super-class for various strategies to compute children boxes of a container box +" +Class { + #name : 'MiCoInnerEntitiesAbstractExtractor', + #superclass : 'Object', + #category : 'MooseIDE-CoUsageMap-Model', + #package : 'MooseIDE-CoUsageMap', + #tag : 'Model' +} + +{ #category : 'accessing' } +MiCoInnerEntitiesAbstractExtractor class >> description [ + + self subclassResponsibility +] + +{ #category : 'accessing' } +MiCoInnerEntitiesAbstractExtractor class >> menuItemName [ + + self subclassResponsibility +] + +{ #category : 'execute' } +MiCoInnerEntitiesAbstractExtractor >> innerEntitiesFor: containerBox [ + + self subclassResponsibility +] diff --git a/src/MooseIDE-CoUsageMap/MiCoInnerEntitiesAttributeAccessExtractor.class.st b/src/MooseIDE-CoUsageMap/MiCoInnerEntitiesAttributeAccessExtractor.class.st new file mode 100644 index 000000000..a116a44f2 --- /dev/null +++ b/src/MooseIDE-CoUsageMap/MiCoInnerEntitiesAttributeAccessExtractor.class.st @@ -0,0 +1,54 @@ +Class { + #name : 'MiCoInnerEntitiesAttributeAccessExtractor', + #superclass : 'MiCoInnerEntitiesAbstractExtractor', + #category : 'MooseIDE-CoUsageMap-Model', + #package : 'MooseIDE-CoUsageMap', + #tag : 'Model' +} + +{ #category : 'accessing' } +MiCoInnerEntitiesAttributeAccessExtractor class >> description [ + + ^'Inner boxes are all the attributes accessed by the entities +(typically methods) represented by the container boxes' +] + +{ #category : 'accessing' } +MiCoInnerEntitiesAttributeAccessExtractor class >> menuItemName [ + + ^'Attribute access' +] + +{ #category : 'execute' } +MiCoInnerEntitiesAttributeAccessExtractor >> attributeAccessorInvocations: anEntity [ + "building the list manually instead of using 2 #flatCollect:" + + | attributes | + attributes := OrderedCollection new. + + anEntity outgoingInvocations + do: [ :invoc | + invoc candidates + do: [ :mth | + mth isAccessor ifTrue: [ attributes addAll: (self directAttributeAccesses: mth) ] + ] + ]. + + ^attributes + +] + +{ #category : 'execute' } +MiCoInnerEntitiesAttributeAccessExtractor >> directAttributeAccesses: entityWithAccesses [ + + ^entityWithAccesses accesses + collect: [ :access | access variable ] + thenSelect: [ :var | var isAttribute ] +] + +{ #category : 'execute' } +MiCoInnerEntitiesAttributeAccessExtractor >> innerEntitiesFor: anEntity [ + + ^(self directAttributeAccesses: anEntity) , (self attributeAccessorInvocations: anEntity) + +] diff --git a/src/MooseIDE-CoUsageMap/MiCoInnerEntitiesClientClassesExtractor.class.st b/src/MooseIDE-CoUsageMap/MiCoInnerEntitiesClientClassesExtractor.class.st new file mode 100644 index 000000000..bd7211706 --- /dev/null +++ b/src/MooseIDE-CoUsageMap/MiCoInnerEntitiesClientClassesExtractor.class.st @@ -0,0 +1,27 @@ +Class { + #name : 'MiCoInnerEntitiesClientClassesExtractor', + #superclass : 'MiCoInnerEntitiesAbstractExtractor', + #category : 'MooseIDE-CoUsageMap-Model', + #package : 'MooseIDE-CoUsageMap', + #tag : 'Model' +} + +{ #category : 'accessing' } +MiCoInnerEntitiesClientClassesExtractor class >> description [ + + ^'Inner boxes are all the classes dependending on +the entities represented by the container boxes' +] + +{ #category : 'accessing' } +MiCoInnerEntitiesClientClassesExtractor class >> menuItemName [ + + ^'Client classes' +] + +{ #category : 'execute' } +MiCoInnerEntitiesClientClassesExtractor >> innerEntitiesFor: containerEntity [ + + ^containerEntity allClients + flatCollect: [ :client | client containersOfType: FamixTClass ] +] diff --git a/src/MooseIDE-CoUsageMap/MiCoInnerEntitiesProviderClassesExtractor.class.st b/src/MooseIDE-CoUsageMap/MiCoInnerEntitiesProviderClassesExtractor.class.st new file mode 100644 index 000000000..c818d547e --- /dev/null +++ b/src/MooseIDE-CoUsageMap/MiCoInnerEntitiesProviderClassesExtractor.class.st @@ -0,0 +1,27 @@ +Class { + #name : 'MiCoInnerEntitiesProviderClassesExtractor', + #superclass : 'MiCoInnerEntitiesAbstractExtractor', + #category : 'MooseIDE-CoUsageMap-Model', + #package : 'MooseIDE-CoUsageMap', + #tag : 'Model' +} + +{ #category : 'accessing' } +MiCoInnerEntitiesProviderClassesExtractor class >> description [ + + ^'Inner boxes are all the classes accessed by +the entities represented by the container boxes' +] + +{ #category : 'accessing' } +MiCoInnerEntitiesProviderClassesExtractor class >> menuItemName [ + + ^'Classes used' +] + +{ #category : 'execute' } +MiCoInnerEntitiesProviderClassesExtractor >> innerEntitiesFor: containerEntity [ + + ^containerEntity allProviders + flatCollect: [ :prov | prov containersOfType: FamixTClass ] +] diff --git a/src/MooseIDE-CoUsageMap/MiCoMenuManager.class.st b/src/MooseIDE-CoUsageMap/MiCoMenuManager.class.st index 9835b934b..9c592ed63 100644 --- a/src/MooseIDE-CoUsageMap/MiCoMenuManager.class.st +++ b/src/MooseIDE-CoUsageMap/MiCoMenuManager.class.st @@ -39,13 +39,7 @@ MiCoMenuManager >> createGlobalMenuOn: menu [ selector: #automaticColor argumentList: #()) icon: (self iconNamed: #smallPaint). - menu addLine. - (menu - add: 'Settings' - target: mapBuilder visualization - selector: #openSettings - argumentList: #()) - icon: (self iconNamed: #configuration) + ] diff --git a/src/MooseIDE-CoUsageMap/MiCoMethodAttributeCounter.class.st b/src/MooseIDE-CoUsageMap/MiCoMethodAttributeCounter.class.st deleted file mode 100644 index 0f2c13c1c..000000000 --- a/src/MooseIDE-CoUsageMap/MiCoMethodAttributeCounter.class.st +++ /dev/null @@ -1,31 +0,0 @@ -" -Used to obtain a list of inner models and their number of uses on the current method. -" -Class { - #name : 'MiCoMethodAttributeCounter', - #superclass : 'Object', - #instVars : [ - 'settings' - ], - #category : 'MooseIDE-CoUsageMap-Model', - #package : 'MooseIDE-CoUsageMap', - #tag : 'Model' -} - -{ #category : 'public' } -MiCoMethodAttributeCounter >> allAttributesFor: aMiCoMethod [ - "should return a list of associations(a Bag), for each association: - key is the object - value is the number of uses of that object is used by aMiCoMethod" - ^ self subclassResponsibility -] - -{ #category : 'accessing' } -MiCoMethodAttributeCounter >> settings [ - ^ settings -] - -{ #category : 'accessing' } -MiCoMethodAttributeCounter >> settings: anObject [ - settings := anObject -] diff --git a/src/MooseIDE-CoUsageMap/MiCoPharoMethodAttributeCounter.class.st b/src/MooseIDE-CoUsageMap/MiCoPharoMethodAttributeCounter.class.st deleted file mode 100644 index 2dcef9f2f..000000000 --- a/src/MooseIDE-CoUsageMap/MiCoPharoMethodAttributeCounter.class.st +++ /dev/null @@ -1,28 +0,0 @@ -" -Default class used by MiCoUsageMapBuilder. It works with pharo methods. -associationsFor: recives one method and return a list of associations, where the key of one association is the attribute and the valuee is the number of uses of that attribute in the method -" -Class { - #name : 'MiCoPharoMethodAttributeCounter', - #superclass : 'MiCoMethodAttributeCounter', - #category : 'MooseIDE-CoUsageMap-Model', - #package : 'MooseIDE-CoUsageMap', - #tag : 'Model' -} - -{ #category : 'testing' } -MiCoPharoMethodAttributeCounter class >> isDeprecated [ - "Does not seem to be used" - - ^ true -] - -{ #category : 'public' } -MiCoPharoMethodAttributeCounter >> allAttributesFor: aMiCoMethod [ - | method result | - method := aMiCoMethod mooseEntity. - result := RBGenericNodeVisitor - visit: method ast - select: [ :node| node isInstanceVariable ]. - ^ result collect: [:node | node name ] -] diff --git a/src/MooseIDE-CoUsageMap/MiCoUsageMapBlockSettingsPresenter.class.st b/src/MooseIDE-CoUsageMap/MiCoUsageMapBlockSettingsPresenter.class.st deleted file mode 100644 index daa5f7e06..000000000 --- a/src/MooseIDE-CoUsageMap/MiCoUsageMapBlockSettingsPresenter.class.st +++ /dev/null @@ -1,171 +0,0 @@ -" -Presenter created to edit the children block, outer boxes sort block, and inner boxes sort block. -This interacts directly with MiCoUsageMapSettings -" -Class { - #name : 'MiCoUsageMapBlockSettingsPresenter', - #superclass : 'SpPresenter', - #instVars : [ - 'childrenTextInput', - 'sortOuterBoxTextInput', - 'sortInnerBoxTextInput', - 'resetButton', - 'applyButton', - 'closeButton' - ], - #category : 'MooseIDE-CoUsageMap-Browser', - #package : 'MooseIDE-CoUsageMap', - #tag : 'Browser' -} - -{ #category : 'accessing - private tests' } -MiCoUsageMapBlockSettingsPresenter >> applyButton [ - - ^applyButton -] - -{ #category : 'layout' } -MiCoUsageMapBlockSettingsPresenter >> buttonRowLayout [ - - ^SpBoxLayout newLeftToRight - hAlignCenter; - borderWidth: 5; - addLast: (SpBoxLayout newLeftToRight - add: applyButton ; - add: resetButton ; - add: closeButton ; - yourself) - expand: false; - yourself -] - -{ #category : 'accessing - private tests' } -MiCoUsageMapBlockSettingsPresenter >> childrenTextInput [ - - ^childrenTextInput -] - -{ #category : 'accessing - private tests' } -MiCoUsageMapBlockSettingsPresenter >> closeButton [ - - ^closeButton -] - -{ #category : 'initialization' } -MiCoUsageMapBlockSettingsPresenter >> closeWindow [ - - self delete -] - -{ #category : 'initialization' } -MiCoUsageMapBlockSettingsPresenter >> connectPresenters [ - - self settings ifNil: [ ^ self ]. - - childrenTextInput - text: self settings childrenBlockText ; - whenSubmitDo: [ :text | self settings childrenBlockText: text ]. - - sortOuterBoxTextInput - text: self settings outerBoxSortBlockText ; - whenSubmitDo: [ :text | self settings outerBoxSortBlockText: text ]. - - sortInnerBoxTextInput - text: self settings innerBoxSortBlockText ; - whenSubmitDo: [ :text | self settings innerBoxSortBlockText: text ]. - - applyButton action: [ - childrenTextInput triggerSubmitAction. - sortOuterBoxTextInput triggerSubmitAction. - sortInnerBoxTextInput triggerSubmitAction. - self closeWindow - ]. - - resetButton action: [ | set | - set := self settings. - set resetText. - childrenTextInput text: set childrenBlockText. - sortOuterBoxTextInput text: set outerBoxSortBlockText. - sortInnerBoxTextInput text: set innerBoxSortBlockText. - ]. - closeButton action: [ - self closeWindow - ]. -] - -{ #category : 'layout' } -MiCoUsageMapBlockSettingsPresenter >> defaultLayout [ - ^ SpBoxLayout newTopToBottom - spacing: 3; - - add: 'Children block:' asPresenter expand: false ; - add: childrenTextInput height: 200 ; - - add: 'Outer box sort block:' asPresenter expand: false ; - add: sortOuterBoxTextInput height: 170 ; - - add: 'Inner box sort block:' asPresenter expand: false ; - add: sortInnerBoxTextInput height: 170 ; - - add: self buttonRowLayout - expand: false; - - yourself -] - -{ #category : 'initialization' } -MiCoUsageMapBlockSettingsPresenter >> initializeButtons [ - - applyButton := self newButton - label: 'Apply all'. - resetButton := self newButton - label: 'Reset text fields'. - closeButton := self newButton - label: 'Close'. - -] - -{ #category : 'initialization' } -MiCoUsageMapBlockSettingsPresenter >> initializePresenters [ - - childrenTextInput := self newCode. - sortOuterBoxTextInput := self newCode. - sortInnerBoxTextInput := self newCode. - - self initializeButtons -] - -{ #category : 'initialization' } -MiCoUsageMapBlockSettingsPresenter >> initializeWindow: aWindowPresenter [ - aWindowPresenter - initialExtent: 500@700; - title: 'Blocks Settings - Co Usage Map' -] - -{ #category : 'accessing - private tests' } -MiCoUsageMapBlockSettingsPresenter >> resetButton [ - - ^resetButton -] - -{ #category : 'accessing' } -MiCoUsageMapBlockSettingsPresenter >> settings [ - ^ owner settings -] - -{ #category : 'accessing' } -MiCoUsageMapBlockSettingsPresenter >> settings: anObject [ - owner settings: anObject -] - -{ #category : 'accessing - private tests' } -MiCoUsageMapBlockSettingsPresenter >> sortInnerBoxTextInput [ - - ^sortInnerBoxTextInput -] - -{ #category : 'accessing - private tests' } -MiCoUsageMapBlockSettingsPresenter >> sortOuterBoxTextInput [ - - ^sortOuterBoxTextInput -] diff --git a/src/MooseIDE-CoUsageMap/MiCoUsageMapBrowser.class.st b/src/MooseIDE-CoUsageMap/MiCoUsageMapBrowser.class.st index 64664b244..8881414b0 100644 --- a/src/MooseIDE-CoUsageMap/MiCoUsageMapBrowser.class.st +++ b/src/MooseIDE-CoUsageMap/MiCoUsageMapBrowser.class.st @@ -89,14 +89,6 @@ MiCoUsageMapBrowser >> canFollowEntity: anEntity [ ^ anEntity isCollection and: [ anEntity isMooseModel not ] ] -{ #category : 'private - for tests' } -MiCoUsageMapBrowser >> closeSettings [ - "to close the settings window when testing - Should not be used otherwise" - - specModel closeSettings -] - { #category : 'actions' } MiCoUsageMapBrowser >> followEntity: anEntity [ @@ -125,6 +117,12 @@ MiCoUsageMapBrowser >> mapVisualization [ ^ mainPresenter ] +{ #category : 'accessing' } +MiCoUsageMapBrowser >> refresh [ + + self runVisualization. +] + { #category : 'dependencies' } MiCoUsageMapBrowser >> release [ self class instVarNames do: [ :n | self instVarNamed: n put: nil ] diff --git a/src/MooseIDE-CoUsageMap/MiCoUsageMapBuilder.class.st b/src/MooseIDE-CoUsageMap/MiCoUsageMapBuilder.class.st index 1b7722d7b..4724cce21 100644 --- a/src/MooseIDE-CoUsageMap/MiCoUsageMapBuilder.class.st +++ b/src/MooseIDE-CoUsageMap/MiCoUsageMapBuilder.class.st @@ -193,13 +193,12 @@ MiCoUsageMapBuilder >> initializeShapes [ { #category : 'hooks' } MiCoUsageMapBuilder >> innerBoxShapeFor: innerBox containerBox: containerBox [ - | height | - height := self specModel innerBoxHeight. + widthScale := self specModel widthScale. ^ RSBox new model: innerBox; width: (widthScale scale: (innerBox numberOfUses)); - height: height; + height: 10; color: (self colorFromTags: innerBox tag); border: (self highlightManager defaultBoxBorder); propertyAt: #container put: containerBox; @@ -332,22 +331,13 @@ MiCoUsageMapBuilder >> shouldUseProgressBar [ { #category : 'public' } MiCoUsageMapBuilder >> sortShapes [ - | block children tBlock | - block := self specModel outerBoxSortBlockCompiled. - tBlock := [ :a :b | block value: a model value: b model ]. - children := self canvas children. - [ children sort: tBlock ] - onErrorDo: [ :ex | - block := self specModel defaultSortBlock. - children sort: tBlock ]. - block := self specModel innerBoxSortBlockCompiled. - children do: [ :node | - tBlock := [ :a :b | - block value: a model value: b model value: node model ]. - [ node innerBoxShapes sort: tBlock ] - onErrorDo: [ :ex | - block := self specModel defaultInnerSortBlock. - node innerBoxShapes sort: tBlock ] + | containerBoxes | + + containerBoxes := self canvas children. + self specModel sortContainerBoxes: containerBoxes. + + containerBoxes do: [ :containerBox | + self specModel sortInnerShapes: containerBox ] ] @@ -377,19 +367,6 @@ MiCoUsageMapBuilder >> updateBoxColor: aMiCoBox fromTags: tags [ ] -{ #category : 'update' } -MiCoUsageMapBuilder >> updateChildren [ - | canvas | - canvas := self canvas. - canvas nodes copy do: #remove. - self initializeValues. - shapes := self containerBoxes collect: [ :met | self containerBoxShapeFor: met ]. - canvas addAll: shapes. - self sortShapes. - self applyLayout. - canvas signalUpdate. -] - { #category : 'update' } MiCoUsageMapBuilder >> updateInnerBoxSize [ | range newScale scaleType | diff --git a/src/MooseIDE-CoUsageMap/MiCoUsageMapModel.class.st b/src/MooseIDE-CoUsageMap/MiCoUsageMapModel.class.st index 1d78322b9..c1b38a231 100644 --- a/src/MooseIDE-CoUsageMap/MiCoUsageMapModel.class.st +++ b/src/MooseIDE-CoUsageMap/MiCoUsageMapModel.class.st @@ -8,7 +8,6 @@ Class { 'settingsWindow', 'containerEntities', 'selectedEntity', - 'methodAttributeCounter', 'innerBoxes', 'containerBoxes', 'widthScale', @@ -19,6 +18,16 @@ Class { #tag : 'Model' } +{ #category : 'public' } +MiCoUsageMapModel >> allAttributesFor: aMiCoMethod [ + "should return a list of associations(a Bag), for each association: + key is the object + value is the number of uses of that object is used by aMiCoMethod" + + ^[ self settings innerBoxExtractor new innerEntitiesFor: aMiCoMethod mooseEntity ] + onErrorDo: [ :ex | ex traceCr. #() ]. +] + { #category : 'tagging' } MiCoUsageMapModel >> automaticColor [ @@ -56,12 +65,6 @@ MiCoUsageMapModel >> changeTagsDuring: aBlockClosure [ self selectedTag: lastTag ] -{ #category : 'private - for tests' } -MiCoUsageMapModel >> closeSettings [ - "used only for closing settings opened in tests" - settingsWindow ifNotNil: [ settingsWindow close ] -] - { #category : 'accessing' } MiCoUsageMapModel >> containerBoxNamed: aByteString [ ^ self containerBoxes detect: [ :contr | contr name = aByteString ] @@ -82,39 +85,6 @@ MiCoUsageMapModel >> containerEntities: aCollection [ containerEntities := aCollection ] -{ #category : 'accessing' } -MiCoUsageMapModel >> containerInnerCounter [ - - ^ methodAttributeCounter -] - -{ #category : 'accessing' } -MiCoUsageMapModel >> containerInnerCounter: aMiCoMethodAttributeCounter [ - methodAttributeCounter := aMiCoMethodAttributeCounter -] - -{ #category : 'settings' } -MiCoUsageMapModel >> defaultInnerSortBlock [ - ^ [ :inner1 :inner2 :containr | inner1 name < inner2 name ]. -] - -{ #category : 'settings' } -MiCoUsageMapModel >> defaultSortBlock [ - ^ [ :container1 :container2 | - | size1 size2 | - size1 := container1 innerBoxes size. - size2 := container2 innerBoxes size. - size1 = size2 - ifTrue: [ container1 name < container2 name ] - ifFalse: [ size1 > size2 ] - ]. -] - -{ #category : 'settings' } -MiCoUsageMapModel >> defaultTester [ - ^ MiCoFromSettingsMethodAttributeTester new -] - { #category : 'accessing' } MiCoUsageMapModel >> entities [ ^containerEntities @@ -163,8 +133,7 @@ MiCoUsageMapModel >> getOrCreateInnerBoxFor: object [ MiCoUsageMapModel >> initialize [ super initialize. - settings := MiCoUsageMapSettings new. - self containerInnerCounter: self defaultTester + settings := MiCoUsageMapSettings new ] { #category : 'initialization' } @@ -178,12 +147,10 @@ MiCoUsageMapModel >> initializeContainerBoxes [ { #category : 'initialization' } MiCoUsageMapModel >> initializeReferences [ innerBoxes := OrderedCollection new. - - self containerInnerCounter settings: self settings. self containerBoxes do: [ :cont | | bag | - bag := Bag withAll: (self containerInnerCounter allAttributesFor: cont). + bag := Bag withAll: (self allAttributesFor: cont). bag doWithOccurrences: [ :innerEntity :count | | in | count > 0 ifTrue: [ in := self getOrCreateInnerBoxFor: innerEntity. @@ -222,11 +189,6 @@ MiCoUsageMapModel >> innerBoxHeight [ ^self settings innerBoxHeight ] -{ #category : 'settings' } -MiCoUsageMapModel >> innerBoxSortBlockCompiled [ - ^self settings innerBoxSortBlockCompiled -] - { #category : 'accessing' } MiCoUsageMapModel >> innerBoxes [ ^ innerBoxes @@ -287,16 +249,12 @@ MiCoUsageMapModel >> newInnerBoxFor: anObject [ MiCoUsageMapModel >> openSettings [ "note: should use default settings infrastructure" - ^MiCoUsageMapGeneralSettingsPresenter new + ^MiCoUsageMapSettingsPresenter new settings: settings ; + specModel: self ; openDialog ] -{ #category : 'settings' } -MiCoUsageMapModel >> outerBoxSortBlockCompiled [ - ^self settings outerBoxSortBlockCompiled -] - { #category : 'events' } MiCoUsageMapModel >> quickTaggingOn: entity [ @@ -306,6 +264,13 @@ MiCoUsageMapModel >> quickTaggingOn: entity [ ] +{ #category : 'actions' } +MiCoUsageMapModel >> refreshVisualization [ + + self initializeValues. + browser refresh +] + { #category : 'tagging' } MiCoUsageMapModel >> removeTagOn: aMooseEntity [ aMooseEntity allTags @@ -344,6 +309,29 @@ MiCoUsageMapModel >> settings [ ^settings ] +{ #category : 'sorting' } +MiCoUsageMapModel >> sortContainerBoxes: containerShapes [ + + containerShapes sort: [:containerA :containerB || sizeA sizeB | + sizeA := containerA model numberOfInnerBoxes. + sizeB := containerB model numberOfInnerBoxes. + sizeA = sizeB + ifTrue: [ containerA model name < containerB model name ] + ifFalse: [ sizeA > sizeB ] ]. +] + +{ #category : 'sorting' } +MiCoUsageMapModel >> sortInnerShapes: containerShape [ + + containerShape innerBoxShapes sort: [:entityA :entityB || sizeA sizeB | + sizeA := entityA model numberOfUsesOn: containerShape model. + sizeB := entityB model numberOfUsesOn: containerShape model. + sizeA = sizeB + ifTrue: [ entityA model name < entityB model name ] + ifFalse: [ sizeA > sizeB ] + ] +] + { #category : 'tagging' } MiCoUsageMapModel >> tagEntity: aMooseEntity with: aTag [ "entites can have only one tag in this tool" diff --git a/src/MooseIDE-CoUsageMap/MiCoUsageMapSettings.class.st b/src/MooseIDE-CoUsageMap/MiCoUsageMapSettings.class.st index c14410f5f..b786c5a37 100644 --- a/src/MooseIDE-CoUsageMap/MiCoUsageMapSettings.class.st +++ b/src/MooseIDE-CoUsageMap/MiCoUsageMapSettings.class.st @@ -12,142 +12,10 @@ Class { #tag : 'Settings' } -{ #category : 'settings' } -MiCoUsageMapSettings >> browsingBlockSettings: aBuilder [ - - (aBuilder group: #ShowBlockSettings) - target: self; - parent: #CoUsageMap; - order: 101; - label: 'Blocks settings'; - description: 'Receives 2 outer nodes, returns if it should swap nodes'; - dialog: [ PluggableButtonMorph - on: self - getState: nil - action: #openBlocksSettings - label: #buttonSettingLabel ] - - -] - -{ #category : 'settings' } -MiCoUsageMapSettings >> browsingSettingInnerBoxRange: aBuilder [ - - - (aBuilder miDualRange: #innerBoxRange) - parent: #CoUsageMap; - target: self; - order: 4; - label: 'Range for inner boxes'; - description: 'Use this to change the minimun and maximun size of the inner boxes'; - default: self defaultInnerBoxRange; - range: (5 to: 100) - -] - -{ #category : 'settings' } -MiCoUsageMapSettings >> browsingSettingInnerScale: aBuilder [ - - (aBuilder pickOne: #innerBoxScaleType) - parent: #CoUsageMap; - domainValues: self scaleTypes; - target: self; - order: 3; - label: 'Inner box width scale'; - description: 'Choose between different types of scales'; - default: self defaultInnerBoxScaleType -] - -{ #category : 'settings' } -MiCoUsageMapSettings >> browsingSettingInnerSize: aBuilder [ - - (aBuilder miRange: #innerBoxHeight) - parent: #CoUsageMap; - target: self; - order: 1; - label: 'Inner box height'; - description: 'Will change the height of the inner box for co usage map visualization'; - default: self defaultInnerBoxHeight; - range: (2 to: 50) - -] - -{ #category : 'settings' } -MiCoUsageMapSettings >> browsingSettingThreshold: aBuilder [ - - (aBuilder miRange: #threshold75PercentGroup) - parent: #CoUsageMap; - target: self; - order: 0; - label: 'Threshold percent per group'; - description: 'This threshold is used by automatic color methods in the CoUsageMapBrowser. -When the container has several attributes of different colors, the color is chosen from the group that exceeds the threshold in relation to the size of the attributes.'; - default: self defaultThreshold75; - range: (10 to: 100) - -] - -{ #category : 'settings' } -MiCoUsageMapSettings >> browsingSettings02On: aBuilder [ - - - (aBuilder group: #CoUsageMap) - parent: #moose; - label: 'Co Usage Map'; - description: 'Alls settings concerned with co usage map browser'; - order: 10 -] - -{ #category : 'accessing' } -MiCoUsageMapSettings >> buttonSettingLabel [ - ^ 'Blocks Settings' - - -] - -{ #category : 'accessing - computed' } -MiCoUsageMapSettings >> childrenBlockCompiled [ - ^ self compiledBlock: self childrenBlockText onError: self defaultChildrenBlockText -] - -{ #category : 'accessing' } -MiCoUsageMapSettings >> childrenBlockText [ - ^ self propertiesMap at: #childrenBlockText ifAbsent: [ self defaultChildrenBlockText ] -] - -{ #category : 'accessing' } -MiCoUsageMapSettings >> childrenBlockText: aString [ - self propertiesMap at: #childrenBlockText put: aString -] - -{ #category : 'accessing - computed' } -MiCoUsageMapSettings >> compiledBlock: aString onError: defaultString [ - | compiler | - compiler := Smalltalk compiler. - ^ [ compiler evaluate: aString ] - on: Error - do: [ :ex | compiler evaluate: defaultString ] -] - { #category : 'accessing - defaults' } -MiCoUsageMapSettings >> defaultChildrenBlockText [ - - ^ '"This code is for entity method, but you can change it -You should return all the inner entities even with duplicates" -[ :entity | - entity isContainerEntity - ifTrue: [ - entity accesses - collect: [ :access | access variable ] - thenSelect: [ :var | var isAttribute ] - ] - ifFalse: [ #() ] -]' -] +MiCoUsageMapSettings >> defaultInnerBoxExtractor [ -{ #category : 'accessing - defaults' } -MiCoUsageMapSettings >> defaultInnerBoxHeight [ - ^ 10 + ^MiCoInnerEntitiesAttributeAccessExtractor ] { #category : 'accessing - defaults' } @@ -160,43 +28,19 @@ MiCoUsageMapSettings >> defaultInnerBoxScaleType [ ^ #linear ] -{ #category : 'accessing - defaults' } -MiCoUsageMapSettings >> defaultInnerBoxSortBlockText [ - ^ '[:entityA :entityB :container | - | sizeA sizeB | - sizeA := entityA numberOfUsesOn: container. - sizeB := entityB numberOfUsesOn: container. - sizeA = sizeB - ifTrue: [ entityA name < entityB name ] - ifFalse: [ sizeA > sizeB ] -]' -] - -{ #category : 'accessing - defaults' } -MiCoUsageMapSettings >> defaultOuterBoxSortBlockText [ - ^ '[:containerA :containerB | -"containers are MiCoMethod instances" -| sizeA sizeB | -sizeA := containerA numberOfChildren. -sizeB := containerB numberOfChildren. -sizeA = sizeB - ifTrue: [ containerA name < containerB name ] - ifFalse: [ sizeA > sizeB ] ]' -] - { #category : 'accessing - defaults' } MiCoUsageMapSettings >> defaultThreshold75 [ ^ 75 ] { #category : 'accessing' } -MiCoUsageMapSettings >> innerBoxHeight [ - ^ self propertiesMap at: #innerBoxHeight ifAbsent: [ self defaultInnerBoxHeight ]. +MiCoUsageMapSettings >> innerBoxExtractor [ + ^ self propertiesMap at: #innerBoxExtractor ifAbsent: [ self defaultInnerBoxExtractor ] ] { #category : 'accessing' } -MiCoUsageMapSettings >> innerBoxHeight: aNumber [ - self propertiesMap at: #innerBoxHeight put: aNumber +MiCoUsageMapSettings >> innerBoxExtractor: aString [ + self propertiesMap at: #innerBoxExtractor put: aString ] { #category : 'accessing' } @@ -219,43 +63,6 @@ MiCoUsageMapSettings >> innerBoxScaleType: aString [ self propertiesMap at: #innerBoxScaleType put: aString ] -{ #category : 'accessing - computed' } -MiCoUsageMapSettings >> innerBoxSortBlockCompiled [ - ^ self compiledBlock: self innerBoxSortBlockText onError: self defaultInnerBoxSortBlockText -] - -{ #category : 'accessing' } -MiCoUsageMapSettings >> innerBoxSortBlockText [ - ^ self propertiesMap at: #innerBoxSortBlockText ifAbsent: [ self defaultInnerBoxSortBlockText ] -] - -{ #category : 'accessing' } -MiCoUsageMapSettings >> innerBoxSortBlockText: aString [ - self propertiesMap at: #innerBoxSortBlockText put: aString -] - -{ #category : 'opening' } -MiCoUsageMapSettings >> openBlocksSettings [ - MiCoUsageMapBlockSettingsPresenter new - settings: self; - open -] - -{ #category : 'accessing - computed' } -MiCoUsageMapSettings >> outerBoxSortBlockCompiled [ - ^ self compiledBlock: self outerBoxSortBlockText onError: self defaultOuterBoxSortBlockText -] - -{ #category : 'accessing' } -MiCoUsageMapSettings >> outerBoxSortBlockText [ - ^ self propertiesMap at: #outerBoxSortBlockText ifAbsent: [ self defaultOuterBoxSortBlockText ] -] - -{ #category : 'accessing' } -MiCoUsageMapSettings >> outerBoxSortBlockText: aString [ - self propertiesMap at: #outerBoxSortBlockText put: aString -] - { #category : 'private' } MiCoUsageMapSettings >> propertiesMap [ ^ properties ifNil: [ properties := Dictionary new ] @@ -270,9 +77,7 @@ MiCoUsageMapSettings >> reset [ MiCoUsageMapSettings >> resetText [