Skip to content

Commit 4f034c9

Browse files
committed
Enclose default members to expand with brackets if they are otherwise not legal
1 parent 4954ef1 commit 4f034c9

File tree

4 files changed

+91
-2
lines changed

4 files changed

+91
-2
lines changed

Rubberduck.CodeAnalysis/QuickFixes/ExpandBangNotationQuickFix.cs

Lines changed: 15 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -59,10 +59,24 @@ private void InsertDefaultMember(VBAParser.DictionaryAccessContext dictionaryAcc
5959
private string DefaultMemberAccessCode(QualifiedSelection selection, DeclarationFinder finder)
6060
{
6161
var defaultMemberAccesses = finder.IdentifierReferences(selection);
62-
var defaultMemberNames = defaultMemberAccesses.Select(reference => reference.Declaration.IdentifierName);
62+
var defaultMemberNames = defaultMemberAccesses
63+
.Select(reference => reference.Declaration.IdentifierName)
64+
.Select(declarationName => IsNotLegalIdentifierName(declarationName)
65+
? $"[{declarationName}]"
66+
: declarationName);
6367
return $".{string.Join("().", defaultMemberNames)}";
6468
}
6569

70+
private bool IsNotLegalIdentifierName(string declarationName)
71+
{
72+
return string.IsNullOrEmpty(declarationName)
73+
|| NonIdentifierCharacters.Any(character => declarationName.Contains(character))
74+
|| AdditionalNonFirstIdentifierCharacters.Contains(declarationName[0]); ;
75+
}
76+
77+
private string NonIdentifierCharacters = "[](){}\r\n\t.,'\"\\ |!@#$%^&*-+:=; ";
78+
private string AdditionalNonFirstIdentifierCharacters = "0123456789_";
79+
6680
public override string Description(IInspectionResult result)
6781
{
6882
return Resources.Inspections.QuickFixes.ExpandBangNotationQuickFix;

Rubberduck.CodeAnalysis/QuickFixes/ExpandDefaultMemberQuickFix.cs

Lines changed: 14 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -54,10 +54,23 @@ private void InsertDefaultMember(ParserRuleContext lExpressionContext, Qualified
5454
private string DefaultMemberAccessCode(QualifiedSelection selection, DeclarationFinder finder)
5555
{
5656
var defaultMemberAccesses = finder.IdentifierReferences(selection).Where(reference => reference.DefaultMemberRecursionDepth > 0);
57-
var defaultMemberNames = defaultMemberAccesses.Select(reference => reference.Declaration.IdentifierName);
57+
var defaultMemberNames = defaultMemberAccesses.Select(reference => reference.Declaration.IdentifierName)
58+
.Select(declarationName => IsNotLegalIdentifierName(declarationName)
59+
? $"[{declarationName}]"
60+
: declarationName);
5861
return $".{string.Join("().", defaultMemberNames)}";
5962
}
6063

64+
private bool IsNotLegalIdentifierName(string declarationName)
65+
{
66+
return string.IsNullOrEmpty(declarationName)
67+
|| NonIdentifierCharacters.Any(character => declarationName.Contains(character))
68+
|| AdditionalNonFirstIdentifierCharacters.Contains(declarationName[0]); ;
69+
}
70+
71+
private string NonIdentifierCharacters = "[](){}\r\n\t.,'\"\\ |!@#$%^&*-+:=; ";
72+
private string AdditionalNonFirstIdentifierCharacters = "0123456789_";
73+
6174
public override string Description(IInspectionResult result)
6275
{
6376
return Resources.Inspections.QuickFixes.ExpandDefaultMemberQuickFix;

RubberduckTests/QuickFixes/ExpandBangNotationQuickFixTests.cs

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -170,6 +170,37 @@ End Function
170170
Assert.AreEqual(expectedModuleCode, actualModuleCode);
171171
}
172172

173+
[Test]
174+
[Category("QuickFixes")]
175+
public void OtherwiseIllegalDeclarationNamesAreEnclosedInBrackets()
176+
{
177+
var moduleCode = @"
178+
Private Sub Foo()
179+
Dim wkb As Excel.Workbook
180+
Dim bar As Variant
181+
bar = wkb.Sheets!MySheet.Range(""A1"").Value
182+
End Sub
183+
";
184+
185+
var expectedModuleCode = @"
186+
Private Sub Foo()
187+
Dim wkb As Excel.Workbook
188+
Dim bar As Variant
189+
bar = wkb.Sheets.[_Default](""MySheet"").Range(""A1"").Value
190+
End Sub
191+
";
192+
193+
var vbe = new MockVbeBuilder()
194+
.ProjectBuilder("TestProject", ProjectProtection.Unprotected)
195+
.AddComponent("Module1", ComponentType.StandardModule, moduleCode)
196+
.AddReference("Excel", MockVbeBuilder.LibraryPathMsExcel, 1, 8, true)
197+
.AddProjectToVbeBuilder()
198+
.Build();
199+
200+
var actualModuleCode = ApplyQuickFixToFirstInspectionResult(vbe.Object, "Module1", state => new UseOfBangNotationInspection(state));
201+
Assert.AreEqual(expectedModuleCode, actualModuleCode);
202+
}
203+
173204
protected override IQuickFix QuickFix(RubberduckParserState state)
174205
{
175206
return new ExpandBangNotationQuickFix(state);

RubberduckTests/QuickFixes/ExpandDefaultMemberQuickFixTests.cs

Lines changed: 31 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -644,6 +644,37 @@ End Sub
644644
Assert.AreEqual(expectedModuleCode, actualModuleCode);
645645
}
646646

647+
[Test]
648+
[Category("QuickFixes")]
649+
public void OtherwiseIllegalDeclarationNamesAreEnclosedInBrackets()
650+
{
651+
var moduleCode = @"
652+
Private Sub Foo()
653+
Dim wkb As Excel.Workbook
654+
Dim bar As Variant
655+
bar = wkb.Sheets(""MySheet"").Range(""A1"").Value
656+
End Sub
657+
";
658+
659+
var expectedModuleCode = @"
660+
Private Sub Foo()
661+
Dim wkb As Excel.Workbook
662+
Dim bar As Variant
663+
bar = wkb.Sheets.[_Default](""MySheet"").Range(""A1"").Value
664+
End Sub
665+
";
666+
667+
var vbe = new MockVbeBuilder()
668+
.ProjectBuilder("TestProject", ProjectProtection.Unprotected)
669+
.AddComponent("Module1", ComponentType.StandardModule, moduleCode)
670+
.AddReference("Excel", MockVbeBuilder.LibraryPathMsExcel, 1, 8, true)
671+
.AddProjectToVbeBuilder()
672+
.Build();
673+
674+
var actualModuleCode = ApplyQuickFixToFirstInspectionResult(vbe.Object, "Module1", state => new IndexedDefaultMemberAccessInspection(state));
675+
Assert.AreEqual(expectedModuleCode, actualModuleCode);
676+
}
677+
647678
protected override IQuickFix QuickFix(RubberduckParserState state)
648679
{
649680
return new ExpandDefaultMemberQuickFix(state);

0 commit comments

Comments
 (0)