1+ using System . Collections . Generic ;
2+ using System . Linq ;
3+ using Rubberduck . Inspections . Abstract ;
4+ using Rubberduck . Inspections . Inspections . Extensions ;
5+ using Rubberduck . Inspections . Results ;
6+ using Rubberduck . Parsing ;
7+ using Rubberduck . Parsing . Grammar ;
8+ using Rubberduck . Parsing . Inspections ;
9+ using Rubberduck . Parsing . Inspections . Abstract ;
10+ using Rubberduck . Parsing . Symbols ;
11+ using Rubberduck . Parsing . TypeResolvers ;
12+ using Rubberduck . Parsing . VBA ;
13+ using Rubberduck . Parsing . VBA . DeclarationCaching ;
14+ using Rubberduck . Resources . Inspections ;
15+ using Rubberduck . VBEditor ;
16+
17+ namespace Rubberduck . CodeAnalysis . Inspections . Concrete
18+ {
19+ public class SetAssignmentWithIncompatibleObjectTypeInspection : InspectionBase
20+ {
21+ private readonly IDeclarationFinderProvider _declarationFinderProvider ;
22+ private readonly ISetTypeResolver _setTypeResolver ;
23+
24+ /// <summary>
25+ /// Locates assignments to object variables for which the RHS does not have a compatible declared type.
26+ /// </summary>
27+ /// <why>
28+ /// The VBA compiler does not check whether different object types are compatible. Instead there is a runtime error whenever the types are incompatible.
29+ /// </why>
30+ /// <example hasResult="true">
31+ /// <![CDATA[
32+ /// IInterface:
33+ ///
34+ /// Public Sub DoSomething()
35+ /// End Sub
36+ ///
37+ /// ------------------------------
38+ /// Class1:
39+ ///
40+ ///'No Implements IInterface
41+ ///
42+ /// Public Sub DoSomething()
43+ /// End Sub
44+ ///
45+ /// ------------------------------
46+ /// Module1:
47+ ///
48+ /// Public Sub DoIt()
49+ /// Dim cls As Class1
50+ /// Dim intrfc As IInterface
51+ ///
52+ /// Set cls = New Class1
53+ /// Set intrfc = cls
54+ /// End Sub
55+ /// ]]>
56+ /// </example>
57+ /// <example hasResult="false">
58+ /// <![CDATA[
59+ /// IInterface:
60+ ///
61+ /// Public Sub DoSomething()
62+ /// End Sub
63+ ///
64+ /// ------------------------------
65+ /// Class1:
66+ ///
67+ /// Implements IInterface
68+ ///
69+ /// Private Sub IInterface_DoSomething()
70+ /// End Sub
71+ ///
72+ /// ------------------------------
73+ /// Module1:
74+ ///
75+ /// Public Sub DoIt()
76+ /// Dim cls As Class1
77+ /// Dim intrfc As IInterface
78+ ///
79+ /// Set cls = New Class1
80+ /// Set intrfc = cls
81+ /// End Sub
82+ /// ]]>
83+ /// </example>
84+ public SetAssignmentWithIncompatibleObjectTypeInspection ( RubberduckParserState state , ISetTypeResolver setTypeResolver )
85+ : base ( state )
86+ {
87+ _declarationFinderProvider = state ;
88+ _setTypeResolver = setTypeResolver ;
89+
90+ //This will most likely cause a runtime error. The exceptions are rare and should be refactored or made explicit with an @Ignore annotation.
91+ Severity = CodeInspectionSeverity . Error ;
92+ }
93+
94+ protected override IEnumerable < IInspectionResult > DoGetInspectionResults ( )
95+ {
96+ var finder = _declarationFinderProvider . DeclarationFinder ;
97+
98+ var setAssignments = finder . AllIdentifierReferences ( ) . Where ( reference => reference . IsSetAssignment ) ;
99+
100+ var offendingAssignments = setAssignments
101+ . Where ( ToBeConsidered )
102+ . Select ( setAssignment => SetAssignmentWithAssignedTypeName ( setAssignment , finder ) )
103+ . Where ( setAssignmentWithAssignedTypeName => setAssignmentWithAssignedTypeName . assignedTypeName != null
104+ && ! SetAssignmentPossiblyLegal ( setAssignmentWithAssignedTypeName ) ) ;
105+
106+ return offendingAssignments
107+ . Where ( setAssignmentWithAssignedTypeName => ! IsIgnored ( setAssignmentWithAssignedTypeName . setAssignment ) )
108+ . Select ( setAssignmentWithAssignedTypeName => InspectionResult ( setAssignmentWithAssignedTypeName , _declarationFinderProvider ) ) ;
109+ }
110+
111+ private static bool ToBeConsidered ( IdentifierReference reference )
112+ {
113+ var declaration = reference . Declaration ;
114+ return declaration != null
115+ && declaration . AsTypeDeclaration != null
116+ && declaration . IsObject ;
117+ }
118+
119+ private ( IdentifierReference setAssignment , string assignedTypeName ) SetAssignmentWithAssignedTypeName ( IdentifierReference setAssignment , DeclarationFinder finder )
120+ {
121+ return ( setAssignment , SetTypeNameOfExpression ( RHS ( setAssignment ) , setAssignment . QualifiedModuleName , finder ) ) ;
122+ }
123+
124+ private VBAParser . ExpressionContext RHS ( IdentifierReference setAssignment )
125+ {
126+ return setAssignment . Context . GetAncestor < VBAParser . SetStmtContext > ( ) . expression ( ) ;
127+ }
128+
129+ private string SetTypeNameOfExpression ( VBAParser . ExpressionContext expression , QualifiedModuleName containingModule , DeclarationFinder finder )
130+ {
131+ return _setTypeResolver . SetTypeName ( expression , containingModule ) ;
132+ }
133+
134+ private bool SetAssignmentPossiblyLegal ( ( IdentifierReference setAssignment , string assignedTypeName ) setAssignmentWithAssignedType )
135+ {
136+ var ( setAssignment , assignedTypeName ) = setAssignmentWithAssignedType ;
137+
138+ return SetAssignmentPossiblyLegal ( setAssignment . Declaration , assignedTypeName ) ;
139+ }
140+
141+ private bool SetAssignmentPossiblyLegal ( Declaration declaration , string assignedTypeName )
142+ {
143+ return assignedTypeName == declaration . FullAsTypeName
144+ || assignedTypeName == Tokens . Variant
145+ || assignedTypeName == Tokens . Object
146+ || HasBaseType ( declaration , assignedTypeName )
147+ || HasSubType ( declaration , assignedTypeName ) ;
148+ }
149+
150+ private bool HasBaseType ( Declaration declaration , string typeName )
151+ {
152+ var ownType = declaration . AsTypeDeclaration ;
153+ if ( ownType == null || ! ( ownType is ClassModuleDeclaration classType ) )
154+ {
155+ return false ;
156+ }
157+
158+ return classType . Subtypes . Select ( subtype => subtype . QualifiedModuleName . ToString ( ) ) . Contains ( typeName ) ;
159+ }
160+
161+ private bool HasSubType ( Declaration declaration , string typeName )
162+ {
163+ var ownType = declaration . AsTypeDeclaration ;
164+ if ( ownType == null || ! ( ownType is ClassModuleDeclaration classType ) )
165+ {
166+ return false ;
167+ }
168+
169+ return classType . Supertypes . Select ( supertype => supertype . QualifiedModuleName . ToString ( ) ) . Contains ( typeName ) ;
170+ }
171+
172+ private bool IsIgnored ( IdentifierReference assignment )
173+ {
174+ return assignment . IsIgnoringInspectionResultFor ( AnnotationName )
175+ // Ignoring the Declaration disqualifies all assignments
176+ || assignment . Declaration . IsIgnoringInspectionResultFor ( AnnotationName ) ;
177+ }
178+
179+ private IInspectionResult InspectionResult ( ( IdentifierReference setAssignment , string assignedTypeName ) setAssignmentWithAssignedType , IDeclarationFinderProvider declarationFinderProvider )
180+ {
181+ var ( setAssignment , assignedTypeName ) = setAssignmentWithAssignedType ;
182+ return new IdentifierReferenceInspectionResult ( this ,
183+ ResultDescription ( setAssignment , assignedTypeName ) ,
184+ declarationFinderProvider ,
185+ setAssignment ) ;
186+ }
187+
188+ private string ResultDescription ( IdentifierReference setAssignment , string assignedTypeName )
189+ {
190+ var declarationName = setAssignment . Declaration . IdentifierName ;
191+ var variableTypeName = setAssignment . Declaration . FullAsTypeName ;
192+ return string . Format ( InspectionResults . SetAssignmentWithIncompatibleObjectTypeInspection , declarationName , variableTypeName , assignedTypeName ) ;
193+ }
194+ }
195+ }
0 commit comments