@@ -21,20 +21,22 @@ public UnassignedVariableUsageInspection(RubberduckParserState state)
21
21
protected override IEnumerable < IInspectionResult > DoGetInspectionResults ( )
22
22
{
23
23
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 )
27
27
&& ! declaration . IsSelfAssigned
28
- && ! declaration . References . Any ( reference => reference . IsAssignment && ! IsIgnoringInspectionResultFor ( reference , AnnotationName ) ) ) ;
28
+ && ! declaration . References . Any ( reference => reference . IsAssignment ) ) ;
29
29
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.
31
32
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 " ) ) ;
33
34
34
35
return declarations . Where ( d => d . References . Any ( ) &&
35
36
! DeclarationReferencesContainsReference ( lenFunction , d ) &&
36
37
! DeclarationReferencesContainsReference ( lenbFunction , d ) )
37
38
. SelectMany ( d => d . References )
39
+ . Where ( r => ! r . IsIgnoringInspectionResultFor ( AnnotationName ) )
38
40
. Select ( r => new IdentifierReferenceInspectionResult ( this ,
39
41
string . Format ( InspectionResults . UnassignedVariableUsageInspection , r . IdentifierName ) ,
40
42
State ,
0 commit comments