Skip to content

Commit 63abcea

Browse files
committed
Enhance MemberAttibutesRecoverer to deal with properties
Now, the key used to identify members is (memberName, memberType) instead od just memberName. This is necessary because Get, Let and Set properties share the same name.
1 parent 175de28 commit 63abcea

File tree

5 files changed

+96
-22
lines changed

5 files changed

+96
-22
lines changed

Rubberduck.Core/UI/Notifiers/MemberAttributeRecoveryFailureNotifier.cs

Lines changed: 7 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,9 @@
11
using System;
22
using System.Collections.Generic;
3+
using System.Linq;
34
using Rubberduck.Interaction;
45
using Rubberduck.Parsing.Rewriter;
6+
using Rubberduck.Parsing.Symbols;
57
using Rubberduck.VBEditor;
68

79
namespace Rubberduck.UI.Notifiers
@@ -44,18 +46,19 @@ private static string RewriteFailureReasonMessage(RewriteSessionState sessionSta
4446
}
4547
}
4648

47-
public void NotifyMembersForRecoveryNotFound(IEnumerable<QualifiedMemberName> membersNotFound)
49+
public void NotifyMembersForRecoveryNotFound(IEnumerable<(QualifiedMemberName memberName, DeclarationType memberType)> membersNotFound)
4850
{
4951
var message = MembersNotFoundMessage(membersNotFound);
5052
var caption = Resources.RubberduckUI.MemberAttributeRecoveryFailureCaption;
5153

5254
_messageBox.NotifyWarn(message, caption);
5355
}
5456

55-
private string MembersNotFoundMessage(IEnumerable<QualifiedMemberName> membersNotFound)
57+
private string MembersNotFoundMessage(IEnumerable<(QualifiedMemberName memberName, DeclarationType memberType)> membersNotFound)
5658
{
57-
var missingMemberList = $"{Environment.NewLine}{string.Join(Environment.NewLine, membersNotFound)}";
58-
return string.Format(Resources.RubberduckUI.MemberAttributeRecoveryMembersNotFoundMessage, missingMemberList); ;
59+
var missingMemberTexts = membersNotFound.Select(tpl => $"{tpl.memberName} ({tpl.memberType})");
60+
var missingMemberList = $"{Environment.NewLine}{string.Join(Environment.NewLine, missingMemberTexts)}";
61+
return string.Format(Resources.RubberduckUI.MemberAttributeRecoveryMembersNotFoundMessage, missingMemberList);
5962
}
6063
}
6164
}
Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,12 @@
11
using System.Collections.Generic;
2+
using Rubberduck.Parsing.Symbols;
23
using Rubberduck.VBEditor;
34

45
namespace Rubberduck.Parsing.Rewriter
56
{
67
public interface IMemberAttributeRecoveryFailureNotifier
78
{
89
void NotifyRewriteFailed(RewriteSessionState rewriteSessionState);
9-
void NotifyMembersForRecoveryNotFound(IEnumerable<QualifiedMemberName> membersNotFound);
10+
void NotifyMembersForRecoveryNotFound(IEnumerable<(QualifiedMemberName memberName, DeclarationType memberType)> membersNotFound);
1011
}
1112
}

Rubberduck.Parsing/Rewriter/MemberAttributeRecoverer.cs

Lines changed: 19 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
using System;
22
using System.Collections.Generic;
3+
using System.Diagnostics;
34
using System.Linq;
45
using System.Threading;
56
using System.Threading.Tasks;
@@ -19,15 +20,17 @@ public sealed class MemberAttributeRecoverer : IMemberAttributeRecovererWithSett
1920
private IRewritingManager _rewritingManager;
2021
private readonly IMemberAttributeRecoveryFailureNotifier _failureNotifier;
2122

