Skip to content

Commit 3490297

Browse files
committed
sync with main repo / fix merge conflicts
2 parents a5a6419 + edc7d24 commit 3490297

File tree

6 files changed

+121
-49
lines changed

6 files changed

+121
-49
lines changed

Rubberduck.Parsing/Symbols/DeclarationFinder.cs

Lines changed: 32 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -55,8 +55,11 @@ public class DeclarationFinder
5555
private readonly Lazy<ConcurrentDictionary<Declaration, Declaration[]>> _handlersByWithEventsField;
5656
private readonly Lazy<ConcurrentDictionary<VBAParser.ImplementsStmtContext, Declaration[]>> _membersByImplementsContext;
5757
private readonly Lazy<ConcurrentDictionary<Declaration, Declaration[]>> _interfaceMembers;
58+
private Lazy<List<Declaration>> _nonBaseAsType;
59+
private readonly Lazy<ConcurrentBag<Declaration>> _eventHandlers;
60+
private readonly Lazy<ConcurrentBag<Declaration>> _classes;
5861

59-
private static readonly object ThreadLock = new object();
62+
private readonly object threadLock = new object();
6063

6164
private static QualifiedSelection GetGroupingKey(Declaration declaration)
6265
{
@@ -153,8 +156,16 @@ public DeclarationFinder(IReadOnlyList<Declaration> declarations, IEnumerable<IA
153156
});
154157

155158
_membersByImplementsContext = new Lazy<ConcurrentDictionary<VBAParser.ImplementsStmtContext, Declaration[]>>(() =>
156-
new ConcurrentDictionary<VBAParser.ImplementsStmtContext, Declaration[]>(
157-
implementableMembers.ToDictionary(item => item.Context, item => item.Members)), true);
159+
new ConcurrentDictionary<VBAParser.ImplementsStmtContext, Declaration[]>(
160+
implementableMembers.ToDictionary(item => item.Context, item => item.Members)), true);
161+
162+
_nonBaseAsType = new Lazy<List<Declaration>>(() =>
163+
_declarations.AllValues().Where(d =>
164+
!string.IsNullOrWhiteSpace(d.AsTypeName)
165+
&& !d.AsTypeIsBaseType
166+
&& d.DeclarationType != DeclarationType.Project
167+
&& d.DeclarationType != DeclarationType.ProceduralModule).ToList()
168+
,true);
158169
}
159170

160171
public Declaration FindSelectedDeclaration(ICodePane activeCodePane)
@@ -228,38 +239,22 @@ public IEnumerable<Declaration> Members(QualifiedModuleName module)
228239
return _declarations[module];
229240
}
230241

231-
private IEnumerable<Declaration> _nonBaseAsType;
232242
public IEnumerable<Declaration> FindDeclarationsWithNonBaseAsType()
233243
{
234-
lock (ThreadLock)
235-
{
236-
return _nonBaseAsType ?? (_nonBaseAsType = _declarations.AllValues().Where(d =>
237-
!string.IsNullOrWhiteSpace(d.AsTypeName)
238-
&& !d.AsTypeIsBaseType
239-
&& d.DeclarationType != DeclarationType.Project
240-
&& d.DeclarationType != DeclarationType.ProceduralModule).ToList());
241-
}
242-
}
244+
return _nonBaseAsType.Value;
243245

244-
private readonly Lazy<ConcurrentBag<Declaration>> _eventHandlers;
246+
}
247+
245248
public IEnumerable<Declaration> FindEventHandlers()
246249
{
247-
lock (ThreadLock)
248-
{
249-
return _eventHandlers.Value;
250-
}
250+
return _eventHandlers.Value;
251251
}
252252

253-
private readonly Lazy<ConcurrentBag<Declaration>> _classes;
254-
255253
public IEnumerable<Declaration> Classes
256254
{
257255
get
258256
{
259-
lock (ThreadLock)
260-
{
261-
return _classes.Value;
262-
}
257+
return _classes.Value;
263258
}
264259
}
265260

@@ -269,10 +264,7 @@ public IEnumerable<Declaration> Projects
269264
{
270265
get
271266
{
272-
lock (ThreadLock)
273-
{
274-
return _projects.Value;
275-
}
267+
return _projects.Value;
276268
}
277269
}
278270

@@ -290,10 +282,7 @@ public IEnumerable<Declaration> UserDeclarations(DeclarationType type)
290282

291283
public IEnumerable<UnboundMemberDeclaration> FreshUnresolvedMemberDeclarations()
292284
{
293-
lock (ThreadLock)
294-
{
295-
return _newUnresolved.ToArray();
296-
}
285+
return _newUnresolved.ToArray(); //This does not need a lock because enumerators over a ConcurrentBag uses a snapshot.
297286
}
298287

