Skip to content

Commit d2ba220

Browse files
committed
collect form control handlers in DeclarationFinder; fixes #2622.
1 parent dd3e69d commit d2ba220

7 files changed

+27
-14
lines changed

RetailCoder.VBE/Inspections/ImplicitByRefParameterInspection.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ public ImplicitByRefParameterInspection(RubberduckParserState state)
2323
public override IEnumerable<InspectionResultBase> GetInspectionResults()
2424
{
2525
var interfaceMembers = UserDeclarations.FindInterfaceImplementationMembers();
26-
var builtinEventHandlers = State.DeclarationFinder.FindBuiltinEventHandlers();
26+
var builtinEventHandlers = State.DeclarationFinder.FindEventHandlers();
2727

2828
var issues = State.DeclarationFinder
2929
.UserDeclarations(DeclarationType.Parameter)

RetailCoder.VBE/Inspections/ParameterCanBeByValInspection.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -33,7 +33,7 @@ public override IEnumerable<InspectionResultBase> GetInspectionResults()
3333

3434
var eventMembers = declarations.Where(item => !item.IsBuiltIn && item.DeclarationType == DeclarationType.Event).ToList();
3535
var formEventHandlerScopes = State.FindFormEventHandlers().Select(handler => handler.Scope);
36-
var eventHandlerScopes = State.DeclarationFinder.FindBuiltinEventHandlers().Concat(declarations.FindUserEventHandlers()).Select(e => e.Scope);
36+
var eventHandlerScopes = State.DeclarationFinder.FindEventHandlers().Concat(declarations.FindUserEventHandlers()).Select(e => e.Scope);
3737
var eventScopes = eventMembers.Select(s => s.Scope)
3838
.Concat(formEventHandlerScopes)
3939
.Concat(eventHandlerScopes);

RetailCoder.VBE/Inspections/ParameterNotUsedInspection.cs

Lines changed: 2 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,5 @@
11
using System.Collections.Generic;
22
using System.Linq;
3-
using Rubberduck.Common;
43
using Rubberduck.Inspections.Abstract;
54
using Rubberduck.Inspections.Resources;
65
using Rubberduck.Inspections.Results;
@@ -29,7 +28,7 @@ public override IEnumerable<InspectionResultBase> GetInspectionResults()
2928
var interfaceMembers = State.DeclarationFinder.FindAllInterfaceMembers();
3029
var interfaceImplementationMembers = State.DeclarationFinder.FindAllInterfaceImplementingMembers();
3130

32-
var builtInHandlers = State.DeclarationFinder.FindBuiltinEventHandlers();
31+
var handlers = State.DeclarationFinder.FindEventHandlers();
3332

3433
var parameters = State.DeclarationFinder
3534
.UserDeclarations(DeclarationType.Parameter)
@@ -39,7 +38,7 @@ public override IEnumerable<InspectionResultBase> GetInspectionResults()
3938
&& parameter.ParentDeclaration.DeclarationType != DeclarationType.LibraryFunction
4039
&& parameter.ParentDeclaration.DeclarationType != DeclarationType.LibraryProcedure
4140
&& !interfaceMembers.Contains(parameter.ParentDeclaration)
42-
&& !builtInHandlers.Contains(parameter.ParentDeclaration))
41+
&& !handlers.Contains(parameter.ParentDeclaration))
4342
.ToList();
4443

4544
var issues = from issue in parameters

RetailCoder.VBE/Inspections/ProcedureCanBeWrittenAsFunctionInspection.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -43,7 +43,7 @@ public override IEnumerable<InspectionResultBase> GetInspectionResults()
4343
}
4444

4545
var userDeclarations = UserDeclarations.ToList();
46-
var builtinHandlers = State.DeclarationFinder.FindBuiltinEventHandlers().ToList();
46+
var builtinHandlers = State.DeclarationFinder.FindEventHandlers().ToList();
4747

4848
var contextLookup = userDeclarations.Where(decl => decl.Context != null).ToDictionary(decl => decl.Context);
4949

RetailCoder.VBE/Inspections/ProcedureNotUsedInspection.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -41,7 +41,7 @@ public override IEnumerable<InspectionResultBase> GetInspectionResults()
4141
var handlers = State.DeclarationFinder.UserDeclarations(DeclarationType.Control)
4242
.SelectMany(control => declarations.FindEventHandlers(control)).ToList();
4343

44-
var builtInHandlers = State.DeclarationFinder.FindBuiltinEventHandlers();
44+
var builtInHandlers = State.DeclarationFinder.FindEventHandlers();
4545
handlers.AddRange(builtInHandlers);
4646