22-
private readonly
23-
IDictionary<QualifiedModuleName, IDictionary<string, HashSet<AttributeNode>>> _attributesToRecover
24-
= new Dictionary<QualifiedModuleName, IDictionary<string, HashSet<AttributeNode>>>();
25-
private readonly HashSet<QualifiedMemberName> _missingMembers = new HashSet<QualifiedMemberName>();
23+
private readonly IDictionary<QualifiedModuleName, IDictionary<(string memberName, DeclarationType memberType), HashSet<AttributeNode>>> _attributesToRecover
24+
= new Dictionary<QualifiedModuleName, IDictionary<(string memberName, DeclarationType memberType), HashSet<AttributeNode>>>();
25+
private readonly HashSet<(QualifiedMemberName memberName, DeclarationType memberType)> _missingMembers = new HashSet<(QualifiedMemberName memberName, DeclarationType memberType)>();
2626

2727
private readonly Logger _logger = LogManager.GetCurrentClassLogger();
2828

29-
public MemberAttributeRecoverer(IDeclarationFinderProvider declarationFinderProvider,
30-
IParseManager parseManager, IAttributesUpdater attributesUpdater, IMemberAttributeRecoveryFailureNotifier failureNotifier)
29+
public MemberAttributeRecoverer(
30+
IDeclarationFinderProvider declarationFinderProvider,
31+
IParseManager parseManager,
32+
IAttributesUpdater attributesUpdater,
33+
IMemberAttributeRecoveryFailureNotifier failureNotifier)
3134
{
3235
_declarationFinderProvider = declarationFinderProvider;
3336
_parseManager = parseManager;
@@ -83,7 +86,7 @@ private void SaveAttributesToRecover(IDictionary<QualifiedModuleName, IEnumerabl
8386
var attributesByMember = declarationsByModule[module]
8487
.Where(decl => decl.Attributes.Any())
8588
.ToDictionary(
86-
decl => decl.IdentifierName,
89+
decl => (decl.IdentifierName, decl.DeclarationType),
8790
decl => (HashSet<AttributeNode>)decl.Attributes);
8891
_attributesToRecover.Add(module, attributesByMember);
8992
}
@@ -154,41 +157,41 @@ private void CancelTheCurrentParse()
154157
_parseManager.OnParseCancellationRequested(this);
155158
}
156159

