Skip to content

Commit 6348fff

Browse files
committed
Move band-aid for AssignmentToByValParameterInspection from resolver to the inspection itself
This also makes the ImplicitDefaultMemberAssignmentInspection work correctly without tweaks to the resolver..
1 parent d024143 commit 6348fff

File tree

3 files changed

+65
-12
lines changed

3 files changed

+65
-12
lines changed

Rubberduck.CodeAnalysis/Inspections/Concrete/AssignedByValParameterInspection.cs

Lines changed: 30 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -48,12 +48,41 @@ protected override IEnumerable<IInspectionResult> DoGetInspectionResults()
4848
.Cast<ParameterDeclaration>()
4949
.Where(item => !item.IsByRef
5050
&& !item.IsIgnoringInspectionResultFor(AnnotationName)
51-
&& item.References.Any(reference => reference.IsAssignment));
51+
&& item.References.Any(IsAssignmentToDeclaration));
5252

5353
return parameters
5454
.Select(param => new DeclarationInspectionResult(this,
5555
string.Format(InspectionResults.AssignedByValParameterInspection, param.IdentifierName),
5656
param));
5757
}
58+
59+
private static bool IsAssignmentToDeclaration(IdentifierReference reference)
60+
{
61+
if (!reference.IsAssignment)
62+
{
63+
return false;
64+
}
65+
66+
if (reference.IsSetAssignment)
67+
{
68+
return true;
69+
}
70+
71+
var declaration = reference.Declaration;
72+
if (declaration == null)
73+
{
74+
return false;
75+
}
76+
77+
if (declaration.IsObject)
78+
{
79+
//This can only be legal with a default member access.
80+
return false;
81+
}
82+
83+
//This is not perfect in case the referenced declaration is an unbound Variant.
84+
//In that case, a default member access might occur after the run-time resolution.
85+
return true;
86+
}
5887
}
5988
}

Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs

Lines changed: 1 addition & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -193,22 +193,12 @@ private void ResolveDefault(
193193
}
194194
}
195195

196-
//TODO: Find out what this is about.
197-
var reallyIsAssignmentTarget = isAssignmentTarget && isSetAssignment;
198-
if (isAssignmentTarget && !isSetAssignment)
199-
{
200-
var defaultMember = (boundExpression.ReferencedDeclaration?.AsTypeDeclaration as ClassModuleDeclaration)?.DefaultMember;
201-
reallyIsAssignmentTarget = defaultMember == null
202-
|| ((IParameterizedDeclaration) defaultMember).Parameters.All(param => param.IsOptional)
203-
|| defaultMember.DeclarationType == DeclarationType.PropertyLet && ((IParameterizedDeclaration)defaultMember).Parameters.Count(param => !param.IsOptional) == 1;
204-
}
205-
206196
_boundExpressionVisitor.AddIdentifierReferences(
207197
boundExpression,
208198
_qualifiedModuleName,
209199
_currentScope,
210200
_currentParent,
211-
reallyIsAssignmentTarget,
201+
isAssignmentTarget,
212202
hasExplicitLetStatement,
213203
isSetAssignment);
214204
}

RubberduckTests/Inspections/AssignedByValParameterInspectionTests.cs

Lines changed: 34 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -170,6 +170,40 @@ End Sub
170170
}
171171
}
172172

173+
[Test]
174+
[Category("Inspections")]
175+
public void AssignedByValParameter_NoResultForDefaultMembberAssignment()
176+
{
177+
var class1 = @"
178+
Public Property Get Something() As Long
179+
Attribute Foo.VB_UserMemId = 0
180+
End Property
181+
Public Property Let Something(ByVal value As Long)
182+
Attribute Foo.VB_UserMemId = 0
183+
End Property
184+
";
185+
var caller = @"
186+
Option Explicit
187+
Private Sub DoSomething(ByVal foo As Class1)
188+
foo = 42
189+
End Sub
190+
";
191+
var builder = new MockVbeBuilder();
192+
var vbe = builder.ProjectBuilder("TestProject", ProjectProtection.Unprotected)
193+
.AddComponent("Class1", ComponentType.ClassModule, class1)
194+
.AddComponent("Module1", ComponentType.StandardModule, caller)
195+
.AddProjectToVbeBuilder()
196+
.Build();
197+
198+
using (var state = MockParser.CreateAndParse(vbe.Object))
199+
{
200+
var inspection = new AssignedByValParameterInspection(state);
201+
var inspectionResults = inspection.GetInspectionResults(CancellationToken.None);
202+
203+
Assert.IsFalse(inspectionResults.Any());
204+
}
205+
}
206+
173207
[Test]
174208
[Category("Inspections")]
175209
public void InspectionName()

0 commit comments

Comments
 (0)