299288
public IEnumerable<UnboundMemberDeclaration> UnresolvedMemberDeclarations()
@@ -338,19 +327,18 @@ public Declaration FindParameter(Declaration procedure, string parameterName)
338327
public IEnumerable<Declaration> FindMemberMatches(Declaration parent, string memberName)
339328
{
340329
ConcurrentBag<Declaration> children;
341-
if (_declarations.TryGetValue(parent.QualifiedName.QualifiedModuleName, out children))
342-
{
343-
return children.Where(item => item.DeclarationType.HasFlag(DeclarationType.Member)
344-
&& item.IdentifierName == memberName).ToList();
345-
}
346-
347-
return Enumerable.Empty<Declaration>();
330+
return _declarations.TryGetValue(parent.QualifiedName.QualifiedModuleName, out children)
331+
? children.Where(item => item.DeclarationType.HasFlag(DeclarationType.Member)
332+
&& item.IdentifierName == memberName).ToList()
333+
: Enumerable.Empty<Declaration>();
348334
}
349335

350336
public IEnumerable<IAnnotation> FindAnnotations(QualifiedModuleName module)
351337
{
352338
ConcurrentBag<IAnnotation> result;
353-
return _annotations.TryGetValue(module, out result) ? result : Enumerable.Empty<IAnnotation>();
339+
return _annotations.TryGetValue(module, out result)
340+
? result
341+
: Enumerable.Empty<IAnnotation>();
354342
}
355343

356344
public bool IsMatch(string declarationName, string potentialMatchName)
@@ -405,7 +393,8 @@ public Declaration FindProject(string name, Declaration currentScope = null)
405393
Declaration result = null;
406394
try
407395
{
408-
result = MatchName(name).SingleOrDefault(project => project.DeclarationType.HasFlag(DeclarationType.Project)
396+
result = MatchName(name).SingleOrDefault(project =>
397+
project.DeclarationType.HasFlag(DeclarationType.Project)
409398
&& (currentScope == null || project.ProjectId == currentScope.ProjectId));
410399
}
411400
catch (InvalidOperationException exception)
@@ -416,7 +405,7 @@ public Declaration FindProject(string name, Declaration currentScope = null)
416405
return result;
417406
}
418407

