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 . Grammar ;
7
+ using Rubberduck . Parsing . Inspections ;
8
+ using Rubberduck . Parsing . Inspections . Abstract ;
9
+ using Rubberduck . Parsing . Symbols ;
10
+ using Rubberduck . Parsing . TypeResolvers ;
11
+ using Rubberduck . Parsing . VBA ;
12
+ using Rubberduck . Parsing . VBA . DeclarationCaching ;
13
+ using Rubberduck . Resources . Inspections ;
14
+ using Rubberduck . VBEditor ;
15
+
16
+ namespace Rubberduck . CodeAnalysis . Inspections . Concrete
17
+ {
18
+ public class ArgumentWithIncompatibleObjectTypeInspection : InspectionBase
19
+ {
20
+ private readonly IDeclarationFinderProvider _declarationFinderProvider ;
21
+ private readonly ISetTypeResolver _setTypeResolver ;
22
+
23
+ /// <summary>
24
+ /// Locates arguments passed to functions or procedures for object parameters which the do not have a compatible declared type.
25
+ /// </summary>
26
+ /// <why>
27
+ /// The VBA compiler does not check whether different object types are compatible. Instead there is a runtime error whenever the types are incompatible.
28
+ /// </why>
29
+ /// <example hasResult="true">
30
+ /// <![CDATA[
31
+ /// IInterface:
32
+ ///
33
+ /// Public Sub DoSomething()
34
+ /// End Sub
35
+ ///
36
+ /// ------------------------------
37
+ /// Class1:
38
+ ///
39
+ ///'No Implements IInterface
40
+ ///
41
+ /// Public Sub DoSomething()
42
+ /// End Sub
43
+ ///
44
+ /// ------------------------------
45
+ /// Module1:
46
+ ///
47
+ /// Public Sub DoIt()
48
+ /// Dim cls As Class1
49
+ /// Set cls = New Class1
50
+ /// Foo cls
51
+ /// End Sub
52
+ ///
53
+ /// Public Sub Foo(cls As IInterface)
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
+ /// Set cls = New Class1
78
+ /// Foo cls
79
+ /// End Sub
80
+ ///
81
+ /// Public Sub Foo(cls As IInterface)
82
+ /// End Sub
83
+ /// ]]>
84
+ /// </example>
85
+ public ArgumentWithIncompatibleObjectTypeInspection ( RubberduckParserState state , ISetTypeResolver setTypeResolver )
86
+ : base ( state )
87
+ {
88
+ _declarationFinderProvider = state ;
89
+ _setTypeResolver = setTypeResolver ;
90
+
91
+ //This will most likely cause a runtime error. The exceptions are rare and should be refactored or made explicit with an @Ignore annotation.
92
+ Severity = CodeInspectionSeverity . Error ;
93
+ }
94
+
95
+ protected override IEnumerable < IInspectionResult > DoGetInspectionResults ( )
96
+ {
97
+ var finder = _declarationFinderProvider . DeclarationFinder ;
98
+
99
+ var strictlyTypedObjectParameters = finder . DeclarationsWithType ( DeclarationType . Parameter )
100
+ . Where ( ToBeConsidered )
101
+ . OfType < ParameterDeclaration > ( ) ;
102
+
103
+ var offendingArguments = strictlyTypedObjectParameters
104
+ . SelectMany ( param => param . ArgumentReferences )
105
+ . Select ( argumentReference => ArgumentReferenceWithArgumentTypeName ( argumentReference , finder ) )
106
+ . Where ( argumentReferenceWithTypeName => argumentReferenceWithTypeName . argumentTypeName != null
107
+ && ! ArgumentPossiblyLegal (
108
+ argumentReferenceWithTypeName . argumentReference . Declaration ,
109
+ argumentReferenceWithTypeName . argumentTypeName ) ) ;
110
+
111
+ return offendingArguments
112
+ . Where ( argumentReferenceWithTypeName => ! IsIgnored ( argumentReferenceWithTypeName . Item1 ) )
113
+ . Select ( argumentReference => InspectionResult ( argumentReference , _declarationFinderProvider ) ) ;
114
+ }
115
+
116
+ private static bool ToBeConsidered ( Declaration declaration )
117
+ {
118
+ return declaration != null
119
+ && declaration . AsTypeDeclaration != null
120
+ && declaration . IsObject ;
121
+ }
122
+
123
+ private ( IdentifierReference argumentReference , string argumentTypeName ) ArgumentReferenceWithArgumentTypeName ( IdentifierReference argumentReference , DeclarationFinder finder )
124
+ {
125
+ return ( argumentReference , ArgumentSetTypeName ( argumentReference , finder ) ) ;
126
+ }
127
+
128
+ private string ArgumentSetTypeName ( IdentifierReference argumentReference , DeclarationFinder finder )
129
+ {
130
+ var argumentExpression = argumentReference . Context as VBAParser . ExpressionContext ;
131
+ return SetTypeNameOfExpression ( argumentExpression , argumentReference . QualifiedModuleName , finder ) ;
132
+ }
133
+
134
+ private string SetTypeNameOfExpression ( VBAParser . ExpressionContext expression , QualifiedModuleName containingModule , DeclarationFinder finder )
135
+ {
136
+ return _setTypeResolver . SetTypeName ( expression , containingModule ) ;
137
+ }
138
+
139
+ private bool ArgumentPossiblyLegal ( Declaration parameterDeclaration , string assignedTypeName )
140
+ {
141
+ return assignedTypeName == parameterDeclaration . FullAsTypeName
142
+ || assignedTypeName == Tokens . Variant
143
+ || assignedTypeName == Tokens . Object
144
+ || HasBaseType ( parameterDeclaration , assignedTypeName )
145
+ || HasSubType ( parameterDeclaration , assignedTypeName ) ;
146
+ }
147
+
148
+ private bool HasBaseType ( Declaration declaration , string typeName )
149
+ {
150
+ var ownType = declaration . AsTypeDeclaration ;
151
+ if ( ownType == null || ! ( ownType is ClassModuleDeclaration classType ) )
152
+ {
153
+ return false ;
154
+ }
155
+
156
+ return classType . Subtypes . Select ( subtype => subtype . QualifiedModuleName . ToString ( ) ) . Contains ( typeName ) ;
157
+ }
158
+
159
+ private bool HasSubType ( Declaration declaration , string typeName )
160
+ {
161
+ var ownType = declaration . AsTypeDeclaration ;
162
+ if ( ownType == null || ! ( ownType is ClassModuleDeclaration classType ) )
163
+ {
164
+ return false ;
165
+ }
166
+
167
+ return classType . Supertypes . Select ( supertype => supertype . QualifiedModuleName . ToString ( ) ) . Contains ( typeName ) ;
168
+ }
169
+
170
+ private bool IsIgnored ( IdentifierReference assignment )
171
+ {
172
+ return assignment . IsIgnoringInspectionResultFor ( AnnotationName )
173
+ // Ignoring the Declaration disqualifies all assignments
174
+ || assignment . Declaration . IsIgnoringInspectionResultFor ( AnnotationName ) ;
175
+ }
176
+
177
+ private IInspectionResult InspectionResult ( ( IdentifierReference argumentReference , string argumentTypeName ) argumentReferenceWithTypeName , IDeclarationFinderProvider declarationFinderProvider )
178
+ {
179
+ var ( argumentReference , argumentTypeName ) = argumentReferenceWithTypeName ;
180
+ return new IdentifierReferenceInspectionResult ( this ,
181
+ ResultDescription ( argumentReference , argumentTypeName ) ,
182
+ declarationFinderProvider ,
183
+ argumentReference ) ;
184
+ }
185
+
186
+ private string ResultDescription ( IdentifierReference argumentReference , string argumentTypeName )
187
+ {
188
+ var parameterName = argumentReference . Declaration . IdentifierName ;
189
+ var parameterTypeName = argumentReference . Declaration . FullAsTypeName ;
190
+ var argumentExpression = argumentReference . Context . GetText ( ) ;
191
+ return string . Format ( InspectionResults . SetAssignmentWithIncompatibleObjectTypeInspection , parameterName , parameterTypeName , argumentExpression , argumentTypeName ) ;
192
+ }
193
+ }
194
+ }
0 commit comments