Skip to content

Commit 588c4ed

Browse files
committed
Improve handling of transient static sheet references. Closes #4329
1 parent 4d61b8b commit 588c4ed

File tree

2 files changed

+99
-14
lines changed

2 files changed

+99
-14
lines changed

Rubberduck.CodeAnalysis/QuickFixes/AccessSheetUsingCodeNameQuickFix.cs

Lines changed: 18 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -27,7 +27,8 @@ public override void Fix(IInspectionResult result)
2727
var rewriter = _state.GetRewriter(referenceResult.QualifiedName);
2828

2929
var setStatement = referenceResult.Context.GetAncestor<VBAParser.SetStmtContext>();
30-
if (setStatement == null)
30+
var isArgument = referenceResult.Context.GetAncestor<VBAParser.ArgumentContext>() != null;
31+
if (setStatement == null || isArgument)
3132
{
3233
// Sheet accessed inline
3334

@@ -49,20 +50,23 @@ public override void Fix(IInspectionResult result)
4950
return moduleBodyElement != null && moduleBodyElement == referenceResult.Context.GetAncestor<VBAParser.ModuleBodyElementContext>();
5051
});
5152

52-
var variableListContext = (VBAParser.VariableListStmtContext)sheetDeclaration.Context.Parent;
53-
if (variableListContext.variableSubStmt().Length == 1)
53+
if (!sheetDeclaration.IsUndeclared)
5454
{
55-
rewriter.Remove(variableListContext.Parent as ParserRuleContext);
56-
}
57-
else if (sheetDeclaration.Context == variableListContext.variableSubStmt().Last())
58-
{
59-
rewriter.Remove(variableListContext.COMMA().Last());
60-
rewriter.Remove(sheetDeclaration);
61-
}
62-
else
63-
{
64-
rewriter.Remove(variableListContext.COMMA().First(comma => comma.Symbol.StartIndex > sheetDeclaration.Context.Start.StartIndex));
65-
rewriter.Remove(sheetDeclaration);
55+
var variableListContext = (VBAParser.VariableListStmtContext)sheetDeclaration.Context.Parent;
56+
if (variableListContext.variableSubStmt().Length == 1)
57+
{
58+
rewriter.Remove(variableListContext.Parent as ParserRuleContext);
59+
}
60+
else if (sheetDeclaration.Context == variableListContext.variableSubStmt().Last())
61+
{
62+
rewriter.Remove(variableListContext.COMMA().Last());
63+
rewriter.Remove(sheetDeclaration);
64+
}
65+
else
66+
{
67+
rewriter.Remove(variableListContext.COMMA().First(comma => comma.Symbol.StartIndex > sheetDeclaration.Context.Start.StartIndex));
68+
rewriter.Remove(sheetDeclaration);
69+
}
6670
}
6771

6872
foreach (var reference in sheetDeclaration.References)

RubberduckTests/QuickFixes/AccessSheetUsingCodeNameQuickFixTests.cs

Lines changed: 81 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -276,6 +276,87 @@ Dim ws As Worksheet
276276
}
277277
}
278278

279+
[Test]
280+
[Category("QuickFixes")]
281+
public void SheetAccessedUsingString_QuickFixWorks_TransientReferenceSetStatement()
282+
{
283+
const string inputCode = @"
284+
Sub Test()
285+
Dim ws As Worksheet
286+
Set ws = Worksheets.Add(Worksheets(""Sheet1""))
287+
Debug.Print ws.Name
288+
End Sub";
289+
290+
const string expectedCode = @"
291+
Sub Test()
292+
Dim ws As Worksheet
293+
Set ws = Worksheets.Add(Sheet1)
294+
Debug.Print ws.Name
295+
End Sub";
296+
297+
using (var state = ArrangeParserAndParse(inputCode, out var component))
298+
{
299+
var inspection = new SheetAccessedUsingStringInspection(state);
300+
var inspectionResults = inspection.GetInspectionResults(CancellationToken.None);
301+
302+
new AccessSheetUsingCodeNameQuickFix(state).Fix(inspectionResults.First());
303+
Assert.AreEqual(expectedCode, state.GetRewriter(component).GetText());
304+
}
305+
}
306+
307+
[Test]
308+
[Category("QuickFixes")]
309+
public void SheetAccessedUsingString_QuickFixWorks_TransientReferenceNoSetStatement()
310+
{
311+
const string inputCode = @"
312+
Sub Test()
313+
If Not Worksheets.Add(Worksheets(""Sheet1"")) Is Nothing Then
314+
Debug.Print ""Added""
315+
End If
316+
End Sub";
317+
318+
const string expectedCode = @"
319+
Sub Test()
320+
If Not Worksheets.Add(Sheet1) Is Nothing Then
321+
Debug.Print ""Added""
322+
End If
323+
End Sub";
324+
325+
using (var state = ArrangeParserAndParse(inputCode, out var component))
326+
{
327+
var inspection = new SheetAccessedUsingStringInspection(state);
328+
var inspectionResults = inspection.GetInspectionResults(CancellationToken.None);
329+
330+
new AccessSheetUsingCodeNameQuickFix(state).Fix(inspectionResults.First());
331+
Assert.AreEqual(expectedCode, state.GetRewriter(component).GetText());
332+
}
333+
}
334+
335+
[Test]
336+
[Category("QuickFixes")]
337+
public void SheetAccessedUsingString_QuickFixWorks_ImplicitVariableAssignment()
338+
{
339+
const string inputCode = @"
340+
Sub Test()
341+
Set ws = Worksheets(""Sheet1"")
342+
Debug.Print ws.Name
343+
End Sub";
344+
345+
const string expectedCode = @"
346+
Sub Test()
347+
Sheet1.Name
348+
End Sub";
349+
350+
using (var state = ArrangeParserAndParse(inputCode, out var component))
351+
{
352+
var inspection = new SheetAccessedUsingStringInspection(state);
353+
var inspectionResults = inspection.GetInspectionResults(CancellationToken.None);
354+
355+
new AccessSheetUsingCodeNameQuickFix(state).Fix(inspectionResults.First());
356+
Assert.AreEqual(expectedCode, state.GetRewriter(component).GetText());
357+
}
358+
}
359+
279360
private static RubberduckParserState ArrangeParserAndParse(string inputCode, out IVBComponent component)
280361
{
281362
var builder = new MockVbeBuilder();

0 commit comments

Comments
 (0)