Skip to content

Commit 3d5370a

Browse files
authored
Merge pull request #5224 from MDoerner/FixAttributesRecovery
Fix member attributes recovery for properties
2 parents 175de28 + 63abcea commit 3d5370a

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)