From 811448b655f476006602d6badd81dcb4e21f1ce7 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Wed, 17 Jun 2020 01:19:12 +0200 Subject: [PATCH 1/7] Add AddOrUpdateAttribute to AttributesUpdater --- Rubberduck.Parsing/VBA/AttributesUpdater.cs | 104 +++++--- Rubberduck.Parsing/VBA/IAttributesUpdater.cs | 1 + .../PostProcessing/AttributesUpdaterTests.cs | 246 ++++++++++++++++++ 3 files changed, 322 insertions(+), 29 deletions(-) diff --git a/Rubberduck.Parsing/VBA/AttributesUpdater.cs b/Rubberduck.Parsing/VBA/AttributesUpdater.cs index faac4ad0f1..784d63e519 100644 --- a/Rubberduck.Parsing/VBA/AttributesUpdater.cs +++ b/Rubberduck.Parsing/VBA/AttributesUpdater.cs @@ -8,6 +8,7 @@ using Rubberduck.Parsing.Rewriter; using Rubberduck.Parsing.Symbols; using Rubberduck.Parsing.VBA.Parsing; +using Rubberduck.VBEditor; namespace Rubberduck.Parsing.VBA { @@ -72,38 +73,50 @@ public void AddAttribute(IRewriteSession rewriteSession, Declaration declaration var rewriter = rewriteSession.CheckOutModuleRewriter(declaration.QualifiedModuleName); if (declaration.DeclarationType.HasFlag(DeclarationType.Module)) { - var moduleParseTree = (ParserRuleContext)_parseTreeProvider.GetParseTree(declaration.QualifiedModuleName, CodeKind.AttributesCode); - var lastModuleAttribute = moduleParseTree.GetDescendents() - .Where(moduleAttributes => moduleAttributes.attributeStmt() != null) - .SelectMany(moduleAttributes => moduleAttributes.attributeStmt()) - .OrderBy(moduleAttribute => moduleAttribute.stop.TokenIndex) - .LastOrDefault(); - if (lastModuleAttribute == null) - { - //This should never happen for a real module. - var codeToInsert = $"Attribute {attribute} = {AttributeValuesText(values)}{Environment.NewLine}"; - rewriter.InsertBefore(0, codeToInsert); - } - else - { - var codeToInsert = $"{Environment.NewLine}Attribute {attribute} = {AttributeValuesText(values)}"; - rewriter.InsertAfter(lastModuleAttribute.stop.TokenIndex, codeToInsert); - } + var codeToAdd = $"Attribute {attribute} = {AttributeValuesText(values)}"; + InsertAfterLastModuleAttribute(rewriter, declaration.QualifiedModuleName, codeToAdd); } else { - var attributesContext = declaration.AttributesPassContext; - var firstEndOfLineInMember = attributesContext.GetDescendent(); - if (firstEndOfLineInMember == null) - { - var codeToInsert = $"{Environment.NewLine}Attribute {attribute} = {AttributeValuesText(values)}"; - rewriter.InsertAfter(declaration.AttributesPassContext.Stop.TokenIndex, codeToInsert); - } - else - { - var codeToInsert = $"Attribute {attribute} = {AttributeValuesText(values)}{Environment.NewLine}"; - rewriter.InsertAfter(firstEndOfLineInMember.Stop.TokenIndex, codeToInsert); - } + var codeToAdd = $"Attribute {attribute} = {AttributeValuesText(values)}"; + InsertAfterFirstEolOfAttributeContext(rewriter, declaration, codeToAdd); + } + } + + private void InsertAfterLastModuleAttribute(IModuleRewriter rewriter, QualifiedModuleName module, string codeToAdd) + { + var moduleParseTree = (ParserRuleContext)_parseTreeProvider.GetParseTree(module, CodeKind.AttributesCode); + var lastModuleAttribute = moduleParseTree.GetDescendents() + .Where(moduleAttributes => moduleAttributes.attributeStmt() != null) + .SelectMany(moduleAttributes => moduleAttributes.attributeStmt()) + .OrderBy(moduleAttribute => moduleAttribute.stop.TokenIndex) + .LastOrDefault(); + if (lastModuleAttribute == null) + { + //This should never happen for a real module. + var codeToInsert = codeToAdd + Environment.NewLine; + rewriter.InsertBefore(0, codeToInsert); + } + else + { + var codeToInsert = Environment.NewLine + codeToAdd; + rewriter.InsertAfter(lastModuleAttribute.stop.TokenIndex, codeToInsert); + } + } + + private void InsertAfterFirstEolOfAttributeContext(IModuleRewriter rewriter, Declaration declaration, string codeToAdd) + { + var attributesContext = declaration.AttributesPassContext; + var firstEndOfLineInMember = attributesContext.GetDescendent(); + if (firstEndOfLineInMember == null) + { + var codeToInsert = Environment.NewLine + codeToAdd; + rewriter.InsertAfter(declaration.AttributesPassContext.Stop.TokenIndex, codeToInsert); + } + else + { + var codeToInsert = codeToAdd + Environment.NewLine; + rewriter.InsertAfter(firstEndOfLineInMember.Stop.TokenIndex, codeToInsert); } } @@ -223,5 +236,38 @@ private static void UpdateAttributeValues(IModuleRewriter rewriter, AttributeNod rewriter.Replace(new Interval(firstIndexToReplace, lastIndexToReplace), replacementText); } + + public void AddOrUpdateAttribute( + IRewriteSession rewriteSession, + Declaration declaration, + string attribute, + IReadOnlyList values) + { + var attributeNodes = ApplicableAttributeNodes(declaration, attribute); + + if (!attributeNodes.Any()) + { + AddAttribute(rewriteSession, declaration, attribute, values); + return; + } + + if (attribute.Equals("VB_Ext_Key")) + { + var newKey = values.First(); + var matchingExtKeyAttribute = attributeNodes.FirstOrDefault(node => newKey.Equals(node.Values.FirstOrDefault(), StringComparison.InvariantCultureIgnoreCase)); + + if (matchingExtKeyAttribute == null) + { + AddAttribute(rewriteSession, declaration, attribute, values); + return; + } + + var oldValues = matchingExtKeyAttribute.Values; + UpdateAttribute(rewriteSession, declaration, attribute, values, oldValues); + return; + } + + UpdateAttribute(rewriteSession, declaration, attribute, values); + } } } \ No newline at end of file diff --git a/Rubberduck.Parsing/VBA/IAttributesUpdater.cs b/Rubberduck.Parsing/VBA/IAttributesUpdater.cs index 459dbc3ff1..429d05bddc 100644 --- a/Rubberduck.Parsing/VBA/IAttributesUpdater.cs +++ b/Rubberduck.Parsing/VBA/IAttributesUpdater.cs @@ -9,5 +9,6 @@ public interface IAttributesUpdater void AddAttribute(IRewriteSession rewriteSession, Declaration declaration, string attribute, IReadOnlyList values); void RemoveAttribute(IRewriteSession rewriteSession, Declaration declaration, string attribute, IReadOnlyList values = null); void UpdateAttribute(IRewriteSession rewriteSession, Declaration declaration, string attribute, IReadOnlyList newValues, IReadOnlyList oldValues = null); + void AddOrUpdateAttribute(IRewriteSession rewriteSession, Declaration declaration, string attribute, IReadOnlyList values); } } \ No newline at end of file diff --git a/RubberduckTests/PostProcessing/AttributesUpdaterTests.cs b/RubberduckTests/PostProcessing/AttributesUpdaterTests.cs index 5ac2778b46..49d94f2c78 100644 --- a/RubberduckTests/PostProcessing/AttributesUpdaterTests.cs +++ b/RubberduckTests/PostProcessing/AttributesUpdaterTests.cs @@ -849,6 +849,252 @@ End Sub Assert.AreEqual(expectedCode, actualCode); } + [Test] + [Category("AttributesUpdater")] + public void AddOrUpdateAttribute_UsualAttribute_NotThere_AddsAttribute() + { + const string inputCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + + const string expectedCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +Attribute VB_Exposed = True +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + var attribute = "VB_Exposed"; + var newValues = new List { "True" }; + + string actualCode; + var (component, rewriteSession, state) = TestSetup(inputCode); + using (state) + { + var moduleDeclaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Module) + .Single(); + var attributesUpdater = new AttributesUpdater(state); + + attributesUpdater.AddOrUpdateAttribute(rewriteSession, moduleDeclaration, attribute, newValues); + rewriteSession.TryRewrite(); + + actualCode = component.CodeModule.Content(); + } + Assert.AreEqual(expectedCode, actualCode); + } + + [Test] + [Category("AttributesUpdater")] + public void AddOrUpdateAttribute_ExtKey_NotThere_AddsAttribute() + { + const string inputCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + + const string expectedCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +Attribute VB_Ext_Key = ""MyKey"", ""MyValue"" +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + var attribute = "VB_Ext_Key"; + var newValues = new List { "\"MyKey\"", "\"MyValue\"" }; + + string actualCode; + var (component, rewriteSession, state) = TestSetup(inputCode); + using (state) + { + var moduleDeclaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Module) + .Single(); + var attributesUpdater = new AttributesUpdater(state); + + attributesUpdater.AddOrUpdateAttribute(rewriteSession, moduleDeclaration, attribute, newValues); + rewriteSession.TryRewrite(); + + actualCode = component.CodeModule.Content(); + } + Assert.AreEqual(expectedCode, actualCode); + } + + [Test] + [Category("AttributesUpdater")] + public void AddOrUpdateAttribute_UsualAttribute_AlreadyThere_UpdatesAttribute() + { + const string inputCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +Attribute VB_Exposed = False +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + + const string expectedCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +Attribute VB_Exposed = True +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + var attribute = "VB_Exposed"; + var newValues = new List { "True" }; + + string actualCode; + var (component, rewriteSession, state) = TestSetup(inputCode); + using (state) + { + var moduleDeclaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Module) + .Single(); + var attributesUpdater = new AttributesUpdater(state); + + attributesUpdater.AddOrUpdateAttribute(rewriteSession, moduleDeclaration, attribute, newValues); + rewriteSession.TryRewrite(); + + actualCode = component.CodeModule.Content(); + } + Assert.AreEqual(expectedCode, actualCode); + } + + [Test] + [Category("AttributesUpdater")] + public void AddOrUpdateAttribute_ExtKey_KeyNotThere_AddsAttribute() + { + const string inputCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +Attribute VB_Ext_Key = ""AnotherKey"", ""MyValuse"" +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + + const string expectedCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +Attribute VB_Ext_Key = ""AnotherKey"", ""MyValuse"" +Attribute VB_Ext_Key = ""MyKey"", ""MyValue"" +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + var attribute = "VB_Ext_Key"; + var newValues = new List { "\"MyKey\"", "\"MyValue\"" }; + + string actualCode; + var (component, rewriteSession, state) = TestSetup(inputCode); + using (state) + { + var moduleDeclaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Module) + .Single(); + var attributesUpdater = new AttributesUpdater(state); + + attributesUpdater.AddOrUpdateAttribute(rewriteSession, moduleDeclaration, attribute, newValues); + rewriteSession.TryRewrite(); + + actualCode = component.CodeModule.Content(); + } + Assert.AreEqual(expectedCode, actualCode); + } + + [Test] + [Category("AttributesUpdater")] + public void AddOrUpdateAttribute_ExtKey_KeyAlreadyThere_UpdatesAttribute() + { + const string inputCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +Attribute VB_Ext_Key = ""AnotherKey"", ""MyValue"" +Attribute VB_Ext_Key = ""MyKey"", ""AnotherValue"" +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + + const string expectedCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +Attribute VB_Ext_Key = ""AnotherKey"", ""MyValue"" +Attribute VB_Ext_Key = ""MyKey"", ""MyValue"" +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + var attribute = "VB_Ext_Key"; + var newValues = new List { "\"MyKey\"", "\"MyValue\"" }; + + string actualCode; + var (component, rewriteSession, state) = TestSetup(inputCode); + using (state) + { + var moduleDeclaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Module) + .Single(); + var attributesUpdater = new AttributesUpdater(state); + + attributesUpdater.AddOrUpdateAttribute(rewriteSession, moduleDeclaration, attribute, newValues); + rewriteSession.TryRewrite(); + + actualCode = component.CodeModule.Content(); + } + Assert.AreEqual(expectedCode, actualCode); + } + private (IVBComponent component, IExecutableRewriteSession rewriteSession, RubberduckParserState state) TestSetup(string inputCode) { var vbe = MockVbeBuilder.BuildFromSingleStandardModule(inputCode, out var component).Object; From ebe40b9e1d665da23fbe40e08a2cb5a5cebe9c5e Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Thu, 18 Jun 2020 18:37:40 +0200 Subject: [PATCH 2/7] Allow to annotate declarations in attributes code This only applies to components and declarations with attributes contexts. --- Rubberduck.Parsing/VBA/AnnotationUpdater.cs | 102 ++++++++++++----- RubberduckTests/Commands/MockIndenter.cs | 2 +- ...AnnotateSelectedDeclarationCommandTests.cs | 2 +- .../AnnotateSelectedMemberCommandTests.cs | 2 +- .../AnnotateSelectedModuleCommandTests.cs | 2 +- ...odePaneMoveContainingFolderCommandTests.cs | 2 +- .../CodePaneMoveToFolderCommandTests.cs | 2 +- .../PostProcessing/AnnotationUpdaterTests.cs | 106 +++++++++++++++--- .../AddAttributeAnnotationQuickFixTests.cs | 2 +- .../AdjustAttributeAnnotationQuickFixTests.cs | 2 +- .../QuickFixes/IgnoreOnceQuickFixTests.cs | 8 +- .../RemoveAnnotationQuickFixTests.cs | 2 +- ...RemoveDuplicatedAnnotationQuickFixTests.cs | 2 +- ...notateDeclarationRefactoringActionTests.cs | 2 +- .../AnnotateDeclarationRefactoringTests.cs | 2 +- .../ChangeFolderRefactoringActionTests.cs | 2 +- .../MoveContainingFolderRefactoringTests.cs | 2 +- .../MoveFolderRefactoringActionTests.cs | 2 +- ...eMultipleToFolderRefactoringActionTests.cs | 2 +- ...eMultipleToFolderRefactoringActionTests.cs | 2 +- .../MoveToFolderRefactoringActionTests.cs | 2 +- .../MoveToFolderRefactoringTests.cs | 2 +- .../RenameFolderRefactoringActionTests.cs | 2 +- 23 files changed, 188 insertions(+), 68 deletions(-) diff --git a/Rubberduck.Parsing/VBA/AnnotationUpdater.cs b/Rubberduck.Parsing/VBA/AnnotationUpdater.cs index c665f37b8a..aa236890f4 100644 --- a/Rubberduck.Parsing/VBA/AnnotationUpdater.cs +++ b/Rubberduck.Parsing/VBA/AnnotationUpdater.cs @@ -10,13 +10,21 @@ using Rubberduck.Parsing.Rewriter; using Rubberduck.Parsing.Symbols; using Rubberduck.Parsing.VBA.Parsing; +using Rubberduck.VBEditor; namespace Rubberduck.Parsing.VBA { public class AnnotationUpdater : IAnnotationUpdater { + private readonly IParseTreeProvider _parseTreeProvider; + private readonly Logger _logger = LogManager.GetCurrentClassLogger(); + public AnnotationUpdater(IParseTreeProvider parseTreeProvider) + { + _parseTreeProvider = parseTreeProvider; + } + public void AddAnnotation(IRewriteSession rewriteSession, QualifiedContext context, IAnnotation annotationInfo, IReadOnlyList values = null) { var annotationValues = values ?? new List(); @@ -30,41 +38,55 @@ public void AddAnnotation(IRewriteSession rewriteSession, QualifiedContext conte if (rewriteSession.TargetCodeKind != CodeKind.CodePaneCode) { - _logger.Warn($"Tried to add an annotation with a rewriter not suitable for annotationss. (target code kind = {rewriteSession.TargetCodeKind})"); + _logger.Warn($"Tried to add an annotation with a rewriter not suitable to annotate contexts. (target code kind = {rewriteSession.TargetCodeKind})"); _logger.Trace($"Tried to add annotation {annotationInfo.Name} with values {AnnotationValuesText(annotationValues)} to {context.Context.GetText()} at {context.Context.GetSelection()} in module {context.ModuleName} using a rewriter not suitable for annotations."); return; } + AddAnnotation(rewriteSession, context.ModuleName, context.Context, annotationInfo, annotationValues); + } + + private void AddAnnotation(IRewriteSession rewriteSession, QualifiedModuleName moduleName, ParserRuleContext context, IAnnotation annotationInfo, IReadOnlyList values = null) + { + var annotationValues = values ?? new List(); + + if (context == null) + { + _logger.Warn("Tried to add an annotation to a context that is null."); + _logger.Trace($"Tried to add annotation {annotationInfo.Name} with values {AnnotationValuesText(annotationValues)} to a context that is null."); + return; + } + var annotationText = AnnotationText(annotationInfo.Name, annotationValues); string codeToAdd; IModuleRewriter rewriter; - if (context.Context.start.Line == 1) + if (context.start.Line == 1) { codeToAdd = $"{annotationText}{Environment.NewLine}"; - rewriter = rewriteSession.CheckOutModuleRewriter(context.ModuleName); + rewriter = rewriteSession.CheckOutModuleRewriter(moduleName); rewriter.InsertBefore(0, codeToAdd); return; } - var previousEndOfLine = PreviousEndOfLine(context.Context); + var previousEndOfLine = PreviousEndOfLine(context); if (previousEndOfLine == null) { //We are on the first logical line, but not the first physical line. return; } - if (context.Context.start.Line > previousEndOfLine.stop.Line + 1) + if (context.start.Line > previousEndOfLine.stop.Line + 1) { _logger.Warn("Tried to add an annotation to a context not on the first physical line of a logical line."); - _logger.Trace($"Tried to add annotation {annotationInfo.Name} with values {AnnotationValuesText(annotationValues)} to a the context with text '{context.Context.GetText()}' at {context.Context.GetSelection()} in module {context.ModuleName}."); + _logger.Trace($"Tried to add annotation {annotationInfo.Name} with values {AnnotationValuesText(annotationValues)} to a the context with text '{context.GetText()}' at {context.GetSelection()} in module {moduleName}."); return; } - - codeToAdd = previousEndOfLine.TryGetFollowingContext(out VBAParser.WhiteSpaceContext whitespaceAtStartOfLine) - ? $"{whitespaceAtStartOfLine.GetText()}{annotationText}{Environment.NewLine}" + + codeToAdd = previousEndOfLine.TryGetFollowingContext(out VBAParser.WhiteSpaceContext whitespaceAtStartOfLine) + ? $"{whitespaceAtStartOfLine.GetText()}{annotationText}{Environment.NewLine}" : $"{annotationText}{Environment.NewLine}"; - rewriter = rewriteSession.CheckOutModuleRewriter(context.ModuleName); + rewriter = rewriteSession.CheckOutModuleRewriter(moduleName); rewriter.InsertAfter(previousEndOfLine.stop.TokenIndex, codeToAdd); } @@ -133,17 +155,47 @@ private void AddModuleAnnotation(IRewriteSession rewriteSession, Declaration dec return; } - if (rewriteSession.TargetCodeKind != CodeKind.CodePaneCode) + if (rewriteSession.TargetCodeKind != CodeKind.CodePaneCode && rewriteSession.TargetCodeKind != CodeKind.AttributesCode) { - _logger.Warn($"Tried to add an annotation to a module with a rewriter not suitable for annotationss. (target code kind = {rewriteSession.TargetCodeKind})"); + _logger.Warn($"Tried to add an annotation to a module with a rewriter not suitable for annotations. (target code kind = {rewriteSession.TargetCodeKind})"); _logger.Trace($"Tried to add annotation {annotationInfo.Name} with values {AnnotationValuesText(annotationValues)} to the module {declaration.QualifiedModuleName} using a rewriter not suitable for annotations."); return; } - var codeToAdd = $"{AnnotationText(annotationInfo, annotationValues)}{Environment.NewLine}"; + var codeToAdd = AnnotationText(annotationInfo, annotationValues); var rewriter = rewriteSession.CheckOutModuleRewriter(declaration.QualifiedModuleName); - rewriter.InsertBefore(0, codeToAdd); + + if (rewriteSession.TargetCodeKind == CodeKind.AttributesCode) + { + InsertAfterLastModuleAttribute(rewriter, declaration.QualifiedModuleName, codeToAdd); + } + else + { + var codeToInsert = codeToAdd + Environment.NewLine; + rewriter.InsertBefore(0, codeToInsert); + } + } + + private void InsertAfterLastModuleAttribute(IModuleRewriter rewriter, QualifiedModuleName module, string codeToAdd) + { + var moduleParseTree = (ParserRuleContext)_parseTreeProvider.GetParseTree(module, CodeKind.AttributesCode); + var lastModuleAttribute = moduleParseTree.GetDescendents() + .Where(moduleAttributes => moduleAttributes.attributeStmt() != null) + .SelectMany(moduleAttributes => moduleAttributes.attributeStmt()) + .OrderBy(moduleAttribute => moduleAttribute.stop.TokenIndex) + .LastOrDefault(); + if (lastModuleAttribute == null) + { + //This should never happen for a real module. + var codeToInsert = codeToAdd + Environment.NewLine; + rewriter.InsertBefore(0, codeToInsert); + } + else + { + var codeToInsert = Environment.NewLine + codeToAdd; + rewriter.InsertAfter(lastModuleAttribute.stop.TokenIndex, codeToInsert); + } } private void AddVariableAnnotation(IRewriteSession rewriteSession, Declaration declaration, IAnnotation annotationInfo, IReadOnlyList annotationValues) @@ -155,14 +207,14 @@ private void AddVariableAnnotation(IRewriteSession rewriteSession, Declaration d return; } - if (rewriteSession.TargetCodeKind != CodeKind.CodePaneCode) + if (rewriteSession.TargetCodeKind != CodeKind.CodePaneCode && (rewriteSession.TargetCodeKind != CodeKind.AttributesCode || declaration.AttributesPassContext == null)) { - _logger.Warn($"Tried to add an annotation to a variable with a rewriter not suitable for annotationss. (target code kind = {rewriteSession.TargetCodeKind})"); + _logger.Warn($"Tried to add an annotation to a variable with a rewriter not suitable for annotations to the variable. (target code kind = {rewriteSession.TargetCodeKind})"); _logger.Trace($"Tried to add annotation {annotationInfo.Name} with values {AnnotationValuesText(annotationValues)} to the the variable {declaration.IdentifierName} at {declaration.Selection} in module {declaration.QualifiedModuleName} using a rewriter not suitable for annotations."); return; } - AddAnnotation(rewriteSession, new QualifiedContext(declaration.QualifiedName, declaration.Context), annotationInfo, annotationValues); + AddAnnotation(rewriteSession, declaration.QualifiedModuleName, declaration.Context, annotationInfo, annotationValues); } private void AddMemberAnnotation(IRewriteSession rewriteSession, Declaration declaration, IAnnotation annotationInfo, IReadOnlyList annotationValues) @@ -174,19 +226,17 @@ private void AddMemberAnnotation(IRewriteSession rewriteSession, Declaration dec return; } - if (rewriteSession.TargetCodeKind != CodeKind.CodePaneCode) + if (rewriteSession.TargetCodeKind != CodeKind.CodePaneCode && (rewriteSession.TargetCodeKind != CodeKind.AttributesCode || declaration.AttributesPassContext == null)) { - _logger.Warn($"Tried to add an annotation to a member with a rewriter not suitable for annotationss. (target code kind = {rewriteSession.TargetCodeKind})"); + _logger.Warn($"Tried to add an annotation to a member with a rewriter not suitable for annotations to the member. (target code kind = {rewriteSession.TargetCodeKind})"); _logger.Trace($"Tried to add annotation {annotationInfo.Name} with values {AnnotationValuesText(annotationValues)} to the the member {declaration.IdentifierName} at {declaration.Selection} in module {declaration.QualifiedModuleName} using a rewriter not suitable for annotations."); return; } - AddAnnotation(rewriteSession, new QualifiedContext(declaration.QualifiedName, declaration.Context), annotationInfo, annotationValues); + AddAnnotation(rewriteSession, declaration.QualifiedModuleName, declaration.Context, annotationInfo, annotationValues); } - - public void AddAnnotation(IRewriteSession rewriteSession, IdentifierReference reference, IAnnotation annotationInfo, - IReadOnlyList values = null) + public void AddAnnotation(IRewriteSession rewriteSession, IdentifierReference reference, IAnnotation annotationInfo, IReadOnlyList values = null) { var annotationValues = values ?? new List(); @@ -206,7 +256,7 @@ private void AddMemberAnnotation(IRewriteSession rewriteSession, Declaration dec if (rewriteSession.TargetCodeKind != CodeKind.CodePaneCode) { - _logger.Warn($"Tried to add an annotation to an identifier reference with a rewriter not suitable for annotationss. (target code kind = {rewriteSession.TargetCodeKind})"); + _logger.Warn($"Tried to add an annotation to an identifier reference with a rewriter not suitable for annotations to references. (target code kind = {rewriteSession.TargetCodeKind})"); _logger.Trace($"Tried to add annotation {annotationInfo.Name} with values {AnnotationValuesText(annotationValues)} to the the identifier reference {reference.IdentifierName} at {reference.Selection} in module {reference.QualifiedModuleName} using a rewriter not suitable for annotations."); return; } @@ -294,7 +344,7 @@ public void RemoveAnnotations(IRewriteSession rewriteSession, IEnumerable vbe, diff --git a/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedDeclarationCommandTests.cs b/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedDeclarationCommandTests.cs index 603496a3c1..1e06eb9dd6 100644 --- a/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedDeclarationCommandTests.cs +++ b/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedDeclarationCommandTests.cs @@ -44,7 +44,7 @@ public void AnnotateDeclaration_CanExecute_InvalidTargetType() .Callback((Action action) => action.Invoke()); var userInteraction = new RefactoringUserInteraction(factory, uiDispatcherMock.Object); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); var annotateDeclarationAction = new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater); var selectedDeclarationProvider = new SelectedDeclarationProvider(selectionService, state); diff --git a/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedMemberCommandTests.cs b/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedMemberCommandTests.cs index 502f04bc8f..7f05bb86ec 100644 --- a/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedMemberCommandTests.cs +++ b/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedMemberCommandTests.cs @@ -44,7 +44,7 @@ public void AnnotateDeclaration_CanExecute_OutsideMember() .Callback((Action action) => action.Invoke()); var userInteraction = new RefactoringUserInteraction(factory, uiDispatcherMock.Object); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); var annotateDeclarationAction = new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater); var selectedDeclarationProvider = new SelectedDeclarationProvider(selectionService, state); diff --git a/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedModuleCommandTests.cs b/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedModuleCommandTests.cs index d49a011e84..b48646467f 100644 --- a/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedModuleCommandTests.cs +++ b/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedModuleCommandTests.cs @@ -44,7 +44,7 @@ public void AnnotateDeclaration_CanExecute_InsideMember() .Callback((Action action) => action.Invoke()); var userInteraction = new RefactoringUserInteraction(factory, uiDispatcherMock.Object); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); var annotateDeclarationAction = new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater); var selectedDeclarationProvider = new SelectedDeclarationProvider(selectionService, state); diff --git a/RubberduckTests/Commands/RefactorCommands/CodePaneMoveContainingFolderCommandTests.cs b/RubberduckTests/Commands/RefactorCommands/CodePaneMoveContainingFolderCommandTests.cs index 4582f474ce..b1e3101107 100644 --- a/RubberduckTests/Commands/RefactorCommands/CodePaneMoveContainingFolderCommandTests.cs +++ b/RubberduckTests/Commands/RefactorCommands/CodePaneMoveContainingFolderCommandTests.cs @@ -39,7 +39,7 @@ public class CodePaneRefactorMoveContainingFolderCommandTests : RefactorCodePane .Callback((Action action) => action.Invoke()); var userInteraction = new RefactoringUserInteraction(factory, uiDispatcherMock.Object); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); var moveToFolderAction = new MoveToFolderRefactoringAction(rewritingManager, annotationUpdater); var changeFolderAction = new ChangeFolderRefactoringAction(rewritingManager, moveToFolderAction); var moveFolderAction = new MoveFolderRefactoringAction(rewritingManager, changeFolderAction); diff --git a/RubberduckTests/Commands/RefactorCommands/CodePaneMoveToFolderCommandTests.cs b/RubberduckTests/Commands/RefactorCommands/CodePaneMoveToFolderCommandTests.cs index f9bf2b3289..8853105e1e 100644 --- a/RubberduckTests/Commands/RefactorCommands/CodePaneMoveToFolderCommandTests.cs +++ b/RubberduckTests/Commands/RefactorCommands/CodePaneMoveToFolderCommandTests.cs @@ -37,7 +37,7 @@ public class CodePaneRefactorMoveToFolderCommandTests : RefactorCodePaneCommandT .Callback((Action action) => action.Invoke()); var userInteraction = new RefactoringUserInteraction(factory, uiDispatcherMock.Object); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); var moveToFolderAction = new MoveToFolderRefactoringAction(rewritingManager, annotationUpdater); var moveMultipleToFolderAction = new MoveMultipleToFolderRefactoringAction(rewritingManager, moveToFolderAction); diff --git a/RubberduckTests/PostProcessing/AnnotationUpdaterTests.cs b/RubberduckTests/PostProcessing/AnnotationUpdaterTests.cs index 972055996d..06b8b3c5a1 100644 --- a/RubberduckTests/PostProcessing/AnnotationUpdaterTests.cs +++ b/RubberduckTests/PostProcessing/AnnotationUpdaterTests.cs @@ -5,6 +5,7 @@ using Rubberduck.Parsing.Rewriter; using Rubberduck.Parsing.Symbols; using Rubberduck.Parsing.VBA; +using Rubberduck.Parsing.VBA.Parsing; using Rubberduck.VBEditor.SafeComWrappers; using Rubberduck.VBEditor.SafeComWrappers.Abstract; using RubberduckTests.Mocks; @@ -52,7 +53,7 @@ End Sub var fooDeclaration = state.DeclarationFinder .UserDeclarations(DeclarationType.Procedure) .First(decl => decl.IdentifierName == "Foo"); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.AddAnnotation(rewriteSession, fooDeclaration, annotationToAdd, annotationValues); rewriteSession.TryRewrite(); @@ -64,7 +65,7 @@ End Sub [Test] [Category("AnnotationUpdater")] - public void AddAnnotationAddsModuleAnnotationAboveTheFirstLine() + public void AddAnnotationAddsModuleAnnotationAboveTheFirstLineForCodePaneRewriteSession() { const string inputCode = @"'@PredeclaredId @@ -106,7 +107,73 @@ End Sub var moduleDeclaration = state.DeclarationFinder .UserDeclarations(DeclarationType.ProceduralModule) .First(); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); + + annotationUpdater.AddAnnotation(rewriteSession, moduleDeclaration, annotationToAdd, annotationValues); + rewriteSession.TryRewrite(); + + actualCode = component.CodeModule.Content(); + } + Assert.AreEqual(expectedCode, actualCode); + } + + [Test] + [Category("AnnotationUpdater")] + public void AddAnnotationAddsModuleAnnotationBelowTheLastAttributeForAttributeRewriteSession() + { + const string inputCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +'@PredeclaredId +Option Explicit +'@Folder ""folder"" + +Private Sub FooBar() +End Sub + + +'@Obsolete + Public Sub Foo(bar As String) + bar = vbNullString + End Sub +"; + + const string expectedCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +'@ModuleAttribute VB_Ext_Key, ""Key"", ""Value"" +'@PredeclaredId +Option Explicit +'@Folder ""folder"" + +Private Sub FooBar() +End Sub + + +'@Obsolete + Public Sub Foo(bar As String) + bar = vbNullString + End Sub +"; + var annotationToAdd = new ModuleAttributeAnnotation(); + var annotationValues = new List { "VB_Ext_Key", "\"Key\"", "\"Value\"" }; + + string actualCode; + var (component, rewriteSession, state) = TestSetup(inputCode, ComponentType.ClassModule, CodeKind.AttributesCode); + using (state) + { + var moduleDeclaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.ClassModule) + .First(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.AddAnnotation(rewriteSession, moduleDeclaration, annotationToAdd, annotationValues); rewriteSession.TryRewrite(); @@ -153,7 +220,7 @@ End Sub var fooDeclaration = state.DeclarationFinder .UserDeclarations(DeclarationType.Procedure) .First(decl => decl.IdentifierName == "Foo"); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.AddAnnotation(rewriteSession, fooDeclaration, annotationToAdd, annotationValues); rewriteSession.TryRewrite(); @@ -206,7 +273,7 @@ End Sub var moduleDeclaration = state.DeclarationFinder .UserDeclarations(DeclarationType.ProceduralModule) .First(); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.AddAnnotation(rewriteSession, moduleDeclaration, annotationToAdd, annotationValues); rewriteSession.TryRewrite(); @@ -265,7 +332,7 @@ End Sub .UserDeclarations(DeclarationType.Procedure) .First(decl => decl.IdentifierName == "Foo") .References.First(); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.AddAnnotation(rewriteSession, fooReference, annotationToAdd, annotationValues); rewriteSession.TryRewrite(); @@ -310,7 +377,7 @@ End Sub var fooBarDeclaration = state.DeclarationFinder .UserDeclarations(DeclarationType.Procedure) .First(decl => decl.IdentifierName == "FooBar"); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.AddAnnotation(rewriteSession, fooBarDeclaration, annotationToAdd); rewriteSession.TryRewrite(); @@ -356,7 +423,7 @@ End Sub var bazDeclaration = state.DeclarationFinder .UserDeclarations(DeclarationType.Variable) .First(decl => decl.IdentifierName == "baz"); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.AddAnnotation(rewriteSession, bazDeclaration, annotationToAdd); rewriteSession.TryRewrite(); @@ -407,7 +474,7 @@ End Sub .UserDeclarations(DeclarationType.Procedure) .First(decl => decl.IdentifierName == "Foo"); var annotationToRemove = fooDeclaration.Annotations.First(); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.RemoveAnnotation(rewriteSession, annotationToRemove); rewriteSession.TryRewrite(); @@ -458,7 +525,7 @@ End Sub .UserDeclarations(DeclarationType.Procedure) .First(decl => decl.IdentifierName == "Foo"); var annotationToRemove = fooDeclaration.Annotations.First(); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.RemoveAnnotation(rewriteSession, annotationToRemove); rewriteSession.TryRewrite(); @@ -509,7 +576,7 @@ End Sub .UserDeclarations(DeclarationType.Procedure) .First(decl => decl.IdentifierName == "Foo"); var annotationToRemove = fooDeclaration.Annotations.Last(); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.RemoveAnnotation(rewriteSession, annotationToRemove); rewriteSession.TryRewrite(); @@ -559,7 +626,7 @@ End Sub .UserDeclarations(DeclarationType.Procedure) .First(decl => decl.IdentifierName == "Foo"); var annotationToRemove = fooDeclaration.Annotations.First(); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.RemoveAnnotation(rewriteSession, annotationToRemove); rewriteSession.TryRewrite(); @@ -607,7 +674,7 @@ End Sub .UserDeclarations(DeclarationType.ProceduralModule) .First(); var annotationToRemove = moduleDeclaration.Annotations.First(); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.RemoveAnnotation(rewriteSession, annotationToRemove); rewriteSession.TryRewrite(); @@ -639,7 +706,7 @@ Option Explicit .UserDeclarations(DeclarationType.ProceduralModule) .First(); var annotationToRemove = moduleDeclaration.Annotations.First(); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.RemoveAnnotation(rewriteSession, annotationToRemove); rewriteSession.TryRewrite(); @@ -675,7 +742,7 @@ Option Explicit .UserDeclarations(DeclarationType.ProceduralModule) .First(); var annotationsToRemove = moduleDeclaration.Annotations.Where(pta => !(pta.Annotation is ExposedModuleAnnotation)); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.RemoveAnnotations(rewriteSession, annotationsToRemove); rewriteSession.TryRewrite(); @@ -729,7 +796,7 @@ End Sub .UserDeclarations(DeclarationType.Procedure) .First(decl => decl.IdentifierName == "Foo"); var annotationToUpdate = fooDeclaration.Annotations.First(pta => pta.Annotation is DescriptionAnnotation); - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); annotationUpdater.UpdateAnnotation(rewriteSession, annotationToUpdate, newAnnotation, newAnnotationValues); rewriteSession.TryRewrite(); @@ -739,11 +806,14 @@ End Sub Assert.AreEqual(expectedCode, actualCode); } - private (IVBComponent component, IExecutableRewriteSession rewriteSession, RubberduckParserState state) TestSetup(string inputCode, ComponentType componentType = ComponentType.StandardModule) + private (IVBComponent component, IExecutableRewriteSession rewriteSession, RubberduckParserState state) TestSetup(string inputCode, ComponentType componentType = ComponentType.StandardModule, CodeKind codeKind = CodeKind.CodePaneCode) { var vbe = MockVbeBuilder.BuildFromSingleModule(inputCode, componentType, out var component).Object; var (state, rewritingManager) = MockParser.CreateAndParseWithRewritingManager(vbe); - return (component, rewritingManager.CheckOutCodePaneSession(), state); + var rewriteSession = codeKind == CodeKind.AttributesCode + ? rewritingManager.CheckOutAttributesSession() + : rewritingManager.CheckOutCodePaneSession(); + return (component, rewriteSession, state); } } } \ No newline at end of file diff --git a/RubberduckTests/QuickFixes/AddAttributeAnnotationQuickFixTests.cs b/RubberduckTests/QuickFixes/AddAttributeAnnotationQuickFixTests.cs index 208e32eae9..e03f6f3f68 100644 --- a/RubberduckTests/QuickFixes/AddAttributeAnnotationQuickFixTests.cs +++ b/RubberduckTests/QuickFixes/AddAttributeAnnotationQuickFixTests.cs @@ -156,7 +156,7 @@ public void KnownMemberAttributeWithoutAnnotationWhileOtherAttributeWithAnnotati protected override IQuickFix QuickFix(RubberduckParserState state) { - return new AddAttributeAnnotationQuickFix(new AnnotationUpdater(), + return new AddAttributeAnnotationQuickFix(new AnnotationUpdater(state), new AttributeAnnotationProvider(MockParser.WellKnownAnnotations().OfType())); } } diff --git a/RubberduckTests/QuickFixes/AdjustAttributeAnnotationQuickFixTests.cs b/RubberduckTests/QuickFixes/AdjustAttributeAnnotationQuickFixTests.cs index 1214818406..cf96d29e07 100644 --- a/RubberduckTests/QuickFixes/AdjustAttributeAnnotationQuickFixTests.cs +++ b/RubberduckTests/QuickFixes/AdjustAttributeAnnotationQuickFixTests.cs @@ -109,7 +109,7 @@ protected override IVBE TestVbe(string code, out IVBComponent component) protected override IQuickFix QuickFix(RubberduckParserState state) { - return new AdjustAttributeAnnotationQuickFix(new AnnotationUpdater(), + return new AdjustAttributeAnnotationQuickFix(new AnnotationUpdater(state), new AttributeAnnotationProvider(MockParser.WellKnownAnnotations().OfType())); } } diff --git a/RubberduckTests/QuickFixes/IgnoreOnceQuickFixTests.cs b/RubberduckTests/QuickFixes/IgnoreOnceQuickFixTests.cs index d6b9486c5e..f1bde16a63 100644 --- a/RubberduckTests/QuickFixes/IgnoreOnceQuickFixTests.cs +++ b/RubberduckTests/QuickFixes/IgnoreOnceQuickFixTests.cs @@ -760,7 +760,7 @@ public void UntypedFunctionUsage_IgnoreQuickFixWorks() var inspectionResults = inspection.GetInspectionResults(CancellationToken.None); var rewriteSession = rewritingManager.CheckOutCodePaneSession(); - new IgnoreOnceQuickFix(new AnnotationUpdater(), state, new[] { inspection }).Fix(inspectionResults.First(), rewriteSession); + new IgnoreOnceQuickFix(new AnnotationUpdater(state), state, new[] { inspection }).Fix(inspectionResults.First(), rewriteSession); var actualCode = rewriteSession.CheckOutModuleRewriter(component.QualifiedModuleName).GetText(); Assert.AreEqual(expectedCode, actualCode); @@ -794,7 +794,7 @@ Sub Ffffff() var inspectionResults = inspection.GetInspectionResults(CancellationToken.None); var rewriteSession = rewritingManager.CheckOutCodePaneSession(); - new IgnoreOnceQuickFix(new AnnotationUpdater(), state, new[] { inspection }).Fix(inspectionResults.First(), rewriteSession); + new IgnoreOnceQuickFix(new AnnotationUpdater(state), state, new[] { inspection }).Fix(inspectionResults.First(), rewriteSession); var actualCode = rewriteSession.CheckOutModuleRewriter(component.QualifiedModuleName).GetText(); Assert.AreEqual(expectedCode, actualCode); @@ -1111,7 +1111,7 @@ public void ImplicitlyTypedConst_IgnoreOnceQuickFixWorks() var resultToFix = inspectionResults.First(); var rewriteSession = rewritingManager.CheckOutCodePaneSession(); - var quickFix = new IgnoreOnceQuickFix(new AnnotationUpdater(), state, new[] {inspection}); + var quickFix = new IgnoreOnceQuickFix(new AnnotationUpdater(state), state, new[] {inspection}); quickFix.Fix(resultToFix, rewriteSession); return rewriteSession.CheckOutModuleRewriter(moduleName).GetText(); @@ -1187,7 +1187,7 @@ private IEnumerable InspectionResults(IInspection inspection, var inspectionResults = InspectionResults(inspection, state); var rewriteSession = rewritingManager.CheckOutCodePaneSession(); - var quickFix = new IgnoreOnceQuickFix(new AnnotationUpdater(), state, new[] { inspection }); + var quickFix = new IgnoreOnceQuickFix(new AnnotationUpdater(state), state, new[] { inspection }); foreach (var resultToFix in inspectionResults) { diff --git a/RubberduckTests/QuickFixes/RemoveAnnotationQuickFixTests.cs b/RubberduckTests/QuickFixes/RemoveAnnotationQuickFixTests.cs index 7cf1a8e657..6328507826 100644 --- a/RubberduckTests/QuickFixes/RemoveAnnotationQuickFixTests.cs +++ b/RubberduckTests/QuickFixes/RemoveAnnotationQuickFixTests.cs @@ -49,7 +49,7 @@ public void MemberAttributeAnnotationWithoutAttribute_QuickFixWorks() protected override IQuickFix QuickFix(RubberduckParserState state) { - return new RemoveAnnotationQuickFix(new AnnotationUpdater()); + return new RemoveAnnotationQuickFix(new AnnotationUpdater(state)); } } } \ No newline at end of file diff --git a/RubberduckTests/QuickFixes/RemoveDuplicatedAnnotationQuickFixTests.cs b/RubberduckTests/QuickFixes/RemoveDuplicatedAnnotationQuickFixTests.cs index 477eaa0084..a13a0dea00 100644 --- a/RubberduckTests/QuickFixes/RemoveDuplicatedAnnotationQuickFixTests.cs +++ b/RubberduckTests/QuickFixes/RemoveDuplicatedAnnotationQuickFixTests.cs @@ -192,7 +192,7 @@ public void RemoveDuplicatedAnnotation_QuickFixWorks_RemoveDuplicatesOfOnlyOneAn protected override IQuickFix QuickFix(RubberduckParserState state) { - return new RemoveDuplicatedAnnotationQuickFix(new AnnotationUpdater()); + return new RemoveDuplicatedAnnotationQuickFix(new AnnotationUpdater(state)); } } } diff --git a/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringActionTests.cs b/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringActionTests.cs index e7924124be..ce48e30fe3 100644 --- a/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringActionTests.cs +++ b/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringActionTests.cs @@ -276,7 +276,7 @@ End Sub protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) { - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); return new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater); } } diff --git a/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringTests.cs b/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringTests.cs index bafd90e44c..59517ee2d6 100644 --- a/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringTests.cs +++ b/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringTests.cs @@ -84,7 +84,7 @@ public void AnnotateDeclarationRefactoring_InvalidTargetType_Throws() RefactoringUserInteraction userInteraction, ISelectionService selectionService) { - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); var annotateDeclarationAction = new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater); var selectedDeclarationProvider = new SelectedDeclarationProvider(selectionService, state); diff --git a/RubberduckTests/Refactoring/ChangeFolder/ChangeFolderRefactoringActionTests.cs b/RubberduckTests/Refactoring/ChangeFolder/ChangeFolderRefactoringActionTests.cs index 96cae51664..f2e974cbc4 100644 --- a/RubberduckTests/Refactoring/ChangeFolder/ChangeFolderRefactoringActionTests.cs +++ b/RubberduckTests/Refactoring/ChangeFolder/ChangeFolderRefactoringActionTests.cs @@ -192,7 +192,7 @@ End Sub protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) { - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); var moveToFolderAction = new MoveToFolderRefactoringAction(rewritingManager, annotationUpdater); return new ChangeFolderRefactoringAction(rewritingManager, moveToFolderAction); } diff --git a/RubberduckTests/Refactoring/MoveFolders/MoveContainingFolderRefactoringTests.cs b/RubberduckTests/Refactoring/MoveFolders/MoveContainingFolderRefactoringTests.cs index 2f385ebe7c..f318622771 100644 --- a/RubberduckTests/Refactoring/MoveFolders/MoveContainingFolderRefactoringTests.cs +++ b/RubberduckTests/Refactoring/MoveFolders/MoveContainingFolderRefactoringTests.cs @@ -368,7 +368,7 @@ End Sub RefactoringUserInteraction userInteraction, ISelectionService selectionService) { - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); var moveToFolderAction = new MoveToFolderRefactoringAction(rewritingManager, annotationUpdater); var changeFolderAction = new ChangeFolderRefactoringAction(rewritingManager, moveToFolderAction); var moveFolderAction = new MoveFolderRefactoringAction(rewritingManager, changeFolderAction); diff --git a/RubberduckTests/Refactoring/MoveFolders/MoveFolderRefactoringActionTests.cs b/RubberduckTests/Refactoring/MoveFolders/MoveFolderRefactoringActionTests.cs index 7a5c3ccd17..1e798614c6 100644 --- a/RubberduckTests/Refactoring/MoveFolders/MoveFolderRefactoringActionTests.cs +++ b/RubberduckTests/Refactoring/MoveFolders/MoveFolderRefactoringActionTests.cs @@ -197,7 +197,7 @@ End Sub protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) { - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); var moveToFolderAction = new MoveToFolderRefactoringAction(rewritingManager, annotationUpdater); var changeFolderAction = new ChangeFolderRefactoringAction(rewritingManager, moveToFolderAction); return new MoveFolderRefactoringAction(rewritingManager, changeFolderAction); diff --git a/RubberduckTests/Refactoring/MoveFolders/MoveMultipleToFolderRefactoringActionTests.cs b/RubberduckTests/Refactoring/MoveFolders/MoveMultipleToFolderRefactoringActionTests.cs index 4885642981..8b3724fe01 100644 --- a/RubberduckTests/Refactoring/MoveFolders/MoveMultipleToFolderRefactoringActionTests.cs +++ b/RubberduckTests/Refactoring/MoveFolders/MoveMultipleToFolderRefactoringActionTests.cs @@ -105,7 +105,7 @@ End Sub protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) { - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); var moveToFolderAction = new MoveToFolderRefactoringAction(rewritingManager, annotationUpdater); var changeFolderAction = new ChangeFolderRefactoringAction(rewritingManager, moveToFolderAction); var moveFolderAction = new MoveFolderRefactoringAction(rewritingManager, changeFolderAction); diff --git a/RubberduckTests/Refactoring/MoveToFolder/MoveMultipleToFolderRefactoringActionTests.cs b/RubberduckTests/Refactoring/MoveToFolder/MoveMultipleToFolderRefactoringActionTests.cs index 52441db72b..8a0cae8b38 100644 --- a/RubberduckTests/Refactoring/MoveToFolder/MoveMultipleToFolderRefactoringActionTests.cs +++ b/RubberduckTests/Refactoring/MoveToFolder/MoveMultipleToFolderRefactoringActionTests.cs @@ -74,7 +74,7 @@ End Sub protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) { - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); var moveToFolderAction = new MoveToFolderRefactoringAction(rewritingManager, annotationUpdater); return new MoveMultipleToFolderRefactoringAction(rewritingManager, moveToFolderAction); } diff --git a/RubberduckTests/Refactoring/MoveToFolder/MoveToFolderRefactoringActionTests.cs b/RubberduckTests/Refactoring/MoveToFolder/MoveToFolderRefactoringActionTests.cs index 755018de09..34101c237d 100644 --- a/RubberduckTests/Refactoring/MoveToFolder/MoveToFolderRefactoringActionTests.cs +++ b/RubberduckTests/Refactoring/MoveToFolder/MoveToFolderRefactoringActionTests.cs @@ -151,7 +151,7 @@ End Sub protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) { - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); return new MoveToFolderRefactoringAction(rewritingManager, annotationUpdater); } } diff --git a/RubberduckTests/Refactoring/MoveToFolder/MoveToFolderRefactoringTests.cs b/RubberduckTests/Refactoring/MoveToFolder/MoveToFolderRefactoringTests.cs index 8f58710de6..fb3150b7f0 100644 --- a/RubberduckTests/Refactoring/MoveToFolder/MoveToFolderRefactoringTests.cs +++ b/RubberduckTests/Refactoring/MoveToFolder/MoveToFolderRefactoringTests.cs @@ -201,7 +201,7 @@ End Sub RefactoringUserInteraction userInteraction, ISelectionService selectionService) { - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); var moveToFolderAction = new MoveToFolderRefactoringAction(rewritingManager, annotationUpdater); var moveMultipleToFolderAction = new MoveMultipleToFolderRefactoringAction(rewritingManager, moveToFolderAction); diff --git a/RubberduckTests/Refactoring/RenameFolder/RenameFolderRefactoringActionTests.cs b/RubberduckTests/Refactoring/RenameFolder/RenameFolderRefactoringActionTests.cs index 9706a13453..48a56594d8 100644 --- a/RubberduckTests/Refactoring/RenameFolder/RenameFolderRefactoringActionTests.cs +++ b/RubberduckTests/Refactoring/RenameFolder/RenameFolderRefactoringActionTests.cs @@ -193,7 +193,7 @@ End Sub protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) { - var annotationUpdater = new AnnotationUpdater(); + var annotationUpdater = new AnnotationUpdater(state); var moveToFolderAction = new MoveToFolderRefactoringAction(rewritingManager, annotationUpdater); var changeFolderAction = new ChangeFolderRefactoringAction(rewritingManager, moveToFolderAction); return new RenameFolderRefactoringAction(rewritingManager, changeFolderAction); From 5e8a911014284f0b817d19203907cc5c4ae8fda7 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Wed, 24 Jun 2020 03:05:03 +0200 Subject: [PATCH 3/7] Enhance AnnotateDeclarationRefactoringAction to allow adjusting corresponding attributes The adjustment/addition of an attribute only happens if the corresponding flag is set on the model and the annotation is an IAttributeAnnotation. --- .../Abstract/CodeOnlyRefactoringActionBase.cs | 4 +- .../AnnotateDeclarationModel.cs | 5 +- .../AnnotateDeclarationRefactoringAction.cs | 96 +++++ .../AnnotateFolderRefactoringAction.cs | 55 --- ...buteRewriteSessionNotSupportedException.cs | 5 + ...ttributeRewriteSessionRequiredException.cs | 5 + ...AnnotateSelectedDeclarationCommandTests.cs | 6 +- .../AnnotateSelectedMemberCommandTests.cs | 3 +- .../AnnotateSelectedModuleCommandTests.cs | 3 +- .../PostProcessing/AttributesUpdaterTests.cs | 226 +++++++++++- ...notateDeclarationRefactoringActionTests.cs | 345 +++++++++++++++++- .../AnnotateDeclarationRefactoringTests.cs | 3 +- 12 files changed, 682 insertions(+), 74 deletions(-) create mode 100644 Rubberduck.Refactorings/AnnotateDeclaration/AnnotateDeclarationRefactoringAction.cs delete mode 100644 Rubberduck.Refactorings/AnnotateDeclaration/AnnotateFolderRefactoringAction.cs create mode 100644 Rubberduck.Refactorings/Exceptions/AttributeRewriteSessionNotSupportedException.cs create mode 100644 Rubberduck.Refactorings/Exceptions/AttributeRewriteSessionRequiredException.cs diff --git a/Rubberduck.Refactorings/Abstract/CodeOnlyRefactoringActionBase.cs b/Rubberduck.Refactorings/Abstract/CodeOnlyRefactoringActionBase.cs index e1db929c6c..32afb5042a 100644 --- a/Rubberduck.Refactorings/Abstract/CodeOnlyRefactoringActionBase.cs +++ b/Rubberduck.Refactorings/Abstract/CodeOnlyRefactoringActionBase.cs @@ -18,7 +18,7 @@ protected CodeOnlyRefactoringActionBase(IRewritingManager rewritingManager) public virtual void Refactor(TModel model) { - var rewriteSession = RewriteSession(RewriteSessionCodeKind); + var rewriteSession = RewriteSession(RewriteSessionCodeKind(model)); Refactor(model, rewriteSession); @@ -35,6 +35,6 @@ private IExecutableRewriteSession RewriteSession(CodeKind codeKind) : _rewritingManager.CheckOutCodePaneSession(); } - protected virtual CodeKind RewriteSessionCodeKind => CodeKind.CodePaneCode; + protected virtual CodeKind RewriteSessionCodeKind(TModel model) => CodeKind.CodePaneCode; } } \ No newline at end of file diff --git a/Rubberduck.Refactorings/AnnotateDeclaration/AnnotateDeclarationModel.cs b/Rubberduck.Refactorings/AnnotateDeclaration/AnnotateDeclarationModel.cs index c4d6fd9b34..d46a0981ab 100644 --- a/Rubberduck.Refactorings/AnnotateDeclaration/AnnotateDeclarationModel.cs +++ b/Rubberduck.Refactorings/AnnotateDeclaration/AnnotateDeclarationModel.cs @@ -22,15 +22,18 @@ public class AnnotateDeclarationModel : IRefactoringModel public Declaration Target { get; } public IAnnotation Annotation { get; set; } public IList Arguments { get; set; } + public bool AdjustAttribute { get; set; } public AnnotateDeclarationModel( Declaration target, IAnnotation annotation = null, - IList arguments = null) + IList arguments = null, + bool adjustAttribute = false) { Target = target; Annotation = annotation; Arguments = arguments ?? new List(); + AdjustAttribute = adjustAttribute; } } } \ No newline at end of file diff --git a/Rubberduck.Refactorings/AnnotateDeclaration/AnnotateDeclarationRefactoringAction.cs b/Rubberduck.Refactorings/AnnotateDeclaration/AnnotateDeclarationRefactoringAction.cs new file mode 100644 index 0000000000..92168b61c9 --- /dev/null +++ b/Rubberduck.Refactorings/AnnotateDeclaration/AnnotateDeclarationRefactoringAction.cs @@ -0,0 +1,96 @@ +using System.Linq; +using Rubberduck.Common; +using Rubberduck.Parsing.Annotations; +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Parsing.VBA.Parsing; +using Rubberduck.Refactorings.Exceptions; + +namespace Rubberduck.Refactorings.AnnotateDeclaration +{ + public class AnnotateDeclarationRefactoringAction : CodeOnlyRefactoringActionBase + { + private readonly IAnnotationUpdater _annotationUpdater; + private readonly IAttributesUpdater _attributesUpdater; + + public AnnotateDeclarationRefactoringAction( + IRewritingManager rewritingManager, + IAnnotationUpdater annotationUpdater, + IAttributesUpdater attributesUpdater) + : base(rewritingManager) + { + _annotationUpdater = annotationUpdater; + _attributesUpdater = attributesUpdater; + } + + protected override CodeKind RewriteSessionCodeKind(AnnotateDeclarationModel model) + { + return model.AdjustAttribute + && model.Annotation is IAttributeAnnotation + ? CodeKind.AttributesCode + : CodeKind.CodePaneCode; + } + + public override void Refactor(AnnotateDeclarationModel model, IRewriteSession rewriteSession) + { + if (model.AdjustAttribute + && rewriteSession.TargetCodeKind != CodeKind.AttributesCode + && model.Annotation is IAttributeAnnotation) + { + throw new AttributeRewriteSessionRequiredException(); + } + + var targetDeclaration = model.Target; + + if (rewriteSession.TargetCodeKind == CodeKind.AttributesCode + && targetDeclaration.AttributesPassContext == null + && !targetDeclaration.DeclarationType.HasFlag(DeclarationType.Module)) + { + throw new AttributeRewriteSessionNotSupportedException(); + } + + var arguments = model.Arguments.Select(ToCode).ToList(); + + if (model.AdjustAttribute + && model.Annotation is IAttributeAnnotation attributeAnnotation) + { + var baseAttribute = attributeAnnotation.Attribute(arguments); + var attribute = targetDeclaration.DeclarationType.HasFlag(DeclarationType.Module) + ? baseAttribute + : Attributes.MemberAttributeName(baseAttribute, targetDeclaration.IdentifierName); + var attributeValues = attributeAnnotation.AnnotationToAttributeValues(arguments); + _attributesUpdater.AddOrUpdateAttribute(rewriteSession, targetDeclaration, attribute, attributeValues); + } + + _annotationUpdater.AddAnnotation(rewriteSession, targetDeclaration, model.Annotation, arguments); + } + + private string ToCode(TypedAnnotationArgument annotationArgument) + { + switch (annotationArgument.ArgumentType) + { + case AnnotationArgumentType.Text: + return annotationArgument.Argument.ToVbaStringLiteral(); + case AnnotationArgumentType.Boolean: + return ToBooleanLiteral(annotationArgument.Argument); + default: + return annotationArgument.Argument; + } + } + + private const string NotABoolean = "NOT_A_BOOLEAN"; + private string ToBooleanLiteral(string booleanText) + { + if (!bool.TryParse(booleanText, out var booleanValue)) + { + return NotABoolean; + } + + return booleanValue + ? Tokens.True + : Tokens.False; + } + } +} \ No newline at end of file diff --git a/Rubberduck.Refactorings/AnnotateDeclaration/AnnotateFolderRefactoringAction.cs b/Rubberduck.Refactorings/AnnotateDeclaration/AnnotateFolderRefactoringAction.cs deleted file mode 100644 index b58ab1b63c..0000000000 --- a/Rubberduck.Refactorings/AnnotateDeclaration/AnnotateFolderRefactoringAction.cs +++ /dev/null @@ -1,55 +0,0 @@ -using System; -using System.Linq; -using Rubberduck.Common; -using Rubberduck.Parsing.Annotations; -using Rubberduck.Parsing.Grammar; -using Rubberduck.Parsing.Rewriter; -using Rubberduck.Parsing.VBA; - -namespace Rubberduck.Refactorings.AnnotateDeclaration -{ - public class AnnotateDeclarationRefactoringAction : CodeOnlyRefactoringActionBase - { - private readonly IAnnotationUpdater _annotationUpdater; - - public AnnotateDeclarationRefactoringAction( - IRewritingManager rewritingManager, - IAnnotationUpdater annotationUpdater) - : base(rewritingManager) - { - _annotationUpdater = annotationUpdater; - } - - public override void Refactor(AnnotateDeclarationModel model, IRewriteSession rewriteSession) - { - var arguments = model.Arguments.Select(ToCode).ToList(); - _annotationUpdater.AddAnnotation(rewriteSession, model.Target, model.Annotation, arguments); - } - - private string ToCode(TypedAnnotationArgument annotationArgument) - { - switch (annotationArgument.ArgumentType) - { - case AnnotationArgumentType.Text: - return annotationArgument.Argument.ToVbaStringLiteral(); - case AnnotationArgumentType.Boolean: - return ToBooleanLiteral(annotationArgument.Argument); - default: - return annotationArgument.Argument; - } - } - - private const string NotABoolean = "NOT_A_BOOLEAN"; - private string ToBooleanLiteral(string booleanText) - { - if (!bool.TryParse(booleanText, out var booleanValue)) - { - return NotABoolean; - } - - return booleanValue - ? Tokens.True - : Tokens.False; - } - } -} \ No newline at end of file diff --git a/Rubberduck.Refactorings/Exceptions/AttributeRewriteSessionNotSupportedException.cs b/Rubberduck.Refactorings/Exceptions/AttributeRewriteSessionNotSupportedException.cs new file mode 100644 index 0000000000..ad604b5f14 --- /dev/null +++ b/Rubberduck.Refactorings/Exceptions/AttributeRewriteSessionNotSupportedException.cs @@ -0,0 +1,5 @@ +namespace Rubberduck.Refactorings.Exceptions +{ + public class AttributeRewriteSessionNotSupportedException : RefactoringException + { } +} \ No newline at end of file diff --git a/Rubberduck.Refactorings/Exceptions/AttributeRewriteSessionRequiredException.cs b/Rubberduck.Refactorings/Exceptions/AttributeRewriteSessionRequiredException.cs new file mode 100644 index 0000000000..f50ee55cbc --- /dev/null +++ b/Rubberduck.Refactorings/Exceptions/AttributeRewriteSessionRequiredException.cs @@ -0,0 +1,5 @@ +namespace Rubberduck.Refactorings.Exceptions +{ + public class AttributeRewriteSessionRequiredException : RefactoringException + { } +} \ No newline at end of file diff --git a/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedDeclarationCommandTests.cs b/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedDeclarationCommandTests.cs index 1e06eb9dd6..6f2115172e 100644 --- a/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedDeclarationCommandTests.cs +++ b/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedDeclarationCommandTests.cs @@ -31,7 +31,8 @@ public void AnnotateDeclaration_CanExecute_InvalidTargetType() } protected override CommandBase TestCommand( - IVBE vbe, RubberduckParserState state, + IVBE vbe, + RubberduckParserState state, IRewritingManager rewritingManager, ISelectionService selectionService) { @@ -45,7 +46,8 @@ public void AnnotateDeclaration_CanExecute_InvalidTargetType() var userInteraction = new RefactoringUserInteraction(factory, uiDispatcherMock.Object); var annotationUpdater = new AnnotationUpdater(state); - var annotateDeclarationAction = new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater); + var attributesUpdater = new AttributesUpdater(state); + var annotateDeclarationAction = new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater, attributesUpdater); var selectedDeclarationProvider = new SelectedDeclarationProvider(selectionService, state); diff --git a/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedMemberCommandTests.cs b/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedMemberCommandTests.cs index 7f05bb86ec..dd7134b9b4 100644 --- a/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedMemberCommandTests.cs +++ b/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedMemberCommandTests.cs @@ -45,7 +45,8 @@ public void AnnotateDeclaration_CanExecute_OutsideMember() var userInteraction = new RefactoringUserInteraction(factory, uiDispatcherMock.Object); var annotationUpdater = new AnnotationUpdater(state); - var annotateDeclarationAction = new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater); + var attributesUpdater = new AttributesUpdater(state); + var annotateDeclarationAction = new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater, attributesUpdater); var selectedDeclarationProvider = new SelectedDeclarationProvider(selectionService, state); diff --git a/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedModuleCommandTests.cs b/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedModuleCommandTests.cs index b48646467f..798e63823d 100644 --- a/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedModuleCommandTests.cs +++ b/RubberduckTests/Commands/RefactorCommands/AnnotateSelectedModuleCommandTests.cs @@ -45,7 +45,8 @@ public void AnnotateDeclaration_CanExecute_InsideMember() var userInteraction = new RefactoringUserInteraction(factory, uiDispatcherMock.Object); var annotationUpdater = new AnnotationUpdater(state); - var annotateDeclarationAction = new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater); + var attributesUpdater = new AttributesUpdater(state); + var annotateDeclarationAction = new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater, attributesUpdater); var selectedDeclarationProvider = new SelectedDeclarationProvider(selectionService, state); diff --git a/RubberduckTests/PostProcessing/AttributesUpdaterTests.cs b/RubberduckTests/PostProcessing/AttributesUpdaterTests.cs index 49d94f2c78..4e5bec8360 100644 --- a/RubberduckTests/PostProcessing/AttributesUpdaterTests.cs +++ b/RubberduckTests/PostProcessing/AttributesUpdaterTests.cs @@ -851,7 +851,7 @@ End Sub [Test] [Category("AttributesUpdater")] - public void AddOrUpdateAttribute_UsualAttribute_NotThere_AddsAttribute() + public void AddOrUpdateAttribute_UsualAttribute_NotThere_AddsAttribute_Module() { const string inputCode = @"VERSION 1.0 CLASS @@ -899,7 +899,7 @@ End Sub [Test] [Category("AttributesUpdater")] - public void AddOrUpdateAttribute_ExtKey_NotThere_AddsAttribute() + public void AddOrUpdateAttribute_UsualAttribute_AlreadyThere_UpdatesAttribute_Module() { const string inputCode = @"VERSION 1.0 CLASS @@ -908,6 +908,7 @@ public void AddOrUpdateAttribute_ExtKey_NotThere_AddsAttribute() END Attribute VB_Name = ""ClassKeys"" Attribute VB_GlobalNameSpace = False +Attribute VB_Exposed = False Public Sub Foo(bar As String) bar = vbNullString End Sub @@ -920,13 +921,13 @@ End Sub END Attribute VB_Name = ""ClassKeys"" Attribute VB_GlobalNameSpace = False -Attribute VB_Ext_Key = ""MyKey"", ""MyValue"" +Attribute VB_Exposed = True Public Sub Foo(bar As String) bar = vbNullString End Sub "; - var attribute = "VB_Ext_Key"; - var newValues = new List { "\"MyKey\"", "\"MyValue\"" }; + var attribute = "VB_Exposed"; + var newValues = new List { "True" }; string actualCode; var (component, rewriteSession, state) = TestSetup(inputCode); @@ -947,7 +948,7 @@ End Sub [Test] [Category("AttributesUpdater")] - public void AddOrUpdateAttribute_UsualAttribute_AlreadyThere_UpdatesAttribute() + public void AddOrUpdateAttribute_UsualAttribute_NotThere_AddsAttribute_Member() { const string inputCode = @"VERSION 1.0 CLASS @@ -956,7 +957,6 @@ public void AddOrUpdateAttribute_UsualAttribute_AlreadyThere_UpdatesAttribute() END Attribute VB_Name = ""ClassKeys"" Attribute VB_GlobalNameSpace = False -Attribute VB_Exposed = False Public Sub Foo(bar As String) bar = vbNullString End Sub @@ -969,13 +969,219 @@ End Sub END Attribute VB_Name = ""ClassKeys"" Attribute VB_GlobalNameSpace = False -Attribute VB_Exposed = True Public Sub Foo(bar As String) +Attribute Foo.VB_UserMemId = 0 bar = vbNullString End Sub "; - var attribute = "VB_Exposed"; - var newValues = new List { "True" }; + var attribute = "Foo.VB_UserMemId"; + var newValues = new List { "0" }; + + string actualCode; + var (component, rewriteSession, state) = TestSetup(inputCode); + using (state) + { + var moduleDeclaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Procedure) + .Single(); + var attributesUpdater = new AttributesUpdater(state); + + attributesUpdater.AddOrUpdateAttribute(rewriteSession, moduleDeclaration, attribute, newValues); + rewriteSession.TryRewrite(); + + actualCode = component.CodeModule.Content(); + } + Assert.AreEqual(expectedCode, actualCode); + } + + [Test] + [Category("AttributesUpdater")] + public void AddOrUpdateAttribute_UsualAttribute_AlreadyThere_UpdatesAttribute_Member() + { + const string inputCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +Public Sub Foo(bar As String) +Attribute Foo.VB_UserMemId = -4 + bar = vbNullString +End Sub +"; + + const string expectedCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +Public Sub Foo(bar As String) +Attribute Foo.VB_UserMemId = 0 + bar = vbNullString +End Sub +"; + var attribute = "Foo.VB_UserMemId"; + var newValues = new List { "0" }; + + string actualCode; + var (component, rewriteSession, state) = TestSetup(inputCode); + using (state) + { + var moduleDeclaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Procedure) + .Single(); + var attributesUpdater = new AttributesUpdater(state); + + attributesUpdater.AddOrUpdateAttribute(rewriteSession, moduleDeclaration, attribute, newValues); + rewriteSession.TryRewrite(); + + actualCode = component.CodeModule.Content(); + } + Assert.AreEqual(expectedCode, actualCode); + } + + [Test] + [Category("AttributesUpdater")] + public void AddOrUpdateAttribute_UsualAttribute_NotThere_AddsAttribute_Variable() + { + const string inputCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False + +Public MyVariable As Variant + +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + + const string expectedCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False + +Public MyVariable As Variant +Attribute MyVariable.VB_VarDescription = ""MyDesc"" + +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + var attribute = "MyVariable.VB_VarDescription"; + var newValues = new List { "\"MyDesc\"" }; + + string actualCode; + var (component, rewriteSession, state) = TestSetup(inputCode); + using (state) + { + var moduleDeclaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Variable) + .Single(declaration => declaration.IdentifierName.Equals("MyVariable")); + var attributesUpdater = new AttributesUpdater(state); + + attributesUpdater.AddOrUpdateAttribute(rewriteSession, moduleDeclaration, attribute, newValues); + rewriteSession.TryRewrite(); + + actualCode = component.CodeModule.Content(); + } + Assert.AreEqual(expectedCode, actualCode); + } + + [Test] + [Category("AttributesUpdater")] + public void AddOrUpdateAttribute_UsualAttribute_AlreadyThere_UpdatesAttribute_Variable() + { + const string inputCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False + +Public MyVariable As Variant +Attribute MyVariable.VB_VarDescription = ""NotMyDesc"" + +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + + const string expectedCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False + +Public MyVariable As Variant +Attribute MyVariable.VB_VarDescription = ""MyDesc"" + +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + var attribute = "MyVariable.VB_VarDescription"; + var newValues = new List { "\"MyDesc\"" }; + + string actualCode; + var (component, rewriteSession, state) = TestSetup(inputCode); + using (state) + { + var moduleDeclaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Variable) + .Single(declaration => declaration.IdentifierName.Equals("MyVariable")); + var attributesUpdater = new AttributesUpdater(state); + + attributesUpdater.AddOrUpdateAttribute(rewriteSession, moduleDeclaration, attribute, newValues); + rewriteSession.TryRewrite(); + + actualCode = component.CodeModule.Content(); + } + Assert.AreEqual(expectedCode, actualCode); + } + + [Test] + [Category("AttributesUpdater")] + public void AddOrUpdateAttribute_ExtKey_NotThere_AddsAttribute() + { + const string inputCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + + const string expectedCode = + @"VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True +END +Attribute VB_Name = ""ClassKeys"" +Attribute VB_GlobalNameSpace = False +Attribute VB_Ext_Key = ""MyKey"", ""MyValue"" +Public Sub Foo(bar As String) + bar = vbNullString +End Sub +"; + var attribute = "VB_Ext_Key"; + var newValues = new List { "\"MyKey\"", "\"MyValue\"" }; string actualCode; var (component, rewriteSession, state) = TestSetup(inputCode); diff --git a/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringActionTests.cs b/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringActionTests.cs index ce48e30fe3..5e80f7c753 100644 --- a/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringActionTests.cs +++ b/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringActionTests.cs @@ -8,6 +8,7 @@ using Rubberduck.Parsing.VBA; using Rubberduck.Refactorings; using Rubberduck.Refactorings.AnnotateDeclaration; +using Rubberduck.Refactorings.Exceptions; namespace RubberduckTests.Refactoring.AnnotateDeclaration { @@ -273,11 +274,353 @@ End Sub Assert.AreEqual(expectedCode, refactoredCode); } + [Test] + [Category("Refactorings")] + public void AnnotateDeclarationRefactoringAction_AdjustAttributeSet_NoAttributeAnnotation_AsIfNotSet() + { + const string code = @" +Public Sub Foo() +End Sub +"; + const string expectedCode = @" +'@Ignore ProcedureNotUsed +Public Sub Foo() +End Sub +"; + Func modelBuilder = (state) => + { + var declaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Procedure) + .Single(); + var annotation = new IgnoreAnnotation(); + var arguments = new List + { + new TypedAnnotationArgument(AnnotationArgumentType.Inspection, "ProcedureNotUsed") + }; + + return new AnnotateDeclarationModel(declaration, annotation, arguments, true); + }; + + var refactoredCode = RefactoredCode(code, modelBuilder); + + Assert.AreEqual(expectedCode, refactoredCode); + } + + [Test] + [Category("Refactorings")] + public void AnnotateDeclarationRefactoringAction_AdjustAttributeSet_AttributeNotThere_AddsAttribute_Module() + { + const string code = @"Attribute VB_Exposed = False +Public Sub Foo() +End Sub +"; + const string expectedCode = @"Attribute VB_Exposed = False +Attribute VB_Description = ""MyDesc"" +'@ModuleDescription ""MyDesc"" +Public Sub Foo() +End Sub +"; + Func modelBuilder = (state) => + { + var declaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Module) + .Single(); + var annotation = new ModuleDescriptionAnnotation(); + var arguments = new List + { + new TypedAnnotationArgument(AnnotationArgumentType.Text, "MyDesc") + }; + + return new AnnotateDeclarationModel(declaration, annotation, arguments, true); + }; + + var refactoredCode = RefactoredCode(code, modelBuilder); + + Assert.AreEqual(expectedCode, refactoredCode); + } + + [Test] + [Category("Refactorings")] + public void AnnotateDeclarationRefactoringAction_AdjustAttributeSet_AttributeNotThere_AddsAttribute_Member() + { + const string code = @" +Public Sub Foo() +End Sub +"; + const string expectedCode = @" +'@Description ""MyDesc"" +Public Sub Foo() +Attribute Foo.VB_Description = ""MyDesc"" +End Sub +"; + Func modelBuilder = (state) => + { + var declaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Procedure) + .Single(); + var annotation = new DescriptionAnnotation(); + var arguments = new List + { + new TypedAnnotationArgument(AnnotationArgumentType.Text, "MyDesc") + }; + + return new AnnotateDeclarationModel(declaration, annotation, arguments, true); + }; + + var refactoredCode = RefactoredCode(code, modelBuilder); + + Assert.AreEqual(expectedCode, refactoredCode); + } + + [Test] + [Category("Refactorings")] + public void AnnotateDeclarationRefactoringAction_AdjustAttributeSet_AttributeNotThere_AddsAttribute_ModuleVariable() + { + const string code = @" +Public MyVariable As Variant + +Public Sub Foo() +End Sub +"; + const string expectedCode = @" +'@VariableDescription ""MyDesc"" +Public MyVariable As Variant +Attribute MyVariable.VB_VarDescription = ""MyDesc"" + +Public Sub Foo() +End Sub +"; + Func modelBuilder = (state) => + { + var declaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Variable) + .Single(); + var annotation = new VariableDescriptionAnnotation(); + var arguments = new List + { + new TypedAnnotationArgument(AnnotationArgumentType.Text, "MyDesc") + }; + + return new AnnotateDeclarationModel(declaration, annotation, arguments, true); + }; + + var refactoredCode = RefactoredCode(code, modelBuilder); + + Assert.AreEqual(expectedCode, refactoredCode); + } + + [Test] + [Category("Refactorings")] + public void AnnotateDeclarationRefactoringAction_AdjustAttributeSet_NoAttributeContext_LocalVariable_Throws() + { + const string code = @" + +Public Sub Foo() + Dim MyVariable As Variant +End Sub +"; + Func modelBuilder = (state) => + { + var declaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Variable) + .Single(); + var annotation = new VariableDescriptionAnnotation(); + var arguments = new List + { + new TypedAnnotationArgument(AnnotationArgumentType.Text, "MyDesc") + }; + + return new AnnotateDeclarationModel(declaration, annotation, arguments, true); + }; + + Assert.Throws(() => RefactoredCode(code, modelBuilder)); + } + + [Test] + [Category("Refactorings")] + public void AnnotateDeclarationRefactoringAction_AdjustAttributeSet_AttributeAlreadyThere_AdjustsAttribute_Module() + { + const string code = @"Attribute VB_Exposed = False +Attribute VB_PredeclaredId = False +Public Sub Foo() +End Sub +"; + const string expectedCode = @"Attribute VB_Exposed = False +Attribute VB_PredeclaredId = True +'@PredeclaredId +Public Sub Foo() +End Sub +"; + Func modelBuilder = (state) => + { + var declaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Module) + .Single(); + var annotation = new PredeclaredIdAnnotation(); + var arguments = new List(); + + return new AnnotateDeclarationModel(declaration, annotation, arguments, true); + }; + + var refactoredCode = RefactoredCode(code, modelBuilder); + + Assert.AreEqual(expectedCode, refactoredCode); + } + + [Test] + [Category("Refactorings")] + public void AnnotateDeclarationRefactoringAction_AdjustAttributeSet_AttributeAlreadyThere_AdjustsAttribute_Member() + { + const string code = @" +Public Sub Foo() +Attribute Foo.VB_Description = ""NotMyDesc"" +End Sub +"; + const string expectedCode = @" +'@Description ""MyDesc"" +Public Sub Foo() +Attribute Foo.VB_Description = ""MyDesc"" +End Sub +"; + Func modelBuilder = (state) => + { + var declaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Procedure) + .Single(); + var annotation = new DescriptionAnnotation(); + var arguments = new List + { + new TypedAnnotationArgument(AnnotationArgumentType.Text, "MyDesc") + }; + + return new AnnotateDeclarationModel(declaration, annotation, arguments, true); + }; + + var refactoredCode = RefactoredCode(code, modelBuilder); + + Assert.AreEqual(expectedCode, refactoredCode); + } + + [Test] + [Category("Refactorings")] + public void AnnotateDeclarationRefactoringAction_AdjustAttributeSet_AttributeNotThere_AdjustsAttribute_ModuleVariable() + { + const string code = @" +Public MyVariable As Variant +Attribute MyVariable.VB_VarDescription = ""NotMyDesc"" + +Public Sub Foo() +End Sub +"; + const string expectedCode = @" +'@VariableDescription ""MyDesc"" +Public MyVariable As Variant +Attribute MyVariable.VB_VarDescription = ""MyDesc"" + +Public Sub Foo() +End Sub +"; + Func modelBuilder = (state) => + { + var declaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Variable) + .Single(); + var annotation = new VariableDescriptionAnnotation(); + var arguments = new List + { + new TypedAnnotationArgument(AnnotationArgumentType.Text, "MyDesc") + }; + + return new AnnotateDeclarationModel(declaration, annotation, arguments, true); + }; + + var refactoredCode = RefactoredCode(code, modelBuilder); + + Assert.AreEqual(expectedCode, refactoredCode); + } + + [Test] + [Category("Refactorings")] + public void AnnotateDeclarationRefactoringAction_AdjustAttributeSet_DifferentiatesBetweenExtKeys_Add() + { + const string code = @"Attribute VB_Ext_Key = ""MyFirstKey"", ""MyFirstValue"" +Attribute VB_Ext_Key = ""MySecondKey"", ""MySecondValue"" +Attribute VB_Ext_Key = ""MyThirdKey"", ""MyThirdValue"" +Public Sub Foo() +End Sub +"; + const string expectedCode = @"Attribute VB_Ext_Key = ""MyFirstKey"", ""MyFirstValue"" +Attribute VB_Ext_Key = ""MySecondKey"", ""MySecondValue"" +Attribute VB_Ext_Key = ""MyThirdKey"", ""MyThirdValue"" +Attribute VB_Ext_Key = ""MyNewKey"", ""MyNewValue"" +'@ModuleAttribute VB_Ext_Key, ""MyNewKey"", ""MyNewValue"" +Public Sub Foo() +End Sub +"; + Func modelBuilder = (state) => + { + var declaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Module) + .Single(); + var annotation = new ModuleAttributeAnnotation(); + var arguments = new List + { + new TypedAnnotationArgument(AnnotationArgumentType.Attribute, "VB_Ext_Key"), + new TypedAnnotationArgument(AnnotationArgumentType.Text, "MyNewKey"), + new TypedAnnotationArgument(AnnotationArgumentType.Text, "MyNewValue") + }; + + return new AnnotateDeclarationModel(declaration, annotation, arguments, true); + }; + + var refactoredCode = RefactoredCode(code, modelBuilder); + + Assert.AreEqual(expectedCode, refactoredCode); + } + + [Test] + [Category("Refactorings")] + public void AnnotateDeclarationRefactoringAction_AdjustAttributeSet_DifferentiatesBetweenExtKeys_Adjust() + { + const string code = @"Attribute VB_Ext_Key = ""MyFirstKey"", ""MyFirstValue"" +Attribute VB_Ext_Key = ""MySecondKey"", ""MySecondValue"" +Attribute VB_Ext_Key = ""MyThirdKey"", ""MyThirdValue"" +Public Sub Foo() +End Sub +"; + const string expectedCode = @"Attribute VB_Ext_Key = ""MyFirstKey"", ""MyFirstValue"" +Attribute VB_Ext_Key = ""MySecondKey"", ""MyNewValue"" +Attribute VB_Ext_Key = ""MyThirdKey"", ""MyThirdValue"" +'@ModuleAttribute VB_Ext_Key, ""MySecondKey"", ""MyNewValue"" +Public Sub Foo() +End Sub +"; + Func modelBuilder = (state) => + { + var declaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Module) + .Single(); + var annotation = new ModuleAttributeAnnotation(); + var arguments = new List + { + new TypedAnnotationArgument(AnnotationArgumentType.Attribute, "VB_Ext_Key"), + new TypedAnnotationArgument(AnnotationArgumentType.Text, "MySecondKey"), + new TypedAnnotationArgument(AnnotationArgumentType.Text, "MyNewValue") + }; + + return new AnnotateDeclarationModel(declaration, annotation, arguments, true); + }; + + var refactoredCode = RefactoredCode(code, modelBuilder); + + Assert.AreEqual(expectedCode, refactoredCode); + } protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) { var annotationUpdater = new AnnotationUpdater(state); - return new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater); + var attributesUpdater = new AttributesUpdater(state); + return new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater, attributesUpdater); } } } \ No newline at end of file diff --git a/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringTests.cs b/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringTests.cs index 59517ee2d6..066d49078f 100644 --- a/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringTests.cs +++ b/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringTests.cs @@ -85,7 +85,8 @@ public void AnnotateDeclarationRefactoring_InvalidTargetType_Throws() ISelectionService selectionService) { var annotationUpdater = new AnnotationUpdater(state); - var annotateDeclarationAction = new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater); + var attributesUpdater = new AttributesUpdater(state); + var annotateDeclarationAction = new AnnotateDeclarationRefactoringAction(rewritingManager, annotationUpdater, attributesUpdater); var selectedDeclarationProvider = new SelectedDeclarationProvider(selectionService, state); return new AnnotateDeclarationRefactoring(annotateDeclarationAction, selectedDeclarationProvider, selectionService, userInteraction); From 5a21194984bfaf3c0816df33a1d2466d4a0ef607 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Wed, 24 Jun 2020 16:13:35 +0200 Subject: [PATCH 4/7] Adjust AnnotateDeclarationViewModel for new AdjustAttribute capability --- .../AnnotateDeclarationViewModel.cs | 19 +++++++++ Rubberduck.Parsing/Symbols/Declaration.cs | 2 +- .../AnnotateDeclarationViewModelTests.cs | 42 +++++++++++++++++-- 3 files changed, 59 insertions(+), 4 deletions(-) diff --git a/Rubberduck.Core/UI/Refactorings/AnnotateDeclaration/AnnotateDeclarationViewModel.cs b/Rubberduck.Core/UI/Refactorings/AnnotateDeclaration/AnnotateDeclarationViewModel.cs index 44da90d3d6..5b4ce9ba88 100644 --- a/Rubberduck.Core/UI/Refactorings/AnnotateDeclaration/AnnotateDeclarationViewModel.cs +++ b/Rubberduck.Core/UI/Refactorings/AnnotateDeclaration/AnnotateDeclarationViewModel.cs @@ -80,11 +80,30 @@ public IAnnotation Annotation OnPropertyChanged(); OnPropertyChanged(nameof(IsValidAnnotation)); + OnPropertyChanged(nameof(ShowAdjustAttributeOption)); } } public ObservableViewModelCollection AnnotationArguments { get; } + public bool AdjustAttribute + { + get => Model.AdjustAttribute; + set + { + if (value == Model.AdjustAttribute) + { + return; + } + + Model.AdjustAttribute = value; + + OnPropertyChanged(); + } + } + + public bool ShowAdjustAttributeOption => Model?.Annotation is IAttributeAnnotation; + private void RefreshAnnotationArguments(IAnnotation annotation) { AnnotationArguments.Clear(); diff --git a/Rubberduck.Parsing/Symbols/Declaration.cs b/Rubberduck.Parsing/Symbols/Declaration.cs index 8a31d32d2a..32dac2dc7a 100644 --- a/Rubberduck.Parsing/Symbols/Declaration.cs +++ b/Rubberduck.Parsing/Symbols/Declaration.cs @@ -289,7 +289,7 @@ public string DescriptionString { string literalDescription; - var memberAttribute = Attributes.SingleOrDefault(a => a.Name == $"{IdentifierName}.VB_Description"); + var memberAttribute = Attributes.SingleOrDefault(a => a.Name == Attributes.MemberAttributeName("VB_Description", IdentifierName)); if (memberAttribute != null) { literalDescription = memberAttribute.Values.SingleOrDefault() ?? string.Empty; diff --git a/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationViewModelTests.cs b/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationViewModelTests.cs index 13bd220d1d..5f310603f6 100644 --- a/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationViewModelTests.cs +++ b/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationViewModelTests.cs @@ -269,6 +269,28 @@ public void RemoveArgument_LastArgumentRemoved() } } + [Test] + [Category("Refactorings")] + public void ShowAdjustAttributeOption_AttributeAnnotation_True() + { + var viewModel = TestViewModel(DeclarationType.Procedure); + var annotation = new DescriptionAnnotation(); + viewModel.Annotation = annotation; + + Assert.IsTrue(viewModel.ShowAdjustAttributeOption); + } + + [Test] + [Category("Refactorings")] + public void ShowAdjustAttributeOption_NotAnAttributeAnnotation_False() + { + var viewModel = TestViewModel(DeclarationType.Procedure); + var annotation = new IgnoreAnnotation(); + viewModel.Annotation = annotation; + + Assert.IsFalse(viewModel.ShowAdjustAttributeOption); + } + [Test] [Category("Refactorings")] public void SetAnnotation_ResetsArguments() @@ -291,6 +313,20 @@ public void SetAnnotation_SetsAnnotationOnModel() Assert.AreSame(viewModel.Model.Annotation, annotation); } + [Test] + [Category("Refactorings")] + [TestCase(true, true)] + [TestCase(false, true)] + [TestCase(true, false)] + [TestCase(false, false)] + public void SetAdjustAttribute_SetsAdjustAttributeOnModel(bool initialValue, bool valueToSet) + { + var viewModel = TestViewModel(DeclarationType.Procedure, initialAdjustAttribute: initialValue); + viewModel.AdjustAttribute = valueToSet; + + Assert.AreEqual(viewModel.Model.AdjustAttribute, valueToSet); + } + [Test] [Category("Refactorings")] public void ModelIsInputModelFromCreation() @@ -321,10 +357,10 @@ public void DialogOK_SetsArguments() } - private AnnotateDeclarationViewModel TestViewModel(DeclarationType targetDeclarationType, IAnnotation initialAnnotation = null, bool localScope = false) + private AnnotateDeclarationViewModel TestViewModel(DeclarationType targetDeclarationType, IAnnotation initialAnnotation = null, bool localScope = false, bool initialAdjustAttribute = false) { var argumentFactory = MockArgumentFactory().Object; - return TestViewModel(targetDeclarationType, argumentFactory, initialAnnotation, localScope); + return TestViewModel(targetDeclarationType, argumentFactory, initialAnnotation, localScope, initialAdjustAttribute); } private Mock MockArgumentFactory(IReadOnlyList hasErrorSpecifications = null) @@ -353,7 +389,7 @@ private Mock MockArgument(AnnotationArgumentType a return mockArgument; } - private AnnotateDeclarationViewModel TestViewModel(DeclarationType targetDeclarationType, IAnnotationArgumentViewModelFactory argumentFactory, IAnnotation initialAnnotation = null, bool localScope = false) + private AnnotateDeclarationViewModel TestViewModel(DeclarationType targetDeclarationType, IAnnotationArgumentViewModelFactory argumentFactory, IAnnotation initialAnnotation = null, bool localScope = false, bool initialAdjustAttribute = false) { var targetDeclaration = TestDeclaration(targetDeclarationType, localScope); var model = new AnnotateDeclarationModel(targetDeclaration, initialAnnotation); From a1e92de9984d4284f098e544faad003e568d6879 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Wed, 24 Jun 2020 23:19:01 +0200 Subject: [PATCH 5/7] Add option to add/adjust attribute to AnnotateDeclaration UI --- .../UI/Converters/BoolToVisibleVisibilityConverter.cs | 6 ++++-- .../AnnotateDeclaration/AnnotateDeclarationView.xaml | 10 ++++++++++ Rubberduck.Resources/RubberduckUI.Designer.cs | 9 +++++++++ Rubberduck.Resources/RubberduckUI.de.resx | 3 +++ Rubberduck.Resources/RubberduckUI.resx | 3 +++ 5 files changed, 29 insertions(+), 2 deletions(-) diff --git a/Rubberduck.Core/UI/Converters/BoolToVisibleVisibilityConverter.cs b/Rubberduck.Core/UI/Converters/BoolToVisibleVisibilityConverter.cs index bf58dd2368..d6645461ca 100644 --- a/Rubberduck.Core/UI/Converters/BoolToVisibleVisibilityConverter.cs +++ b/Rubberduck.Core/UI/Converters/BoolToVisibleVisibilityConverter.cs @@ -7,16 +7,18 @@ namespace Rubberduck.UI.Converters { public class BoolToVisibleVisibilityConverter : IValueConverter { + public Visibility FalseVisibility { get; set; } = Visibility.Collapsed; + public object Convert(object value, Type targetType, object parameter, CultureInfo culture) { var typedValue = (bool)value; - return typedValue ? Visibility.Visible : Visibility.Collapsed; + return typedValue ? Visibility.Visible : FalseVisibility; } public object ConvertBack(object value, Type targetType, object parameter, CultureInfo culture) { var typedValue = (Visibility)value; - return typedValue != Visibility.Collapsed; + return typedValue != FalseVisibility; } } } diff --git a/Rubberduck.Core/UI/Refactorings/AnnotateDeclaration/AnnotateDeclarationView.xaml b/Rubberduck.Core/UI/Refactorings/AnnotateDeclaration/AnnotateDeclarationView.xaml index 3f47acdb76..bcc02d4d14 100644 --- a/Rubberduck.Core/UI/Refactorings/AnnotateDeclaration/AnnotateDeclarationView.xaml +++ b/Rubberduck.Core/UI/Refactorings/AnnotateDeclaration/AnnotateDeclarationView.xaml @@ -18,6 +18,7 @@ + @@ -102,6 +103,15 @@ + + + + + diff --git a/Rubberduck.Resources/RubberduckUI.Designer.cs b/Rubberduck.Resources/RubberduckUI.Designer.cs index 2a4be83420..7915f5aff1 100644 --- a/Rubberduck.Resources/RubberduckUI.Designer.cs +++ b/Rubberduck.Resources/RubberduckUI.Designer.cs @@ -162,6 +162,15 @@ public class RubberduckUI { } } + /// + /// Looks up a localized string similar to Add/Adjust attribute. + /// + public static string AnnotateDeclarationDialog_AdjustAttributeLabel { + get { + return ResourceManager.GetString("AnnotateDeclarationDialog_AdjustAttributeLabel", resourceCulture); + } + } + /// /// Looks up a localized string similar to Annotation to Add:. /// diff --git a/Rubberduck.Resources/RubberduckUI.de.resx b/Rubberduck.Resources/RubberduckUI.de.resx index 164c8e9f03..808d9c8856 100644 --- a/Rubberduck.Resources/RubberduckUI.de.resx +++ b/Rubberduck.Resources/RubberduckUI.de.resx @@ -1722,4 +1722,7 @@ Wollen Sie fortfahren? Ordner umbenennen + + Attribut hinzufügen / anpassen + \ No newline at end of file diff --git a/Rubberduck.Resources/RubberduckUI.resx b/Rubberduck.Resources/RubberduckUI.resx index c973384aa5..37230872ca 100644 --- a/Rubberduck.Resources/RubberduckUI.resx +++ b/Rubberduck.Resources/RubberduckUI.resx @@ -1940,4 +1940,7 @@ Do you want to proceed? Rename folder + + Add/Adjust attribute + \ No newline at end of file From 1a2cef2b07119a439198d03fbb13601f151054e7 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Wed, 24 Jun 2020 23:22:18 +0200 Subject: [PATCH 6/7] Show AnnotateDeclaration UI from CE command for IAttributeAnnotations This is an exception to the rule that annotations without parameters are applied immediately. This is necessary since the option to add.adjust the corresponding attribute exists now. --- .../UI/CodeExplorer/Commands/AnnotateDeclarationCommand.cs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/Rubberduck.Core/UI/CodeExplorer/Commands/AnnotateDeclarationCommand.cs b/Rubberduck.Core/UI/CodeExplorer/Commands/AnnotateDeclarationCommand.cs index a9d7852101..f4409a1c0d 100644 --- a/Rubberduck.Core/UI/CodeExplorer/Commands/AnnotateDeclarationCommand.cs +++ b/Rubberduck.Core/UI/CodeExplorer/Commands/AnnotateDeclarationCommand.cs @@ -133,7 +133,8 @@ protected override void OnExecute(object parameter) { var model = ModelFromParameter(annotation, target); if (!annotation.AllowedArguments.HasValue - || annotation.AllowedArguments.Value > 0) + || annotation.AllowedArguments.Value > 0 + || annotation is IAttributeAnnotation) { model = _userInteraction.UserModifiedModel(model); } From 823562b45a8e25a9848fc2a272c68065e9f89000 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Thu, 25 Jun 2020 00:18:09 +0200 Subject: [PATCH 7/7] Use correct context when adding annotations via attributes code This is hard to test since the bug fixed here only materializes when the attributes are removed in the code pane version of the code. --- Rubberduck.Parsing/VBA/AnnotationUpdater.cs | 12 ++- ...notateDeclarationRefactoringActionTests.cs | 74 +++++++++++++++++++ 2 files changed, 84 insertions(+), 2 deletions(-) diff --git a/Rubberduck.Parsing/VBA/AnnotationUpdater.cs b/Rubberduck.Parsing/VBA/AnnotationUpdater.cs index aa236890f4..4e4cd79d51 100644 --- a/Rubberduck.Parsing/VBA/AnnotationUpdater.cs +++ b/Rubberduck.Parsing/VBA/AnnotationUpdater.cs @@ -214,7 +214,11 @@ private void AddVariableAnnotation(IRewriteSession rewriteSession, Declaration d return; } - AddAnnotation(rewriteSession, declaration.QualifiedModuleName, declaration.Context, annotationInfo, annotationValues); + var context = rewriteSession.TargetCodeKind == CodeKind.CodePaneCode + ? declaration.Context + : declaration.AttributesPassContext; + + AddAnnotation(rewriteSession, declaration.QualifiedModuleName, context, annotationInfo, annotationValues); } private void AddMemberAnnotation(IRewriteSession rewriteSession, Declaration declaration, IAnnotation annotationInfo, IReadOnlyList annotationValues) @@ -233,7 +237,11 @@ private void AddMemberAnnotation(IRewriteSession rewriteSession, Declaration dec return; } - AddAnnotation(rewriteSession, declaration.QualifiedModuleName, declaration.Context, annotationInfo, annotationValues); + var context = rewriteSession.TargetCodeKind == CodeKind.CodePaneCode + ? declaration.Context + : declaration.AttributesPassContext; + + AddAnnotation(rewriteSession, declaration.QualifiedModuleName, context, annotationInfo, annotationValues); } public void AddAnnotation(IRewriteSession rewriteSession, IdentifierReference reference, IAnnotation annotationInfo, IReadOnlyList values = null) diff --git a/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringActionTests.cs b/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringActionTests.cs index 5e80f7c753..0729dd462b 100644 --- a/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringActionTests.cs +++ b/RubberduckTests/Refactoring/AnnotateDeclaration/AnnotateDeclarationRefactoringActionTests.cs @@ -616,6 +616,80 @@ End Sub Assert.AreEqual(expectedCode, refactoredCode); } + [Test] + [Category("Refactorings")] + public void AnnotateDeclarationRefactoringAction_AdjustAttributeSet_WorksWithExistingAnnotation_Module() + { + const string code = @"Attribute VB_Exposed = False +'@Folder ""MyFolder"" +'@DefaultMember +Public Sub Foo() +End Sub +"; + const string expectedCode = @"Attribute VB_Exposed = False +Attribute VB_Description = ""MyDesc"" +'@ModuleDescription ""MyDesc"" +'@Folder ""MyFolder"" +'@DefaultMember +Public Sub Foo() +End Sub +"; + Func modelBuilder = (state) => + { + var declaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Module) + .Single(); + var annotation = new ModuleDescriptionAnnotation(); + var arguments = new List + { + new TypedAnnotationArgument(AnnotationArgumentType.Text, "MyDesc") + }; + + return new AnnotateDeclarationModel(declaration, annotation, arguments, true); + }; + + var refactoredCode = RefactoredCode(code, modelBuilder); + + Assert.AreEqual(expectedCode, refactoredCode); + } + + [Test] + [Category("Refactorings")] + public void AnnotateDeclarationRefactoringAction_WorksWithExistingAnnotation_Member() + { + const string code = @"Attribute VB_Exposed = False +'@Folder ""MyFolder"" +'@DefaultMember +Public Sub Foo() +End Sub +"; + const string expectedCode = @"Attribute VB_Exposed = False +'@Folder ""MyFolder"" +'@DefaultMember +'@Description ""MyDesc"" +Public Sub Foo() +Attribute Foo.VB_Description = ""MyDesc"" +End Sub +"; + Func modelBuilder = (state) => + { + var declaration = state.DeclarationFinder + .UserDeclarations(DeclarationType.Procedure) + .Single(); + var annotation = new DescriptionAnnotation(); + var arguments = new List + { + new TypedAnnotationArgument(AnnotationArgumentType.Text, "MyDesc") + }; + + return new AnnotateDeclarationModel(declaration, annotation, arguments, true); + }; + + var refactoredCode = RefactoredCode(code, modelBuilder); + + Assert.AreEqual(expectedCode, refactoredCode); + } + protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) { var annotationUpdater = new AnnotationUpdater(state);