419-
public Declaration FindStdModule(string name, Declaration parent = null, bool includeBuiltIn = false)
408+
public Declaration FindStdModule(string name, Declaration parent, bool includeBuiltIn = false)
420409
{
421410
Debug.Assert(parent != null);
422411
Declaration result = null;
@@ -435,7 +424,7 @@ public Declaration FindStdModule(string name, Declaration parent = null, bool in
435424
return result;
436425
}
437426

438-
public Declaration FindClassModule(string name, Declaration parent = null, bool includeBuiltIn = false)
427+
public Declaration FindClassModule(string name, Declaration parent, bool includeBuiltIn = false)
439428
{
440429
Debug.Assert(parent != null);
441430
Declaration result = null;

Rubberduck.Parsing/VBA/ParseCoordinator.cs

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -704,6 +704,10 @@ private void ParseAllInternal(object requestor, CancellationToken token)
704704
{
705705
token.ThrowIfCancellationRequested();
706706

707+
Thread.Sleep(50); //Simplistic hack to give the VBE time to do its work in case the parsing run is requested from an event handler.
708+
709+
token.ThrowIfCancellationRequested();
710+
707711
State.RefreshProjects(_vbe);
708712

709713
token.ThrowIfCancellationRequested();

Rubberduck.Parsing/VBA/RubberduckParserState.cs

Lines changed: 4 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1072,12 +1072,13 @@ public HashSet<QualifiedModuleName> ModulesReferencedBy(QualifiedModuleName refe
10721072

10731073
public HashSet<QualifiedModuleName> ModulesReferencedBy(IEnumerable<QualifiedModuleName> referencingModules)
10741074
{
1075-
var referencedModules = new HashSet<QualifiedModuleName>();
1075+
var toModules = new HashSet<QualifiedModuleName>();
1076+
10761077
foreach (var referencingModule in referencingModules)
10771078
{
1078-
referencedModules.UnionWith(ModulesReferencedBy(referencingModule));
1079+
toModules.UnionWith(ModulesReferencedBy(referencingModule));
10791080
}
1080-
return referencedModules;
1081+
return toModules;
10811082
}
10821083

10831084
public HashSet<QualifiedModuleName> ModulesReferencing(QualifiedModuleName referencedModule)

Rubberduck.VBEEditor/Events/VBENativeServices.cs

Lines changed: 17 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -170,12 +170,27 @@ private static void OnWindowFocusChange(object sender, WindowChangedEventArgs ev
170170

171171
private static ICodePane GetCodePaneFromHwnd(IntPtr hwnd)
172172
{
173-
var caption = hwnd.GetWindowText();
174-
return _vbe.CodePanes.FirstOrDefault(x => x.Window.Caption.Equals(caption));
173+
try
174+
{
175+
var caption = hwnd.GetWindowText();
176+
return _vbe.CodePanes.FirstOrDefault(x => x.Window.Caption.Equals(caption));
177+
}
178+
catch
179+
{
180+
// This *should* only happen when a code pane window is removed and RD responds faster than
181+
// the VBE removes it from the windows collection. TODO: Find a better method to match code panes
182+
// to windows than testing the captions.
183+
return null;
184+
}
175185
}
176186

177187
private static IWindow GetWindowFromHwnd(IntPtr hwnd)
178188
{
189+
if (!User32.IsWindow(hwnd))
190+
{
191+
return null;
192+
}
193+
179194
var caption = hwnd.GetWindowText();
180195
return _vbe.Windows.FirstOrDefault(x => x.Caption.Equals(caption));
181196
}

Rubberduck.VBEEditor/WindowsApi/User32.cs

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -82,5 +82,14 @@ public static class User32
8282

8383
[DllImport("user32.dll", CharSet = CharSet.Unicode)]
8484
internal static extern IntPtr FindWindowEx(IntPtr parentHandle, IntPtr childAfter, string lclassName, string windowTitle);
85+
86+
/// <summary>
87+
/// Validates a window handle.
88+
/// </summary>
89+
/// <param name="hWnd">The handle to validate.</param>
90+
/// <returns></returns>
91+
[DllImport("user32.dll")]
92+
[return: MarshalAs(UnmanagedType.Bool)]
93+
internal static extern bool IsWindow(IntPtr hWnd);
8594
}
8695
}

RubberduckTests/Symbols/DeclarationFinderTests.cs

Lines changed: 55 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,4 @@
1-
using System.Linq;
1+
using System.Linq;
22
using System.Threading;
33
using Microsoft.VisualStudio.TestTools.UnitTesting;
44
using Rubberduck.Parsing.Symbols;
@@ -67,5 +67,59 @@ End Sub
6767

6868
Assert.AreEqual(expected, actual, "Expected {0}, resolved to {1}", expected.DeclarationType, actual.DeclarationType);
6969
}
70+
71+
[TestCategory("Resolver")]
72+
[TestMethod]
73+
public void DeclarationFinderCanCopeWithMultipleModulesImplementingTheSameInterface()
74+
{
75+
var project = GetTestProject("testProject");
76+
var interf = GetTestClassModule(project, "interface");
77+
var member = GetTestFunction(interf, "testMember", Accessibility.Public);
78+
var implementingClass1 = GetTestClassModule(project, "implementingClass1");
79+
var implementingClass2 = GetTestClassModule(project, "implementingClass2");
80+
var implementsContext1 = new VBAParser.ImplementsStmtContext(null, 0);
81+
var implementsContext2 = new VBAParser.ImplementsStmtContext(null, 0);
82+
AddReference(interf, implementingClass1, implementsContext1);
83+
AddReference(interf, implementingClass1, implementsContext2);
84+
var declarations = new List<Declaration> { interf, member, implementingClass1, implementingClass2 };
85+
86+
DeclarationFinder finder = new DeclarationFinder(declarations, new List<Rubberduck.Parsing.Annotations.IAnnotation>(), new List<UnboundMemberDeclaration>());
87+
var interfaceDeclarations = finder.FindAllInterfaceMembers().ToList();
88+
89+
Assert.AreEqual(1, interfaceDeclarations.Count());
90+
}
91+
92+
private static ClassModuleDeclaration GetTestClassModule(Declaration projectDeclatation, string name, bool isExposed = false)
93+
{
94+
var qualifiedClassModuleMemberName = new QualifiedMemberName(StubQualifiedModuleName(name), name);
95+
var classModuleAttributes = new Rubberduck.Parsing.VBA.Attributes();
96+
if (isExposed)
97+
{
98+
classModuleAttributes.AddExposedClassAttribute();
99+
}
100+
return new ClassModuleDeclaration(qualifiedClassModuleMemberName, projectDeclatation, name, false, null, classModuleAttributes);
101+
}
102+
103+
private static ProjectDeclaration GetTestProject(string name)
104+
{
105+
var qualifiedProjectName = new QualifiedMemberName(StubQualifiedModuleName("proj"), name);
106+
return new ProjectDeclaration(qualifiedProjectName, name, false, null);
107+
}
108+
109+
private static QualifiedModuleName StubQualifiedModuleName(string name)
110+
{
111+
return new QualifiedModuleName("dummy", "dummy", name);
112+
}
113+
114+
private static FunctionDeclaration GetTestFunction(Declaration moduleDeclatation, string name, Accessibility functionAccessibility)
115+
{
116+
var qualifiedFunctionMemberName = new QualifiedMemberName(moduleDeclatation.QualifiedName.QualifiedModuleName, name);
117+
return new FunctionDeclaration(qualifiedFunctionMemberName, moduleDeclatation, moduleDeclatation, "test", null, "test", functionAccessibility, null, Selection.Home, false, false, null, null);
118+
}
119+
120+
private static void AddReference(Declaration toDeclaration, Declaration fromModuleDeclaration, ParserRuleContext context = null)
121+
{
122+
toDeclaration.AddReference(toDeclaration.QualifiedName.QualifiedModuleName, fromModuleDeclaration, fromModuleDeclaration, context, toDeclaration.IdentifierName, toDeclaration, Selection.Home, new List<Rubberduck.Parsing.Annotations.IAnnotation>());
123+
}
70124
}
71125
}

0 commit comments

Comments
 (0)