Skip to content

Commit fa57ae7

Browse files
committed
Redesign ParameterNotUsedInspection
For interfaces, it now only reports parameters of the interface member and not of individual implementations. Moreover, it does it only if there are implementations and none uses the parameter. The same behaviour now also applies to user events and event handlers. (Parameters ofevent handlers of built-in events are never reported.) In addition, ClassModuleDeclaration.IsInterface has been enhanced to also retun true is there is an @interface annotation on the class.
1 parent 47f3d58 commit fa57ae7

File tree

5 files changed

+256
-36
lines changed

5 files changed

+256
-36
lines changed
Lines changed: 101 additions & 27 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,11 @@
1-
using System.Collections.Generic;
1+
using System.Diagnostics;
22
using System.Linq;
33
using Rubberduck.Common;
44
using Rubberduck.Inspections.Abstract;
5-
using Rubberduck.Inspections.Results;
6-
using Rubberduck.Parsing.Inspections.Abstract;
75
using Rubberduck.Resources.Inspections;
86
using Rubberduck.Parsing.Symbols;
97
using Rubberduck.Parsing.VBA;
8+
using Rubberduck.Parsing.VBA.DeclarationCaching;
109

1110
namespace Rubberduck.Inspections.Concrete
1211
{
@@ -37,34 +36,109 @@ namespace Rubberduck.Inspections.Concrete
3736
/// End Sub
3837
/// ]]>
3938
/// </example>
40-
public sealed class ParameterNotUsedInspection : InspectionBase
39+
public sealed class ParameterNotUsedInspection : DeclarationInspectionBase
4140
{
4241
public ParameterNotUsedInspection(RubberduckParserState state)
43-
: base(state) { }
42+
: base(state, DeclarationType.Parameter)
43+
{}
4444

45-
protected override IEnumerable<IInspectionResult> DoGetInspectionResults()
45+
protected override bool IsResultDeclaration(Declaration declaration, DeclarationFinder finder)
4646
{
47-
var interfaceMembers = State.DeclarationFinder.FindAllInterfaceMembers();
48-
var interfaceImplementationMembers = State.DeclarationFinder.FindAllInterfaceImplementingMembers();
49-
50-
var handlers = State.DeclarationFinder.FindEventHandlers();
51-
52-
var parameters = State.DeclarationFinder
53-
.UserDeclarations(DeclarationType.Parameter)
54-
.OfType<ParameterDeclaration>()
55-
.Where(parameter => !parameter.References.Any()
56-
&& parameter.ParentDeclaration.DeclarationType != DeclarationType.Event
57-
&& parameter.ParentDeclaration.DeclarationType != DeclarationType.LibraryFunction
58-
&& parameter.ParentDeclaration.DeclarationType != DeclarationType.LibraryProcedure
59-
&& !interfaceMembers.Contains(parameter.ParentDeclaration)
60-
&& !handlers.Contains(parameter.ParentDeclaration))
61-
.ToList();
62-
63-
var issues = from issue in parameters
64-
let isInterfaceImplementationMember = interfaceImplementationMembers.Contains(issue.ParentDeclaration)
65-
select new DeclarationInspectionResult(this, string.Format(InspectionResults.ParameterNotUsedInspection, issue.IdentifierName).Capitalize(), issue);
66-
67-
return issues;
47+
if (declaration.References.Any()
48+
|| !(declaration is ParameterDeclaration parameter))
49+
{
50+
return false;
51+
}
52+
53+
var enclosingMember = parameter.ParentDeclaration;
54+
if (IsLibraryMethod(enclosingMember))
55+
{
56+
return false;
57+
}
58+
59+
if (enclosingMember is EventDeclaration eventDeclaration)
60+
{
61+
return ThereAreHandlersAndNoneUsesTheParameter(parameter, eventDeclaration, finder);
62+
}
63+
64+
if (enclosingMember is ModuleBodyElementDeclaration member)
65+
{
66+
if (member.IsInterfaceMember)
67+
{
68+
return ThereAreImplementationsAndNoneUsesTheParameter(parameter, member, finder);
69+
}
70+
71+
if (member.IsInterfaceImplementation
72+
|| finder.FindEventHandlers().Contains(member))
73+
{
74+
return false;
75+
}
76+
}
77+
78+
return true;
79+
}
80+
81+
private static bool IsLibraryMethod(Declaration declaration)
82+
{
83+
return declaration.DeclarationType == DeclarationType.LibraryProcedure
84+
|| declaration.DeclarationType == DeclarationType.LibraryFunction;
85+
}
86+
87+
private static bool ThereAreImplementationsAndNoneUsesTheParameter(ParameterDeclaration parameter, ModuleBodyElementDeclaration interfaceMember, DeclarationFinder finder)
88+
{
89+
if (!TryFindParameterIndex(parameter, interfaceMember, out var parameterIndex))
90+
{
91+
//This really should never happen.
92+
Debug.Fail($"Could not find index for parameter {parameter.IdentifierName} in interface member {interfaceMember.IdentifierName}.");
93+
return false;
94+
}
95+
96+
var implementations = finder.FindInterfaceImplementationMembers(interfaceMember).ToList();
97+
98+
//We do not want to report all parameters of not implemented interfaces.
99+
return implementations.Any()
100+
&& implementations.All(implementation => ParameterAtIndexIsNotUsed(implementation, parameterIndex));
101+
}
102+
103+
private static bool TryFindParameterIndex(ParameterDeclaration parameter, IParameterizedDeclaration enclosingMember, out int parameterIndex)
104+
{
105+
parameterIndex = enclosingMember.Parameters
106+
.ToList()
107+
.IndexOf(parameter);
108+
return parameterIndex != -1;
109+
}
110+
111+
private static bool ParameterAtIndexIsNotUsed(IParameterizedDeclaration declaration, int parameterIndex)
112+
{
113+
var parameter = declaration.Parameters.ElementAtOrDefault(parameterIndex);
114+
return parameter != null
115+
&& !parameter.References.Any();
116+
}
117+
118+
private static bool ThereAreHandlersAndNoneUsesTheParameter(ParameterDeclaration parameter, EventDeclaration eventDeclaration, DeclarationFinder finder)
119+
{
120+
if (!TryFindParameterIndex(parameter, eventDeclaration, out var parameterIndex))
121+
{
122+
//This really should never happen.
123+
Debug.Fail($"Could not find index for parameter {parameter.IdentifierName} in event {eventDeclaration.IdentifierName}.");
124+
return false;
125+
}
126+
127+
if (!eventDeclaration.IsUserDefined)
128+
{
129+
return false;
130+
}
131+
132+
var handlers = finder.FindEventHandlers(eventDeclaration).ToList();
133+
134+
//We do not want to report all parameters of not handled events.
135+
return handlers.Any()
136+
&& handlers.All(handler => ParameterAtIndexIsNotUsed(handler, parameterIndex));
137+
}
138+
139+
protected override string ResultDescription(Declaration declaration)
140+
{
141+
return string.Format(InspectionResults.ParameterNotUsedInspection, declaration.IdentifierName).Capitalize();
68142
}
69143
}
70144
}

