File tree Expand file tree Collapse file tree 2 files changed +33
-3
lines changed
Rubberduck.CodeAnalysis/Inspections/Concrete
RubberduckTests/Inspections Expand file tree Collapse file tree 2 files changed +33
-3
lines changed Original file line number Diff line number Diff line change @@ -41,7 +41,7 @@ protected override IEnumerable<IInspectionResult> DoGetInspectionResults()
41
41
42
42
return declarations
43
43
. Where ( d => d . References . Any ( ) && ! excludedDeclarations . Any ( excl => DeclarationReferencesContainsReference ( excl , d ) ) )
44
- . SelectMany ( d => d . References )
44
+ . SelectMany ( d => d . References . Where ( r => ! IsAssignedByRefArgument ( r . ParentScoping , r ) ) )
45
45
. Distinct ( )
46
46
. Where ( r => ! r . IsIgnoringInspectionResultFor ( AnnotationName ) )
47
47
. Where ( r => ! r . Context . TryGetAncestor < VBAParser . RedimStmtContext > ( out _ ) && ! IsArraySubscriptAssignment ( r ) )
@@ -51,6 +51,17 @@ protected override IEnumerable<IInspectionResult> DoGetInspectionResults()
51
51
r ) ) . ToList ( ) ;
52
52
}
53
53
54
+ private bool IsAssignedByRefArgument ( Declaration enclosingProcedure , IdentifierReference reference )
55
+ {
56
+ var argExpression = reference . Context . GetAncestor < VBAParser . ArgumentExpressionContext > ( ) ;
57
+ var parameter = State . DeclarationFinder . FindParameterFromArgument ( argExpression , enclosingProcedure ) ;
58
+
59
+ // note: not recursive, by design.
60
+ return parameter != null
61
+ && ( parameter . IsImplicitByRef || parameter . IsByRef )
62
+ && parameter . References . Any ( r => r . IsAssignment ) ;
63
+ }
64
+
54
65
private static bool IsArraySubscriptAssignment ( IdentifierReference reference )
55
66
{
56
67
var isLetAssignment = reference . Context . TryGetAncestor < VBAParser . LetStmtContext > ( out var letStmt ) ;
Original file line number Diff line number Diff line change @@ -12,9 +12,9 @@ namespace RubberduckTests.Inspections
12
12
[ TestFixture ]
13
13
public class UnassignedVariableUsageInspectionTests
14
14
{
15
- private IEnumerable < IInspectionResult > GetInspectionResults ( string code )
15
+ private IEnumerable < IInspectionResult > GetInspectionResults ( string code , ComponentType componentType = ComponentType . ClassModule )
16
16
{
17
- var vbe = MockVbeBuilder . BuildFromSingleModule ( code , ComponentType . ClassModule , out _ ) ;
17
+ var vbe = MockVbeBuilder . BuildFromSingleModule ( code , componentType , out _ ) ;
18
18
using ( var state = MockParser . CreateAndParse ( vbe . Object ) )
19
19
{
20
20
@@ -132,6 +132,25 @@ End Sub
132
132
Assert . AreEqual ( 0 , results . Count ( ) ) ;
133
133
}
134
134
135
+ [ Test ]
136
+ [ Category ( "Inspections" ) ]
137
+ public void UnassignedVariableUsage_NoResultForAssignedByRefReference ( )
138
+ {
139
+ const string code = @"
140
+ Sub DoSomething()
141
+ Dim foo
142
+ AssignThing foo
143
+ Debug.Print foo
144
+ End Sub
145
+
146
+ Sub AssignThing(ByRef thing As Variant)
147
+ thing = 42
148
+ End Sub
149
+ " ;
150
+ var results = GetInspectionResults ( code , ComponentType . StandardModule ) ;
151
+ Assert . AreEqual ( 0 , results . Count ( ) ) ;
152
+ }
153
+
135
154
[ Test ]
136
155
[ Category ( "Inspections" ) ]
137
156
public void UnassignedVariableUsage_NoResultIfNoReferences ( )
You can’t perform that action at this time.
0 commit comments