Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Merge pull request #5311 from MDoerner/FixExcelHotkeyAttribute
Fixes ExcelHotkey attribute annotation value
  • Loading branch information
retailcoder committed Dec 4, 2019
2 parents a42fe52 + bf4f880 commit c0e49f5
Show file tree
Hide file tree
Showing 4 changed files with 114 additions and 3 deletions.
Expand Up @@ -15,7 +15,7 @@ public ExcelHotKeyAnnotation()

public override IReadOnlyList<string> AnnotationToAttributeValues(IReadOnlyList<string> annotationValues)
{
return annotationValues.Take(1).Select(v => v.UnQuote()[0] + @"\n14".EnQuote()).ToList();
return annotationValues.Take(1).Select(v => (v.UnQuote()[0] + @"\n14").EnQuote()).ToList();
}

public override IReadOnlyList<string> AttributeToAnnotationValues(IReadOnlyList<string> attributeValues)
Expand Down
91 changes: 91 additions & 0 deletions RubberduckTests/Annotations/AttributeAnnotationTests.cs
@@ -0,0 +1,91 @@
using System.Collections.Generic;
using System.Linq;
using NUnit.Framework;
using Rubberduck.Parsing.Annotations;
using Rubberduck.Parsing.Symbols;
using Rubberduck.VBEditor.SafeComWrappers;
using RubberduckTests.Mocks;

