Skip to content

Commit 3a5e485

Browse files
committed
Test for ignored inspection based on where the QF puts the annotation. Closes #4364
1 parent 90c5c51 commit 3a5e485

File tree

2 files changed

+10
-8
lines changed

2 files changed

+10
-8
lines changed

Rubberduck.CodeAnalysis/Inspections/Concrete/UnassignedVariableUsageInspection.cs

Lines changed: 8 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -21,20 +21,22 @@ public UnassignedVariableUsageInspection(RubberduckParserState state)
2121
protected override IEnumerable<IInspectionResult> DoGetInspectionResults()
2222
{
2323
var declarations = State.DeclarationFinder.UserDeclarations(DeclarationType.Variable)
24-
.Where(result => !IsIgnoringInspectionResultFor(result, AnnotationName))
25-
.Where(declaration =>
26-
State.DeclarationFinder.MatchName(declaration.AsTypeName).All(d => d.DeclarationType != DeclarationType.UserDefinedType)
24+
.Where(declaration =>
25+
State.DeclarationFinder.MatchName(declaration.AsTypeName)
26+
.All(d => d.DeclarationType != DeclarationType.UserDefinedType)
2727
&& !declaration.IsSelfAssigned
28-
&& !declaration.References.Any(reference => reference.IsAssignment && !IsIgnoringInspectionResultFor(reference, AnnotationName)));
28+
&& !declaration.References.Any(reference => reference.IsAssignment));
2929

30-
//The parameter scoping was apparently incorrect before - need to filter for the actual function.
30+
//See https://github.com/rubberduck-vba/Rubberduck/issues/2010 for why these are being excluded.
31+
//TODO: These need to be modified to correctly work in VB6.
3132
var lenFunction = BuiltInDeclarations.SingleOrDefault(s => s.DeclarationType == DeclarationType.Function && s.Scope.Equals("VBE7.DLL;VBA.Strings.Len"));
32-
var lenbFunction = BuiltInDeclarations.SingleOrDefault(s => s.DeclarationType == DeclarationType.Function && s.Scope.Equals("VBE7.DLL;VBA.Strings.Len"));
33+
var lenbFunction = BuiltInDeclarations.SingleOrDefault(s => s.DeclarationType == DeclarationType.Function && s.Scope.Equals("VBE7.DLL;VBA.Strings.LenB"));
3334

3435
return declarations.Where(d => d.References.Any() &&
3536
!DeclarationReferencesContainsReference(lenFunction, d) &&
3637
!DeclarationReferencesContainsReference(lenbFunction, d))
3738
.SelectMany(d => d.References)
39+
.Where(r => !r.IsIgnoringInspectionResultFor(AnnotationName))
3840
.Select(r => new IdentifierReferenceInspectionResult(this,
3941
string.Format(InspectionResults.UnassignedVariableUsageInspection, r.IdentifierName),
4042
State,

RubberduckTests/Inspections/UnassignedVariableUsageInspectionTests.cs

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -93,11 +93,11 @@ Dim bb As Boolean
9393
public void UnassignedVariableUsage_Ignored_DoesNotReturnResult()
9494
{
9595
const string inputCode =
96-
@"Sub Foo()
97-
'@Ignore UnassignedVariableUsage
96+
@"Sub Foo()
9897
Dim b As Boolean
9998
Dim bb As Boolean
10099
100+
'@Ignore UnassignedVariableUsage
101101
bb = b
102102
End Sub";
103103

0 commit comments

Comments
 (0)