Skip to content

Commit 85e3cfe

Browse files
committed
Modify to support jumps to labels or linenumbers
1 parent c491534 commit 85e3cfe

File tree

2 files changed

+56
-19
lines changed

2 files changed

+56
-19
lines changed

Rubberduck.CodeAnalysis/Inspections/Concrete/AssignmentNotUsedInspection.cs

Lines changed: 31 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
using System.Collections.Generic;
22
using System.Linq;
3+
using Antlr4.Runtime;
34
using Rubberduck.CodeAnalysis.Inspections.Abstract;
45
using Rubberduck.CodeAnalysis.Inspections.Extensions;
56
using Rubberduck.Inspections.CodePathAnalysis;
@@ -112,35 +113,47 @@ private static bool IsAssignmentOfNothing(IdentifierReference reference)
112113

113114
private static bool DisqualifiedByResumeOrGoToStatements(IdentifierReference resultCandidate, DeclarationFinder finder)
114115
{
115-
var relevantLabels = finder.DeclarationsWithType(DeclarationType.LineLabel)
116-
.Where(label => resultCandidate.ParentScoping.Equals(label.ParentDeclaration));
116+
var jumpCtxts = (resultCandidate.ParentScoping.Context.GetDescendents<VBAParser.ResumeStmtContext>().Cast<ParserRuleContext>())
117+
.Concat(resultCandidate.ParentScoping.Context.GetDescendents<VBAParser.GoToStmtContext>().Cast<ParserRuleContext>());
117118

118-
if (!relevantLabels.Any())
119-
{
120-
return false;
121-
}
119+
if (!jumpCtxts.Any()) { return false; }
122120

123-
var lineNumbersForNonAssignmentReferencesOfResultCandidateDeclaration =
121+
var lineNumbersForNonAssignmentReferences =
124122
resultCandidate.Declaration.References
125123
.Where(rf => !rf.IsAssignment)
126124
.Select(rf => rf.Context.Stop.Line);
127125

128-
if (!lineNumbersForNonAssignmentReferencesOfResultCandidateDeclaration.Any())
126+
if (!lineNumbersForNonAssignmentReferences.Any()) { return false; }
127+
128+
//The jumped-to-line is after the resultCandidate and before a use of the variable
129+
return AllJumpToLines(resultCandidate, jumpCtxts, finder)
130+
.Any(jumpToLine => resultCandidate.Context.Start.Line > jumpToLine
131+
&& lineNumbersForNonAssignmentReferences.Max() >= jumpToLine);
132+
}
133+
134+
private static IEnumerable<int> AllJumpToLines(IdentifierReference resultCandidate, IEnumerable<ParserRuleContext> jumpCtxts, DeclarationFinder finder)
135+
{
136+
var jumpToLineNumbers = new List<int>();
137+
var jumpToLabels = new List<string>();
138+
foreach (var ctxt in jumpCtxts)
129139
{
130-
return false;
140+
var target = ctxt.children[2].GetText();
141+
if (int.TryParse(target, out var line))
142+
{
143+
jumpToLineNumbers.Add(line);
144+
}
145+
jumpToLabels.Add(target);
131146
}
132147

133-
var labelReferencesAffectingExecutionPath = relevantLabels.SelectMany(d => d.References)
134-
.Where(labelReference => LabelReferencedByJumpStatementAfterResultCandidateAssignment(labelReference, resultCandidate));
148+
var relevantLabelLineNumbers = finder.DeclarationsWithType(DeclarationType.LineLabel)
149+
.Where(label => resultCandidate.ParentScoping.Equals(label.ParentDeclaration)
150+
&& jumpToLabels.Contains(label.IdentifierName))
151+
.Select(d => d.Context.Start.Line);
135152

136-
return labelReferencesAffectingExecutionPath.Any(labelReference => labelReference.Declaration.Context.Stop.Line < resultCandidate.Context.Start.Line
137-
&& labelReference.Declaration.Context.Start.Line < lineNumbersForNonAssignmentReferencesOfResultCandidateDeclaration.Max());
138-
}
153+
jumpToLineNumbers.AddRange(relevantLabelLineNumbers);
139154

140-
private static bool LabelReferencedByJumpStatementAfterResultCandidateAssignment(IdentifierReference labelReference, IdentifierReference resultCandidate)
141-
=> labelReference.Context.Start.Line > resultCandidate.Context.Stop.Line
142-
&& (labelReference.Context.TryGetAncestor<VBAParser.ResumeStmtContext>(out _)
143-
|| labelReference.Context.TryGetAncestor<VBAParser.GoToStmtContext>(out _));
155+
return jumpToLineNumbers;
156+
}
144157

145158
protected override string ResultDescription(IdentifierReference reference)
146159
{

RubberduckTests/Inspections/AssignmentNotUsedInspectionTests.cs

Lines changed: 25 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -262,7 +262,7 @@ Dim foo As Long
262262
//https://github.com/rubberduck-vba/Rubberduck/issues/5456
263263
[TestCase("Resume CleanExit")]
264264
[TestCase("GoTo CleanExit")]
265-
public void IgnoresAssignmentWhereExecutionPathModifiedByJumpStatementCouldIncludeUse(string statement)
265+
public void IgnoresAssignmentWhereExecutionPathModifiedByJumpStatementCouldIncludeUse_UseLabels(string statement)
266266
{
267267
string code =
268268
$@"
@@ -283,6 +283,30 @@ End Function
283283
Assert.AreEqual(1, results.Count());
284284
}
285285

286+
//Inverse = ratio => line 7
287+
[TestCase("Resume 7")]
288+
[TestCase("GoTo 7")]
289+
public void IgnoresAssignmentWhereExecutionPathModifiedByJumpStatementCouldIncludeUse_UseLineNumbers(string statement)
290+
{
291+
string code =
292+
$@"
293+
Public Function Inverse(value As Double) As Double
294+
Dim ratio As Double
295+
ratio = 0# 'assigment not used - flagged
296+
On Error Goto ErrorHandler
297+
ratio = 1# / value
298+
Inverse = ratio
299+
Exit Function
300+
301+
ErrorHandler:
302+
ratio = -1# 'assigment not used evaluation disqualified by Resume/GoTo - not flagged
303+
{statement}
304+
End Function
305+
";
306+
var results = InspectionResultsForStandardModule(code);
307+
Assert.AreEqual(1, results.Count());
308+
}
309+
286310
[TestCase("Resume IgnoreRatio")]
287311
[TestCase("GoTo IgnoreRatio")]
288312
public void FlagsAssignmentWhereExecutionPathModifiedByJumpStatementCouldNotIncludeUse(string statement)

0 commit comments

Comments
 (0)