33using Rubberduck . Parsing . Symbols ;
44using Rubberduck . Parsing . VBA ;
55using System . Collections . Generic ;
6+ using System . Diagnostics ;
67using System . Linq ;
78
89namespace Rubberduck . Inspections
@@ -19,39 +20,126 @@ public static IEnumerable<Declaration> GetDeclarationsPotentiallyRequiringSetAss
1920 return relevantDeclarations ;
2021 }
2122
23+ /// <summary>
24+ /// Determines whether the 'Set' keyword needs to be added in the context of the specified identifier reference.
25+ /// </summary>
26+ /// <param name="reference">The identifier reference to analyze</param>
27+ /// <param name="state">The parser state</param>
28+ public static bool NeedsSetKeywordAdded ( IdentifierReference reference , RubberduckParserState state )
29+ {
30+ var setStmtContext = reference . Context . GetAncestor < VBAParser . SetStmtContext > ( ) ;
31+ return setStmtContext == null && RequiresSetAssignment ( reference , state ) ;
32+ }
33+
34+ /// <summary>
35+ /// Determines whether the 'Set' keyword is required (whether it's present or not) for the specified identifier reference.
36+ /// </summary>
37+ /// <param name="reference">The identifier reference to analyze</param>
38+ /// <param name="state">The parser state</param>
2239 public static bool RequiresSetAssignment ( IdentifierReference reference , RubberduckParserState state )
2340 {
24- //Not an assignment...definitely does not require a 'Set' assignment
2541 if ( ! reference . IsAssignment )
2642 {
43+ // reference isn't assigning its declaration; not interesting
44+ return false ;
45+ }
46+
47+ var setStmtContext = reference . Context . GetAncestor < VBAParser . SetStmtContext > ( ) ;
48+ if ( setStmtContext != null )
49+ {
50+ // don't assume Set keyword is legit...
51+ return reference . Declaration . IsObject ;
52+ }
53+
54+ var letStmtContext = reference . Context . GetAncestor < VBAParser . LetStmtContext > ( ) ;
55+ if ( letStmtContext == null )
56+ {
57+ // not an assignment
2758 return false ;
2859 }
29-
30- //We know for sure it DOES NOT use 'Set'
31- if ( ! MayRequireAssignmentUsingSet ( reference . Declaration ) )
60+
61+ var declaration = reference . Declaration ;
62+ if ( declaration . IsArray )
63+ {
64+ // arrays don't need a Set statement... todo figure out if array items are objects
65+ return false ;
66+ }
67+
68+ var isObjectVariable = declaration . IsObject ;
69+ var isVariant = declaration . IsUndeclared || declaration . AsTypeName == Tokens . Variant ;
70+ if ( ! isObjectVariable && ! isVariant )
3271 {
3372 return false ;
3473 }
3574
36- //We know for sure that it DOES use 'Set'
37- if ( RequiresAssignmentUsingSet ( reference . Declaration ) )
75+ if ( isObjectVariable )
3876 {
77+ // get the members of the returning type, a default member could make us lie otherwise
78+ var classModule = declaration . AsTypeDeclaration as ClassModuleDeclaration ;
79+ if ( classModule ? . DefaultMember != null )
80+ {
81+ var parameters = ( classModule . DefaultMember as IParameterizedDeclaration ) ? . Parameters . ToArray ( ) ?? Enumerable . Empty < ParameterDeclaration > ( ) . ToArray ( ) ;
82+ if ( ! parameters . Any ( ) || parameters . All ( p => p . IsOptional ) )
83+ {
84+ // assigned declaration has a default parameterless member, which is legally being assigned here.
85+ // might be a good idea to flag that default member assignment though...
86+ return false ;
87+ }
88+ }
89+
90+ // assign declaration is an object without a default parameterless (or with all parameters optional) member - LHS needs a 'Set' keyword.
3991 return true ;
4092 }
4193
42- //We need to look everything to understand the RHS - the assigned reference is probably a Variant
43- var allInterestingDeclarations = GetDeclarationsPotentiallyRequiringSetAssignment ( state . AllUserDeclarations ) ;
94+ // assigned declaration is a variant. we need to know about the RHS of the assignment.
4495
45- return ObjectOrVariantRequiresSetAssignment ( reference , allInterestingDeclarations ) ;
46- }
96+ var expression = letStmtContext . expression ( ) ;
97+ if ( expression == null )
98+ {
99+ Debug . Assert ( false , "RHS expression is empty? What's going on here?" ) ;
100+ }
47101
48- private static bool MayRequireAssignmentUsingSet ( Declaration declaration )
49- {
50- if ( declaration . DeclarationType == DeclarationType . PropertyLet )
102+ if ( expression is VBAParser . NewExprContext )
51103 {
52- return false ;
104+ // RHS expression is newing up an object reference - LHS needs a 'Set' keyword:
105+ return true ;
53106 }
54107
108+ var literalExpression = expression as VBAParser . LiteralExprContext ;
109+ if ( literalExpression ? . literalExpression ( ) ? . literalIdentifier ( ) ? . objectLiteralIdentifier ( ) != null )
110+ {
111+ // RHS is a 'Nothing' token - LHS needs a 'Set' keyword:
112+ return true ;
113+ }
114+
115+ // todo resolve expression return type
116+
117+ var memberRefs = state . DeclarationFinder . IdentifierReferences ( reference . ParentScoping . QualifiedName ) ;
118+ var lastRef = memberRefs . LastOrDefault ( r => ! Equals ( r , reference ) && r . Context . GetAncestor < VBAParser . LetStmtContext > ( ) == letStmtContext ) ;
119+ if ( lastRef ? . Declaration . AsTypeDeclaration ? . DeclarationType . HasFlag ( DeclarationType . ClassModule ) ?? false )
120+ {
121+ // the last reference in the expression is referring to an object type
122+ return true ;
123+ }
124+ if ( lastRef ? . Declaration . AsTypeName == Tokens . Object )
125+ {
126+ return true ;
127+ }
128+
129+ var accessibleDeclarations = state . DeclarationFinder . GetAccessibleDeclarations ( reference . ParentScoping ) ;
130+ foreach ( var accessibleDeclaration in accessibleDeclarations . Where ( d => d . IdentifierName == expression . GetText ( ) ) )
131+ {
132+ if ( accessibleDeclaration . DeclarationType . HasFlag ( DeclarationType . ClassModule ) || accessibleDeclaration . AsTypeName == Tokens . Object )
133+ {
134+ return true ;
135+ }
136+ }
137+
138+ return false ;
139+ }
140+
141+ private static bool MayRequireAssignmentUsingSet ( Declaration declaration )
142+ {
55143 if ( declaration . AsTypeName == Tokens . Variant )
56144 {
57145 return true ;
@@ -82,7 +170,7 @@ private static bool RequiresAssignmentUsingSet(Declaration declaration)
82170 {
83171 if ( declaration . AsTypeDeclaration != null )
84172 {
85- return declaration . AsTypeDeclaration . DeclarationType == DeclarationType . UserDefinedType
173+ return declaration . AsTypeDeclaration . DeclarationType == DeclarationType . ClassModule
86174 && ( ( ( IsVariableOrParameter ( declaration )
87175 && ! declaration . IsSelfAssigned )
88176 || ( IsMemberWithReturnType ( declaration )
@@ -102,84 +190,5 @@ private static bool IsVariableOrParameter(Declaration item)
102190 return item . DeclarationType == DeclarationType . Variable
103191 || item . DeclarationType == DeclarationType . Parameter ;
104192 }
105-
106- private static bool ObjectOrVariantRequiresSetAssignment ( IdentifierReference objectOrVariantRef , IEnumerable < Declaration > variantAndObjectDeclarations )
107- {
108- //Not an assignment...nothing to evaluate
109- if ( ! objectOrVariantRef . IsAssignment )
110- {
111- return false ;
112- }
113-
114- if ( IsAlreadyAssignedUsingSet ( objectOrVariantRef )
115- || objectOrVariantRef . Declaration . AsTypeName != Tokens . Variant )
116- {
117- return true ;
118- }
119-
120- //Variants can be assigned with or without 'Set' depending...
121- var letStmtContext = objectOrVariantRef . Context . GetAncestor < VBAParser . LetStmtContext > ( ) ;
122-
123- //A potential error is only possible for let statements: rset, lset and other type specific assignments are always let assignments;
124- //assignemts in for each loop statements are do not require the set keyword.
125- if ( letStmtContext == null )
126- {
127- return false ;
128- }
129-
130- //You can only new up objects.
131- if ( RHSUsesNew ( letStmtContext ) ) { return true ; }
132-
133- if ( RHSIsLiteral ( letStmtContext ) )
134- {
135- if ( RHSIsObjectLiteral ( letStmtContext ) )
136- {
137- return true ;
138- }
139- //All literals but the object literal potentially do not need a set assignment.
140- //We cannot get more information from the RHS and do not want false positives.
141- return false ;
142- }
143-
144- //If the RHS is the identifierName of one of the 'interesting' declarations, we need to use 'Set'
145- //unless the 'interesting' declaration is also a Variant
146- var rhsIdentifier = GetRHSIdentifierExpressionText ( letStmtContext ) ;
147- return variantAndObjectDeclarations . Any ( dec => dec . IdentifierName == rhsIdentifier && dec . AsTypeName != Tokens . Variant ) ;
148- }
149-
150- private static bool IsLetAssignment ( IdentifierReference reference )
151- {
152- var letStmtContext = reference . Context . GetAncestor < VBAParser . LetStmtContext > ( ) ;
153- return ( reference . IsAssignment && letStmtContext != null ) ;
154- }
155-
156- private static bool IsAlreadyAssignedUsingSet ( IdentifierReference reference )
157- {
158- var setStmtContext = reference . Context . GetAncestor < VBAParser . SetStmtContext > ( ) ;
159- return ( reference . IsAssignment && setStmtContext ? . SET ( ) != null ) ;
160- }
161-
162- private static string GetRHSIdentifierExpressionText ( VBAParser . LetStmtContext letStmtContext )
163- {
164- var expression = letStmtContext . expression ( ) ;
165- return expression is VBAParser . LExprContext ? expression . GetText ( ) : string . Empty ;
166- }
167-
168- private static bool RHSUsesNew ( VBAParser . LetStmtContext letStmtContext )
169- {
170- var expression = letStmtContext . expression ( ) ;
171- return ( expression is VBAParser . NewExprContext ) ;
172- }
173-
174- private static bool RHSIsLiteral ( VBAParser . LetStmtContext letStmtContext )
175- {
176- return letStmtContext . expression ( ) is VBAParser . LiteralExprContext ;
177- }
178-
179- private static bool RHSIsObjectLiteral ( VBAParser . LetStmtContext letStmtContext )
180- {
181- var rhsAsLiteralExpr = letStmtContext . expression ( ) as VBAParser . LiteralExprContext ;
182- return rhsAsLiteralExpr ? . literalExpression ( ) ? . literalIdentifier ( ) ? . objectLiteralIdentifier ( ) != null ;
183- }
184193 }
185194}
0 commit comments