namespace RubberduckTests.Annotations
{
[TestFixture]
public class AttributeAnnotationTests
{
[TestCase("VB_Description", "\"SomeDescription\"", "ModuleDescription", "\"SomeDescription\"")]
[TestCase("VB_Exposed", "True", "Exposed")]
[TestCase("VB_PredeclaredId", "True", "PredeclaredId")]
public void ModuleAttributeAnnotationReturnsReturnsCorrectAttribute(string expectedAttribute, string expectedAttributeValues, string annotationName, string annotationValue = null)
{
var code = $@"
'@{annotationName} {annotationValue}";

var vbe = MockVbeBuilder.BuildFromSingleModule(code, "Class1", ComponentType.ClassModule, out _).Object;
using (var state = MockParser.CreateAndParse(vbe))
{
var moduleDeclaration = state.DeclarationFinder.UserDeclarations(DeclarationType.ClassModule).Single();
var moduleAnnotations = moduleDeclaration.Annotations
.Select(pta => (pta.Annotation, pta.AnnotationArguments));
var (annotation, annotationArguments) = moduleAnnotations.Single(tpl => tpl.Annotation.Name.Equals(annotationName));

var actualAttribute = ((IAttributeAnnotation) annotation).Attribute(annotationArguments);
var actualAttributeValues = ((IAttributeAnnotation)annotation).AnnotationToAttributeValues(annotationArguments);
var actualAttributesValuesText = string.Join(", ", actualAttributeValues);

Assert.AreEqual(expectedAttribute, actualAttribute);
Assert.AreEqual(actualAttributesValuesText, expectedAttributeValues);
}
}

[TestCase("VB_ProcData.VB_Invoke_Func", @"""A\n14""", "ExcelHotkey", "A")] //See issue #5268 at https://github.com/rubberduck-vba/Rubberduck/issues/5268
[TestCase("VB_Description", "\"SomeDescription\"", "Description", "\"SomeDescription\"")]
[TestCase("VB_UserMemId", "0", "DefaultMember")]
[TestCase("VB_UserMemId", "-4", "Enumerator")]
public void MemberAttributeAnnotationReturnsReturnsCorrectAttribute(string expectedAttribute, string expectedAttributeValues, string annotationName, string annotationValue = null)
{
var code = $@"
'@{annotationName} {annotationValue}
Public Function Foo()
End Function";

var vbe = MockVbeBuilder.BuildFromSingleModule(code, "Class1", ComponentType.ClassModule, out _).Object;
using (var state = MockParser.CreateAndParse(vbe))
{
var memberDeclaration = state.DeclarationFinder.UserDeclarations(DeclarationType.Function).Single();
var memberAnnotations = memberDeclaration.Annotations
.Select(pta => (pta.Annotation, pta.AnnotationArguments));
var (annotation, annotationArguments) = memberAnnotations.Single(tpl => tpl.Annotation.Name.Equals(annotationName));

var actualAttribute = ((IAttributeAnnotation)annotation).Attribute(annotationArguments);
var actualAttributeValues = ((IAttributeAnnotation) annotation).AnnotationToAttributeValues(annotationArguments);
var actualAttributesValuesText = string.Join(", ", actualAttributeValues);

Assert.AreEqual(expectedAttribute, actualAttribute);
Assert.AreEqual(expectedAttributeValues, actualAttributesValuesText);
}
}

[TestCase("VB_VarDescription", "\"SomeDescription\"", "VariableDescription", "\"SomeDescription\"")]
public void VariableAttributeAnnotationReturnsReturnsCorrectAttribute(string expectedAttribute, string expectedAttributeValues, string annotationName, string annotationValue = null)
{
var code = $@"
'@{annotationName} {annotationValue}
Public MyVariable";

var vbe = MockVbeBuilder.BuildFromSingleModule(code, "Class1", ComponentType.ClassModule, out _).Object;
using (var state = MockParser.CreateAndParse(vbe))
{
var memberDeclaration = state.DeclarationFinder.UserDeclarations(DeclarationType.Variable).Single();
var memberAnnotations = memberDeclaration.Annotations
.Select(pta => (pta.Annotation, pta.AnnotationArguments));
var (annotation, annotationArguments) = memberAnnotations.Single(tpl => tpl.Annotation.Name.Equals(annotationName));

var actualAttribute = ((IAttributeAnnotation)annotation).Attribute(annotationArguments);
var actualAttributeValues = ((IAttributeAnnotation)annotation).AnnotationToAttributeValues(annotationArguments);
var actualAttributesValuesText = string.Join(", ", actualAttributeValues);

Assert.AreEqual(expectedAttribute, actualAttribute);
Assert.AreEqual(actualAttributesValuesText, expectedAttributeValues);
}
}
}
}
2 changes: 0 additions & 2 deletions RubberduckTests/Grammar/AnnotationTests.cs
@@ -1,9 +1,7 @@
using NUnit.Framework;
using Rubberduck.Parsing.Annotations;
using Rubberduck.VBEditor;
using RubberduckTests.Mocks;
using System;
using System.Collections.Generic;
using System.Linq;

namespace RubberduckTests.Grammar
Expand Down
22 changes: 22 additions & 0 deletions RubberduckTests/QuickFixes/AddMissingAttributeQuickFixTests.cs
Expand Up @@ -52,6 +52,28 @@ public void MissingMemberAttribute_QuickFixWorks()
Assert.AreEqual(expectedCode, actualCode);
}

[Test]
[Category("QuickFixes")]
//See issue #5268 at https://github.com/rubberduck-vba/Rubberduck/issues/5268
public void MissingMemberAttribute_ExcelHotkey_QuickFixWorks()
{
const string inputCode =
@"'@ExcelHotkey ""T""
Public Sub Foo()
Const const1 As Integer = 9
End Sub";

const string expectedCode =
@"'@ExcelHotkey ""T""
Public Sub Foo()
Attribute Foo.VB_ProcData.VB_Invoke_Func = ""T\n14""
Const const1 As Integer = 9
End Sub";

var actualCode = ApplyQuickFixToFirstInspectionResult(inputCode, state => new MissingAttributeInspection(state), CodeKind.AttributesCode);
Assert.AreEqual(expectedCode, actualCode);
}

[Test]
[Category("QuickFixes")]
public void MissingMemberAttributeOnConditionalCompilation_QuickFixWorks()
Expand Down

0 comments on commit c0e49f5

Please sign in to comment.