157-
private void RecoverAttributes(IRewriteSession rewriteSession, QualifiedModuleName module, IDictionary<string, HashSet<AttributeNode>> attributesByMember)
160+
private void RecoverAttributes(IRewriteSession rewriteSession, QualifiedModuleName module, IDictionary<(string memberName, DeclarationType memberType), HashSet<AttributeNode>> attributesByMember)
158161
{
159162
var membersWithAttributesToRecover = attributesByMember.Keys.ToHashSet();
160163
var declarationFinder = _declarationFinderProvider.DeclarationFinder;
161164
var declarationsWithAttributesToRecover = declarationFinder.Members(module)
162-
.Where(decl => membersWithAttributesToRecover.Contains(decl.IdentifierName)
165+
.Where(decl => membersWithAttributesToRecover.Contains((decl.IdentifierName, decl.DeclarationType))
163166
&& decl.ParentScopeDeclaration.DeclarationType.HasFlag(DeclarationType.Module))
164167
.ToList();
165168

166169
if (membersWithAttributesToRecover.Count != declarationsWithAttributesToRecover.Count)
167170
{
168171
var membersWithoutDeclarations = MembersWithoutDeclarations(membersWithAttributesToRecover, declarationsWithAttributesToRecover);
169172
LogFailureToRecoverAllAttributes(module, membersWithoutDeclarations);
170-
_missingMembers.UnionWith(membersWithoutDeclarations.Select(memberName => new QualifiedMemberName(module, memberName)));
173+
_missingMembers.UnionWith(membersWithoutDeclarations.Select(tpl => (new QualifiedMemberName(module, tpl.memberName), tpl.memberType)));
171174
}
172175

173176
foreach (var declaration in declarationsWithAttributesToRecover)
174177
{
175-
RecoverAttributes(rewriteSession, declaration, attributesByMember[declaration.IdentifierName]);
178+
RecoverAttributes(rewriteSession, declaration, attributesByMember[(declaration.IdentifierName, declaration.DeclarationType)]);
176179
}
177180
}
178181

179-
private static ICollection<string> MembersWithoutDeclarations(HashSet<string> membersWithAttributesToRecover, IEnumerable<Declaration> declarationsWithAttributesToRecover)
182+
private static ICollection<(string memberName, DeclarationType memberType)> MembersWithoutDeclarations(HashSet<(string memberName, DeclarationType memberType)> membersWithAttributesToRecover, IEnumerable<Declaration> declarationsWithAttributesToRecover)
180183
{
181184
var membersWithoutDeclarations = membersWithAttributesToRecover.ToHashSet();
182-
membersWithoutDeclarations.ExceptWith(declarationsWithAttributesToRecover.Select(decl => decl.IdentifierName));
185+
membersWithoutDeclarations.ExceptWith(declarationsWithAttributesToRecover.Select(decl => (decl.IdentifierName, decl.DeclarationType)));
183186
return membersWithoutDeclarations;
184187
}
185188

186-
private void LogFailureToRecoverAllAttributes(QualifiedModuleName module, IEnumerable<string> membersWithoutDeclarations)
189+
private void LogFailureToRecoverAllAttributes(QualifiedModuleName module, IEnumerable<(string memberName, DeclarationType memberType)> membersWithoutDeclarations)
187190
{
188191
_logger.Warn("Could not recover the attributes for all members because one or more members could no longer be found.");
189-
foreach (var member in membersWithoutDeclarations)
192+
foreach (var (memberName, memberType) in membersWithoutDeclarations)
190193
{
191-
_logger.Trace($"Could not recover the attributes for member {member} in module {module} because a member of that name exists no longer.");
194+
_logger.Trace($"Could not recover the attributes for member {memberName} of type {memberType} in module {module} because a member of that name and type exists no longer.");
192195
}
193196
}
194197

RubberduckTests/Inspections/EmptyModuleInspectionTests.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -49,7 +49,7 @@ Option Explicit
4949
}
5050

5151
[TestCase("Private Function Foo() As String\r\nEnd Function")]
52-
[TestCase("Private Sub Foo() As String\r\nEnd Sub")]
52+
[TestCase("Private Sub Foo()\r\nEnd Sub")]
5353
[TestCase("Public Property Get Foo()\r\nEnd Property")]
5454
[TestCase("Public Property Set Foo(rhs As Variant)\r\nEnd Property")]
5555
[TestCase("Public Property Let Foo(rhs As Variant)\r\nEnd Property")]

RubberduckTests/Rewriter/MemberAttributeRecovererTests.cs

