@@ -112,7 +112,7 @@ public void EnterWithBlock(VBAParser.WithStmtContext context)
112
112
}
113
113
else
114
114
{
115
- // qualifier = ResolveType(typeContext.complexType());
115
+ qualifier = ResolveType ( typeContext . complexType ( ) ) ;
116
116
}
117
117
}
118
118
@@ -160,11 +160,11 @@ private void ResolveType(VBAParser.ICS_S_MembersCallContext context)
160
160
ResolveType ( identifiers ) ;
161
161
}
162
162
163
- private void ResolveType ( VBAParser . ComplexTypeContext context )
163
+ private Declaration ResolveType ( VBAParser . ComplexTypeContext context )
164
164
{
165
165
if ( context == null )
166
166
{
167
- return ;
167
+ return null ;
168
168
}
169
169
170
170
var identifiers = context . ambiguousIdentifier ( )
@@ -175,19 +175,19 @@ private void ResolveType(VBAParser.ComplexTypeContext context)
175
175
if ( identifiers . Count == 1 )
176
176
{
177
177
var type = ResolveInScopeType ( identifiers . Single ( ) . GetText ( ) , _currentScope ) ;
178
- if ( type != null )
178
+ if ( type != null && ! _alreadyResolved . Contains ( context ) )
179
179
{
180
180
type . AddReference ( CreateReference ( context , type ) ) ;
181
181
_alreadyResolved . Add ( context ) ;
182
182
}
183
- return ;
183
+ return type ;
184
184
}
185
185
186
186
// if there's 2 or more identifiers, resolve to the deepest path:
187
- ResolveType ( identifiers ) ;
187
+ return ResolveType ( identifiers ) ;
188
188
}
189
189
190
- private void ResolveType ( IList < VBAParser . AmbiguousIdentifierContext > identifiers )
190
+ private Declaration ResolveType ( IList < VBAParser . AmbiguousIdentifierContext > identifiers )
191
191
{
192
192
var first = identifiers [ 0 ] . GetText ( ) ;
193
193
var projectMatch = _declarationFinder . FindProject ( _currentScope , first ) ;
@@ -214,38 +214,56 @@ private void ResolveType(IList<VBAParser.AmbiguousIdentifierContext> identifiers
214
214
{
215
215
var udtReference = CreateReference ( identifiers [ 2 ] , udtMatch ) ;
216
216
217
- projectMatch . AddReference ( projectReference ) ;
218
- _alreadyResolved . Add ( projectReference . Context ) ;
219
-
220
- moduleMatch . AddReference ( moduleReference ) ;
221
- _alreadyResolved . Add ( moduleReference . Context ) ;
222
-
223
- udtMatch . AddReference ( udtReference ) ;
224
- _alreadyResolved . Add ( udtReference . Context ) ;
225
-
226
- return ;
217
+ if ( ! _alreadyResolved . Contains ( projectReference . Context ) )
218
+ {
219
+ projectMatch . AddReference ( projectReference ) ;
220
+ _alreadyResolved . Add ( projectReference . Context ) ;
221
+ }
222
+
223
+ if ( ! _alreadyResolved . Contains ( moduleReference . Context ) )
224
+ {
225
+ moduleMatch . AddReference ( moduleReference ) ;
226
+ _alreadyResolved . Add ( moduleReference . Context ) ;
227
+ }
228
+
229
+ if ( ! _alreadyResolved . Contains ( udtReference . Context ) )
230
+ {
231
+ udtMatch . AddReference ( udtReference ) ;
232
+ _alreadyResolved . Add ( udtReference . Context ) ;
233
+ }
234
+
235
+ return udtMatch ;
227
236
}
228
237
var enumMatch = _declarationFinder . FindEnum ( moduleMatch , identifiers [ 2 ] . GetText ( ) ) ;
229
238
if ( enumMatch != null )
230
239
{
231
240
var enumReference = CreateReference ( identifiers [ 2 ] , enumMatch ) ;
232
241
233
- projectMatch . AddReference ( projectReference ) ;
234
- _alreadyResolved . Add ( projectReference . Context ) ;
235
-
236
- moduleMatch . AddReference ( moduleReference ) ;
237
- _alreadyResolved . Add ( moduleReference . Context ) ;
238
-
239
- enumMatch . AddReference ( enumReference ) ;
240
- _alreadyResolved . Add ( enumReference . Context ) ;
241
-
242
- return ;
242
+ if ( ! _alreadyResolved . Contains ( projectReference . Context ) )
243
+ {
244
+ projectMatch . AddReference ( projectReference ) ;
245
+ _alreadyResolved . Add ( projectReference . Context ) ;
246
+ }
247
+
248
+ if ( ! _alreadyResolved . Contains ( moduleReference . Context ) )
249
+ {
250
+ moduleMatch . AddReference ( moduleReference ) ;
251
+ _alreadyResolved . Add ( moduleReference . Context ) ;
252
+ }
253
+
254
+ if ( ! _alreadyResolved . Contains ( enumReference . Context ) )
255
+ {
256
+ enumMatch . AddReference ( enumReference ) ;
257
+ _alreadyResolved . Add ( enumReference . Context ) ;
258
+ }
259
+
260
+ return enumMatch ;
243
261
}
244
262
}
245
263
}
246
264
else
247
265
{
248
- if ( projectReference != null )
266
+ if ( projectReference != null && ! _alreadyResolved . Contains ( projectReference . Context ) )
249
267
{
250
268
projectMatch . AddReference ( projectReference ) ;
251
269
_alreadyResolved . Add ( projectReference . Context ) ;
@@ -257,12 +275,12 @@ private void ResolveType(IList<VBAParser.AmbiguousIdentifierContext> identifiers
257
275
if ( match != null )
258
276
{
259
277
var reference = CreateReference ( identifiers [ 1 ] , match ) ;
260
- if ( reference != null )
278
+ if ( reference != null && ! _alreadyResolved . Contains ( reference . Context ) )
261
279
{
262
280
match . AddReference ( reference ) ;
263
281
_alreadyResolved . Add ( reference . Context ) ;
264
- return ;
265
282
}
283
+ return match ;
266
284
}
267
285
}
268
286
}
@@ -284,14 +302,24 @@ private void ResolveType(IList<VBAParser.AmbiguousIdentifierContext> identifiers
284
302
{
285
303
var reference = CreateReference ( identifiers [ 1 ] , match ) ;
286
304
287
- moduleMatch . AddReference ( moduleReference ) ;
288
- _alreadyResolved . Add ( moduleReference . Context ) ;
305
+ if ( ! _alreadyResolved . Contains ( moduleReference . Context ) )
306
+ {
307
+ moduleMatch . AddReference ( moduleReference ) ;
308
+ _alreadyResolved . Add ( moduleReference . Context ) ;
309
+ }
310
+
311
+ if ( ! _alreadyResolved . Contains ( reference . Context ) )
312
+ {
313
+ match . AddReference ( reference ) ;
314
+ _alreadyResolved . Add ( reference . Context ) ;
315
+ }
289
316
290
- match . AddReference ( reference ) ;
291
- _alreadyResolved . Add ( reference . Context ) ;
317
+ return match ;
292
318
}
293
319
}
294
320
}
321
+
322
+ return null ;
295
323
}
296
324
297
325
private Declaration ResolveInScopeType ( string identifier , Declaration scope )
@@ -379,11 +407,6 @@ private Declaration ResolveInternal(ParserRuleContext callSiteContext, Declarati
379
407
return null ;
380
408
}
381
409
382
- if ( _alreadyResolved . Contains ( callSiteContext ) )
383
- {
384
- return null ;
385
- }
386
-
387
410
if ( ! IdentifierContexts . Contains ( callSiteContext . GetType ( ) ) )
388
411
{
389
412
throw new ArgumentException ( "'" + callSiteContext . GetType ( ) . Name + "' is not an identifier context." , "callSiteContext" ) ;
@@ -440,7 +463,7 @@ private Declaration ResolveInternal(ParserRuleContext callSiteContext, Declarati
440
463
}
441
464
442
465
var reference = CreateReference ( callSiteContext , callee , isAssignmentTarget , hasExplicitLetStatement ) ;
443
- if ( reference != null )
466
+ if ( reference != null && ! _alreadyResolved . Contains ( reference . Context ) )
444
467
{
445
468
callee . AddReference ( reference ) ;
446
469
_alreadyResolved . Add ( reference . Context ) ;
@@ -989,7 +1012,9 @@ private Declaration FindLocalScopeDeclaration(string identifierName, Declaration
989
1012
var matches = _declarationFinder . MatchName ( identifierName ) ;
990
1013
991
1014
var results = matches . Where ( item =>
992
- ( localScope . Equals ( item . ParentScopeDeclaration ) || ( isAssignmentTarget && item . Scope == localScope . Scope ) )
1015
+ ( ( localScope . Equals ( item . ParentDeclaration )
1016
+ || ( item . DeclarationType == DeclarationType . Parameter && localScope . Equals ( item . ParentScopeDeclaration ) ) )
1017
+ || ( isAssignmentTarget && item . Scope == localScope . Scope ) )
993
1018
&& localScope . Context . GetSelection ( ) . Contains ( item . Selection )
994
1019
&& ! _moduleTypes . Contains ( item . DeclarationType ) )
995
1020
. ToList ( ) ;
@@ -1068,10 +1093,9 @@ private Declaration FindProjectScopeDeclaration(string identifierName, Declarati
1068
1093
// the "$" in e.g. "UCase$" isn't picked up as part of the identifierName, so we need to add it manually:
1069
1094
var matches = _declarationFinder . MatchName ( identifierName ) . Where ( item =>
1070
1095
( ! item . IsBuiltIn || item . IdentifierName == identifierName + ( hasStringQualifier ? "$" : string . Empty ) )
1071
- /*&& item.ParentDeclaration.DeclarationType == DeclarationType.Module*/ ) . ToList ( ) ;
1072
-
1073
- // note: we cannot be sure that a class has no PredeclaredId until we can read attributes.
1074
- // for this reason we cannot limit the scope of public members to DeclarationType.Module.
1096
+ && ( ( item . ParentDeclaration . DeclarationType == DeclarationType . Module
1097
+ || item . ParentDeclaration . HasPredeclaredId ) )
1098
+ || item . ParentScopeDeclaration . Equals ( localScope ) ) . ToList ( ) ;
1075
1099
1076
1100
if ( matches . Count == 1 )
1077
1101
{
0 commit comments