4747
var withEventFields = State.DeclarationFinder.UserDeclarations(DeclarationType.Variable).Where(item => item.IsWithEvents).ToList();

RetailCoder.VBE/Inspections/UseMeaningfulNameInspection.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,7 @@ public override IEnumerable<InspectionResultBase> GetInspectionResults()
4242
var settings = _settings.Load(new CodeInspectionSettings()) ?? new CodeInspectionSettings();
4343
var whitelistedNames = settings.WhitelistedIdentifiers.Select(s => s.Identifier).ToArray();
4444

45-
var handlers = State.DeclarationFinder.FindBuiltinEventHandlers();
45+
var handlers = State.DeclarationFinder.FindEventHandlers();
4646

4747
var issues = UserDeclarations
4848
.Where(declaration => !string.IsNullOrEmpty(declaration.IdentifierName) &&

Rubberduck.Parsing/Symbols/DeclarationFinder.cs

Lines changed: 20 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -64,7 +64,7 @@ public DeclarationFinder(IReadOnlyList<Declaration> declarations, IEnumerable<IA
6464
_parametersByParent = declarations.Where(declaration => declaration.DeclarationType == DeclarationType.Parameter)
6565
.GroupBy(declaration => declaration.ParentDeclaration).ToConcurrentDictionary();
6666
_userDeclarationsByType = declarations.Where(declaration => !declaration.IsBuiltIn).GroupBy(declaration => declaration.DeclarationType).ToConcurrentDictionary();
67-
_builtinEvents = new Lazy<ConcurrentBag<Declaration>>(() => FindBuiltInEventHandlers(declarations), true);
67+
_eventHandlers = new Lazy<ConcurrentBag<Declaration>>(() => FindEventHandlers(declarations), true);
6868

6969
_projects = _projects = new Lazy<ConcurrentBag<Declaration>>(() => new ConcurrentBag<Declaration>(declarations.Where(d => d.DeclarationType == DeclarationType.Project)), true);
7070
_classes = new Lazy<ConcurrentBag<Declaration>>(() => new ConcurrentBag<Declaration>(declarations.Where(d => d.DeclarationType == DeclarationType.ClassModule)), true);
@@ -165,12 +165,12 @@ public IEnumerable<Declaration> FindDeclarationsWithNonBaseAsType()
165165
}
166166
}
167167

168-
private readonly Lazy<ConcurrentBag<Declaration>> _builtinEvents;
169-
public IEnumerable<Declaration> FindBuiltinEventHandlers()
168+
private readonly Lazy<ConcurrentBag<Declaration>> _eventHandlers;
169+
public IEnumerable<Declaration> FindEventHandlers()
170170
{
171171
lock (ThreadLock)
172172
{
173-
return _builtinEvents.Value;
173+
return _eventHandlers.Value;
174174
}
175175
}
176176

@@ -695,7 +695,19 @@ private IEnumerable<Declaration> FindAllInReferencedProjectByPriority(Declaratio
695695
}
696696
}
697697

698-
public ConcurrentBag<Declaration> FindBuiltInEventHandlers(IEnumerable<Declaration> declarations)
698+
private IEnumerable<Declaration> FindFormControlHandlers(IReadOnlyList<Declaration> declarations)
699+
{
700+
var controls = declarations
701+
.Where(declaration => declaration.DeclarationType == DeclarationType.Control);
702+
var handlerNames = declarations
703+
.Where(declaration => declaration.IsBuiltIn && declaration.DeclarationType == DeclarationType.Event)
704+
.SelectMany(e => controls.Select(c => c.IdentifierName + "_" + e.IdentifierName));
705+
var handlers = _userDeclarationsByType[DeclarationType.Procedure]
706+
.Where(procedure => handlerNames.Contains(procedure.IdentifierName));
707+
return handlers;
708+
}
709+
710+
private ConcurrentBag<Declaration> FindEventHandlers(IEnumerable<Declaration> declarations)
699711
{
700712
var declarationList = declarations.ToList();
701713

@@ -725,7 +737,9 @@ public ConcurrentBag<Declaration> FindBuiltInEventHandlers(IEnumerable<Declarati
725737
(!item.IsBuiltIn &&
726738
item.DeclarationType == DeclarationType.Procedure &&
727739
handlerNames.Contains(item.IdentifierName))
728-
);
740+
)
741+
.Concat(_handlersByWithEventsField.Value.SelectMany(kvp => kvp.Value))
742+
.Concat(FindFormControlHandlers(declarationList));
729743

730744
return new ConcurrentBag<Declaration>(handlers);
731745
}

0 commit comments

Comments
 (0)