Lines changed: 67 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -250,5 +250,72 @@ Public Function Bar() As Variant
250250
Assert.AreEqual(expectedCodeWithoutRecovery, actualCodeWithoutRecovery);
251251
}
252252
}
253+
254+
[Test]
255+
[Category("Rewriter")]
256+
[TestCase("Attribute Foo.VB_UserMemId = 0", "", "")]
257+
[TestCase("", "Attribute Foo.VB_UserMemId = 0", "")]
258+
[TestCase("", "", "Attribute Foo.VB_UserMemId = 0")]
259+
[TestCase("Attribute Foo.VB_Description = \"myPropertyGet\"", "Attribute Foo.VB_Description = \"myPropertyLet\"", "")]
260+
[TestCase("", "Attribute Foo.VB_Description = \"myPropertyLet\"", "Attribute Foo.VB_Description = \"myPropertySet\"")]
261+
[TestCase("Attribute Foo.VB_Description = \"myPropertyGet\"", "", "Attribute Foo.VB_Description = \"myPropertySet\"")]
262+
[TestCase("Attribute Foo.VB_Description = \"myPropertyGet\"", "Attribute Foo.VB_Description = \"myPropertyLet\"", "Attribute Foo.VB_Description = \"myPropertySet\"")]
263+
public void RecoveringAttributesRecoversTheAttributesInTheModulesProvided_ViaModule_PropertiesAreHandlesSeparately(string getAttributes, string letAttributes, string setAttributes)
264+
{
265+
var inputCode =
266+
$@"Public Property Get Foo() As Variant
267+
{getAttributes}
268+
End Property
269+
270+
Public Property Let Foo(ByVal RHS As Long)
271+
{letAttributes}
272+
End Property
273+
274+
Public Property Set Foo(ByVal RHs As Object)
275+
{setAttributes}
276+
End Property";
277+
278+
var expectedCodeWithRecovery = inputCode;
279+
280+
var expectedCodeWithoutRecovery =
281+
$@"Public Property Get Foo() As Variant{(string.IsNullOrEmpty(getAttributes) ? Environment.NewLine : string.Empty)}
282+
End Property
283+
284+
Public Property Let Foo(ByVal RHS As Long){(string.IsNullOrEmpty(letAttributes) ? Environment.NewLine : string.Empty)}
285+
End Property
286+
287+
Public Property Set Foo(ByVal RHs As Object){(string.IsNullOrEmpty(setAttributes) ? Environment.NewLine : string.Empty)}
288+
End Property";
289+
290+
var vbe = MockVbeBuilder.BuildFromStdModules(("RecoveryModule", inputCode), ("NoRecoveryModule", inputCode)).Object;
291+
var (state, rewritingManager) = MockParser.CreateAndParseWithRewritingManager(vbe);
292+
using (state)
293+
{
294+
var attributesUpdater = new AttributesUpdater(state);
295+
var mockFailureNotifier = new Mock<IMemberAttributeRecoveryFailureNotifier>();
296+
var memberAttributeRecoverer = new MemberAttributeRecoverer(state, state, attributesUpdater, mockFailureNotifier.Object);
297+
memberAttributeRecoverer.RewritingManager = rewritingManager;
298+
299+
var recoveryModule = state.DeclarationFinder.UserDeclarations(DeclarationType.Module)
300+
.First(decl => decl.IdentifierName.Equals("RecoveryModule")).QualifiedModuleName;
301+
var noRecoveryModule = state.DeclarationFinder.UserDeclarations(DeclarationType.Module)
302+
.First(decl => decl.IdentifierName.Equals("NoRecoveryModule")).QualifiedModuleName;
303+
304+
var modulesToRecoverAttributesIn = new List<QualifiedModuleName> { recoveryModule };
305+
306+
memberAttributeRecoverer.RecoverCurrentMemberAttributesAfterNextParse(modulesToRecoverAttributesIn);
307+
308+
var rewriteSession = rewritingManager.CheckOutCodePaneSession();
309+
var declarationsForWhichToRemoveAttributes = state.DeclarationFinder.UserDeclarations(DeclarationType.Property);
310+
RemoveAttributes(declarationsForWhichToRemoveAttributes, rewriteSession);
311+
312+
ExecuteAndWaitForParserState(state, () => rewriteSession.TryRewrite(), ParserState.Ready);
313+
314+
var actualCodeWithRecovery = state.ProjectsProvider.Component(recoveryModule).CodeModule.Content();
315+
var actualCodeWithoutRecovery = state.ProjectsProvider.Component(noRecoveryModule).CodeModule.Content();
316+
Assert.AreEqual(expectedCodeWithRecovery, actualCodeWithRecovery);
317+
Assert.AreEqual(expectedCodeWithoutRecovery, actualCodeWithoutRecovery);
318+
}
319+
}
253320
}
254321
}

0 commit comments

Comments
 (0)