Rubberduck.Parsing/Annotations/Concrete/InterfaceAnnotation.cs

Lines changed: 1 addition & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,4 @@
1-
using System.Collections.Generic;
2-
using Rubberduck.Parsing.Grammar;
3-
using Rubberduck.VBEditor;
4-
5-
namespace Rubberduck.Parsing.Annotations
1+
namespace Rubberduck.Parsing.Annotations
62
{
73
/// <summary>
84
/// Used to mark a class module as an interface, so that Rubberduck treats it as such even if it's not implemented in any opened project.

Rubberduck.Parsing/Symbols/ClassModuleDeclaration.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -188,7 +188,7 @@ private bool HasPredeclaredIdToCache()
188188

189189
public IEnumerable<Declaration> Subtypes => _subtypes.Keys;
190190

191-
public bool IsInterface => _subtypes.Count > 0;
191+
public bool IsInterface => _subtypes.Count > 0 || Annotations.Any(pta => pta.Annotation is InterfaceAnnotation);
192192

193193
public bool IsUserInterface => Subtypes.Any(s => s.IsUserDefined);
194194

Rubberduck.Parsing/Symbols/IInterfaceExposable.cs

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,10 @@ internal static bool IsInterfaceMember(this IInterfaceExposable member) =>
3939
/// <param name="member">The member to find the InterfaceDeclaration of.</param>
4040
/// <returns>Tthe Declaration of the interface that this is a member of, or null if IsInterfaceMember is false.</returns>
4141
internal static ClassModuleDeclaration InterfaceDeclaration(this IInterfaceExposable member) =>
42-
member.ParentDeclaration is ClassModuleDeclaration parent && parent.IsInterface ? parent : null;
42+
member.ParentDeclaration is ClassModuleDeclaration parent
43+
&& parent.IsInterface
44+
? parent
45+
: null;
4346

4447
/// <summary>
4548
/// Provides a default implementation of IInterfaceExposable.ImplementingIdentifierName

RubberduckTests/Inspections/ParameterNotUsedInspectionTests.cs

Lines changed: 149 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -80,9 +80,8 @@ Debug.Print rst(""Field"")
8080

8181
[Test]
8282
[Category("Inspections")]
83-
public void ParameterNotUsed_ReturnsResult_InterfaceImplementation()
83+
public void ParameterNotUsed_InterfaceWithImplementation_ReturnsResultForInterface()
8484
{
85-
//Input
8685
const string inputCode1 =
8786
@"Public Sub DoSomething(ByVal a As Integer)
8887
End Sub";
@@ -96,11 +95,159 @@ Private Sub IClass1_DoSomething(ByVal a As Integer)
9695
{
9796
("IClass1", inputCode1, ComponentType.ClassModule),
9897
("Class1", inputCode2, ComponentType.ClassModule),
98+
("Class2", inputCode2, ComponentType.ClassModule),
9999
};
100100

101101
Assert.AreEqual(1, InspectionResultsForModules(modules).Count());
102102
}
103103

104+
[Test]
105+
[Category("Inspections")]
106+
public void ParameterNotUsed_InterfaceWithImplementation_SomeUseParameter_DoesNotReturnResult()
107+
{
108+
const string inputCode1 =
109+
@"Public Sub DoSomething(ByVal a As Integer)
110+
End Sub";
111+
const string inputCode2 =
112+
@"Implements IClass1
113+
114+
Private Sub IClass1_DoSomething(ByVal a As Integer)
115+
End Sub";
116+
const string inputCode3 =
117+
@"Implements IClass1
118+
119+
Private Sub IClass1_DoSomething(ByVal a As Integer)
120+
Dim bar As Variant
121+
bar = a
122+
End Sub
123+
";
124+
125+
var modules = new (string, string, ComponentType)[]
126+
{
127+
("IClass1", inputCode1, ComponentType.ClassModule),
128+
("Class1", inputCode2, ComponentType.ClassModule),
129+
("Class2", inputCode3, ComponentType.ClassModule),
130+
};
131+
132+
Assert.AreEqual(0, InspectionResultsForModules(modules).Count());
133+
}
134+
135+
[Test]
136+
[Category("Inspections")]
137+
public void ParameterNotUsed_InterfaceWithoutImplementation_DoesNotReturnResult()
138+
{
139+
const string inputCode1 =
140+
@"'@Interface
141+
Public Sub DoSomething(ByVal a As Integer)
142+
End Sub";
143+
144+
var modules = new (string, string, ComponentType)[]
145+
{
146+
("IClass1", inputCode1, ComponentType.ClassModule)
147+
};
148+
149+
Assert.AreEqual(0, InspectionResultsForModules(modules).Count());
150+
}
151+
152+
[Test]
153+
[Category("Inspections")]
154+
public void ParameterNotUsed_EventMemberWithHandlers_ResultForEventOnly()
155+
{
156+
const string inputCode1 =
157+
@"Public Event Foo(ByRef arg1 As Integer)";
158+
159+
const string inputCode2 =
160+
@"Private WithEvents abc As Class1
161+
162+
Private Sub abc_Foo(ByRef arg1 As Integer)
163+
End Sub";
164+
165+
var modules = new (string, string, ComponentType)[]
166+
{
167+
("Class1", inputCode1, ComponentType.ClassModule),
168+
("Class2", inputCode2, ComponentType.ClassModule),
169+
("Class3", inputCode2, ComponentType.ClassModule),
170+
};
171+
172+
Assert.AreEqual(1, InspectionResultsForModules(modules).Count());
173+
}
174+
175+
[Test]
176+
[Category("Inspections")]
177+
public void ParameterNotUsed_EventMemberWithHandlers_SomeUseParameter_DoesNotReturnResult()
178+
{
179+
const string inputCode1 =
180+
@"Public Event Foo(ByRef arg1 As Integer)";
181+
182+
const string inputCode2 =
183+
@"Private WithEvents abc As Class1
184+
185+
Private Sub abc_Foo(ByRef arg1 As Integer)
186+
End Sub";
187+
188+
const string inputCode3 =
189+
@"Private WithEvents abc As Class1
190+
191+
Private Sub abc_Foo(ByRef arg1 As Integer)
192+
Dim bar As Variant
193+
bar = arg1
194+
End Sub";
195+
196+
var modules = new (string, string, ComponentType)[]
197+
{
198+
("Class1", inputCode1, ComponentType.ClassModule),
199+
("Class2", inputCode2, ComponentType.ClassModule),
200+
("Class3", inputCode3, ComponentType.ClassModule),
201+
};
202+
203+
Assert.AreEqual(0, InspectionResultsForModules(modules).Count());
204+
}
205+
206+
[Test]
207+
[Category("Inspections")]
208+
public void ParameterNotUsed_EventMemberWithoutHandlers_DoesNotReturnResult()
209+
{
210+
const string inputCode1 =
211+
@"Public Event Foo(ByRef arg1 As Integer)";
212+
213+
var modules = new (string, string, ComponentType)[]
214+
{
215+
("Class1", inputCode1, ComponentType.ClassModule)
216+
};
217+
218+
Assert.AreEqual(0, InspectionResultsForModules(modules).Count());
219+
}
220+
221+
[Test]
222+
[Category("Inspections")]
223+
public void ParameterNotUsed_LibraryFunction_DoesNotReturnResult()
224+
{
225+
const string inputCode1 =
226+
@"Public Declare Function MyLibFunction Lib ""MyLib"" (arg1 As Integer) As Integer";
227+
228+
var modules = new (string, string, ComponentType)[]
229+
{
230+
("Class1", inputCode1, ComponentType.ClassModule)
231+
};
232+
233+
Assert.AreEqual(0, InspectionResultsForModules(modules).Count());
234+
}
235+
236+
[Test]
237+
[Category("Inspections")]
238+
public void ParameterNotUsed_LibraryProcedure_DoesNotReturnResult()
239+
{
240+
const string inputCode1 =
241+
@"Public Declare Sub MyLibProcedure Lib ""MyLib"" (arg1 As Integer)";
242+
243+
var modules = new (string, string, ComponentType)[]
244+
{
245+
("Class1", inputCode1, ComponentType.ClassModule)
246+
};
247+
248+
Assert.AreEqual(0, InspectionResultsForModules(modules).Count());
249+
}
250+
104251
[Test]
105252
[Category("Inspections")]
106253
public void ParameterNotUsed_Ignored_DoesNotReturnResult()

0 commit comments

Comments
 (0)