Skip to content

Commit 0bda237

Browse files
authored
Merge pull request #4568 from MDoerner/FixIllegalAnnotationInspection
Fix illegal annotation inspection
2 parents 3a6aee5 + fbbe89e commit 0bda237

File tree

11 files changed

+478
-197
lines changed

11 files changed

+478
-197
lines changed

Rubberduck.CodeAnalysis/Inspections/Concrete/IllegalAnnotationInspection.cs

Lines changed: 1 addition & 67 deletions
Original file line numberDiff line numberDiff line change
@@ -20,18 +20,11 @@ public IllegalAnnotationInspection(RubberduckParserState state)
2020

2121
protected override IEnumerable<IInspectionResult> DoGetInspectionResults()
2222
{
23-
var illegalAnnotations = new List<IAnnotation>();
24-
2523
var userDeclarations = State.DeclarationFinder.AllUserDeclarations.ToList();
2624
var identifierReferences = State.DeclarationFinder.AllIdentifierReferences().ToList();
2725
var annotations = State.AllAnnotations;
2826

29-
illegalAnnotations.AddRange(UnboundAnnotations(annotations, userDeclarations, identifierReferences));
30-
illegalAnnotations.AddRange(NonIdentifierAnnotationsOnIdentifiers(identifierReferences));
31-
illegalAnnotations.AddRange(NonModuleAnnotationsOnModules(userDeclarations));
32-
illegalAnnotations.AddRange(NonMemberAnnotationsOnMembers(userDeclarations));
33-
illegalAnnotations.AddRange(NonVariableAnnotationsOnVariables(userDeclarations));
34-
illegalAnnotations.AddRange(NonGeneralAnnotationsWhereOnlyGeneralAnnotationsBelong(userDeclarations));
27+
var illegalAnnotations = UnboundAnnotations(annotations, userDeclarations, identifierReferences);
3528

3629
return illegalAnnotations.Select(annotation =>
3730
new QualifiedContextInspectionResult(
@@ -50,64 +43,5 @@ private static ICollection<IAnnotation> UnboundAnnotations(IEnumerable<IAnnotati
5043

5144
return annotations.Where(annotation => !boundAnnotationsSelections.Contains(annotation.QualifiedSelection)).ToList();
5245
}
53-
54-
private static ICollection<IAnnotation> NonIdentifierAnnotationsOnIdentifiers(IEnumerable<IdentifierReference> identifierReferences)
55-
{
56-
return identifierReferences
57-
.SelectMany(reference => reference.Annotations)
58-
.Where(annotation => !annotation.AnnotationType.HasFlag(AnnotationType.IdentifierAnnotation))
59-
.ToList();
60-
}
61-
62-
private static ICollection<IAnnotation> NonModuleAnnotationsOnModules(IEnumerable<Declaration> userDeclarations)
63-
{
64-
return userDeclarations
65-
.Where(declaration => declaration.DeclarationType.HasFlag(DeclarationType.Module))
66-
.SelectMany(moduleDeclaration => moduleDeclaration.Annotations)
67-
.Where(annotation => !annotation.AnnotationType.HasFlag(AnnotationType.ModuleAnnotation))
68-
.ToList();
69-
}
70-
71-
private static ICollection<IAnnotation> NonMemberAnnotationsOnMembers(IEnumerable<Declaration> userDeclarations)
72-
{
73-
return userDeclarations
74-
.Where(declaration => declaration.DeclarationType.HasFlag(DeclarationType.Member))
75-
.SelectMany(member => member.Annotations)
76-
.Where(annotation => !annotation.AnnotationType.HasFlag(AnnotationType.MemberAnnotation))
77-
.ToList();
78-
}
79-
80-
private static ICollection<IAnnotation> NonVariableAnnotationsOnVariables(IEnumerable<Declaration> userDeclarations)
81-
{
82-
return userDeclarations
83-
.Where(declaration => VariableAnnotationDeclarationTypes.Contains(declaration.DeclarationType))
84-
.SelectMany(declaration => declaration.Annotations)
85-
.Where(annotation => !annotation.AnnotationType.HasFlag(AnnotationType.VariableAnnotation))
86-
.ToList();
87-
}
88-
89-
private static readonly HashSet<DeclarationType> VariableAnnotationDeclarationTypes = new HashSet<DeclarationType>()
90-
{
91-
DeclarationType.Variable,
92-
DeclarationType.Control,
93-
DeclarationType.Constant,
94-
DeclarationType.Enumeration,
95-
DeclarationType.EnumerationMember,
96-
DeclarationType.UserDefinedType,
97-
DeclarationType.UserDefinedType,
98-
DeclarationType.UserDefinedTypeMember
99-
};
100-
101-
private static ICollection<IAnnotation> NonGeneralAnnotationsWhereOnlyGeneralAnnotationsBelong(IEnumerable<Declaration> userDeclarations)
102-
{
103-
return userDeclarations
104-
.Where(declaration => !declaration.DeclarationType.HasFlag(DeclarationType.Module)
105-
&& !declaration.DeclarationType.HasFlag(DeclarationType.Member)
106-
&& !VariableAnnotationDeclarationTypes.Contains(declaration.DeclarationType)
107-
&& declaration.DeclarationType != DeclarationType.Project)
108-
.SelectMany(member => member.Annotations)
109-
.Where(annotation => !annotation.AnnotationType.HasFlag(AnnotationType.GeneralAnnotation))
110-
.ToList();
111-
}
11246
}
11347
}

Rubberduck.Parsing/Annotations/AnnotationService.cs renamed to Rubberduck.Parsing/Annotations/IdentifierAnnotationService.cs

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -1,16 +1,15 @@
1-
using Rubberduck.Parsing.Symbols;
2-
using Rubberduck.VBEditor;
1+
using Rubberduck.VBEditor;
32
using System.Collections.Generic;
43
using System.Linq;
54
using Rubberduck.Parsing.VBA.DeclarationCaching;
65

76
namespace Rubberduck.Parsing.Annotations
87
{
9-
public sealed class AnnotationService
8+
public sealed class IdentifierAnnotationService
109
{
1110
private readonly DeclarationFinder _declarationFinder;
1211

13-
public AnnotationService(DeclarationFinder declarationFinder)
12+
public IdentifierAnnotationService(DeclarationFinder declarationFinder)
1413
{
1514
_declarationFinder = declarationFinder;
1615
}
@@ -22,13 +21,15 @@ public IEnumerable<IAnnotation> FindAnnotations(QualifiedModuleName module, int
2221
// VBE 1-based indexing
2322
for (var currentLine = line - 1; currentLine >= 1; currentLine--)
2423
{
24+
//Identifier annotation sections end at the first line above without an identifier annotation.
2525
if (!moduleAnnotations.Any(annotation => annotation.QualifiedSelection.Selection.StartLine <= currentLine
26-
&& annotation.QualifiedSelection.Selection.EndLine >= currentLine))
26+
&& annotation.QualifiedSelection.Selection.EndLine >= currentLine
27+
&& annotation.AnnotationType.HasFlag(AnnotationType.IdentifierAnnotation)))
2728
{
2829
break;
2930
}
3031

31-
var annotationsStartingOnCurrentLine = moduleAnnotations.Where(a => a.QualifiedSelection.Selection.StartLine == currentLine);
32+
var annotationsStartingOnCurrentLine = moduleAnnotations.Where(a => a.QualifiedSelection.Selection.StartLine == currentLine && a.AnnotationType.HasFlag(AnnotationType.IdentifierAnnotation));
3233

3334
annotations.AddRange(annotationsStartingOnCurrentLine);
3435
}

Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs

Lines changed: 7 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -23,7 +23,7 @@ public sealed class IdentifierReferenceResolver
2323
private Declaration _currentParent;
2424
private readonly BindingService _bindingService;
2525
private readonly BoundExpressionVisitor _boundExpressionVisitor;
26-
private readonly AnnotationService _annotationService;
26+
private readonly IdentifierAnnotationService _identifierAnnotationService;
2727
private static readonly Logger Logger = LogManager.GetCurrentClassLogger();
2828

2929
public IdentifierReferenceResolver(QualifiedModuleName qualifiedModuleName, DeclarationFinder finder)
@@ -44,8 +44,8 @@ public IdentifierReferenceResolver(QualifiedModuleName qualifiedModuleName, Decl
4444
new DefaultBindingContext(_declarationFinder, typeBindingContext, procedurePointerBindingContext),
4545
typeBindingContext,
4646
procedurePointerBindingContext);
47-
_annotationService = new AnnotationService(_declarationFinder);
48-
_boundExpressionVisitor = new BoundExpressionVisitor(_annotationService);
47+
_identifierAnnotationService = new IdentifierAnnotationService(_declarationFinder);
48+
_boundExpressionVisitor = new BoundExpressionVisitor(_identifierAnnotationService);
4949
}
5050

5151
public void SetCurrentScope()
@@ -153,7 +153,7 @@ private void ResolveLabel(ParserRuleContext context, string label)
153153
identifier,
154154
callee,
155155
callSiteContext.GetSelection(),
156-
_annotationService.FindAnnotations(_qualifiedModuleName, callSiteContext.GetSelection().StartLine));
156+
_identifierAnnotationService.FindAnnotations(_qualifiedModuleName, callSiteContext.GetSelection().StartLine));
157157
}
158158
}
159159

@@ -713,7 +713,7 @@ public void Resolve(VBAParser.RaiseEventStmtContext context)
713713
identifier,
714714
callee,
715715
callSiteContext.GetSelection(),
716-
_annotationService.FindAnnotations(_qualifiedModuleName, callSiteContext.GetSelection().StartLine));
716+
_identifierAnnotationService.FindAnnotations(_qualifiedModuleName, callSiteContext.GetSelection().StartLine));
717717
}
718718
if (context.eventArgumentList() == null)
719719
{
@@ -819,7 +819,7 @@ public void Resolve(VBAParser.DebugPrintStmtContext context)
819819
context.debugPrint().debugModule().GetText(),
820820
debugModule,
821821
context.debugPrint().debugModule().GetSelection(),
822-
_annotationService.FindAnnotations(_qualifiedModuleName, context.debugPrint().debugModule().GetSelection().StartLine));
822+
_identifierAnnotationService.FindAnnotations(_qualifiedModuleName, context.debugPrint().debugModule().GetSelection().StartLine));
823823
debugPrint.AddReference(
824824
_qualifiedModuleName,
825825
_currentScope,
@@ -828,7 +828,7 @@ public void Resolve(VBAParser.DebugPrintStmtContext context)
828828
context.debugPrint().debugPrintSub().GetText(),
829829
debugPrint,
830830
context.debugPrint().debugPrintSub().GetSelection(),
831-
_annotationService.FindAnnotations(_qualifiedModuleName, context.debugPrint().debugPrintSub().GetSelection().StartLine));
831+
_identifierAnnotationService.FindAnnotations(_qualifiedModuleName, context.debugPrint().debugPrintSub().GetSelection().StartLine));
832832
var outputList = context.outputList();
833833
if (outputList != null)
834834
{

Rubberduck.Parsing/VBA/DeclarationCaching/DeclarationFinder.cs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -22,7 +22,7 @@ public class DeclarationFinder
2222
private static readonly Logger Logger = LogManager.GetCurrentClassLogger();
2323

2424
private readonly IHostApplication _hostApp;
25-
private readonly AnnotationService _annotationService;
25+
private readonly IdentifierAnnotationService _identifierAnnotationService;
2626
private IDictionary<string, List<Declaration>> _declarationsByName;
2727
private IDictionary<QualifiedModuleName, List<Declaration>> _declarations;
2828
private readonly ConcurrentDictionary<QualifiedMemberName, ConcurrentBag<Declaration>> _newUndeclared;
@@ -68,7 +68,7 @@ public DeclarationFinder(IReadOnlyList<Declaration> declarations, IEnumerable<IA
6868
_newUndeclared = new ConcurrentDictionary<QualifiedMemberName, ConcurrentBag<Declaration>>(new Dictionary<QualifiedMemberName, ConcurrentBag<Declaration>>());
6969
_newUnresolved = new ConcurrentBag<UnboundMemberDeclaration>(new List<UnboundMemberDeclaration>());
7070

71-
_annotationService = new AnnotationService(this);
71+
_identifierAnnotationService = new IdentifierAnnotationService(this);
7272

7373
var collectionConstructionActions = CollectionConstructionActions(declarations, annotations, unresolvedMemberDeclarations);
7474
ExecuteCollectionConstructionActions(collectionConstructionActions);
@@ -804,7 +804,7 @@ public Declaration FindMemberEnclosingProcedure(Declaration enclosingProcedure,
804804

805805
public Declaration OnUndeclaredVariable(Declaration enclosingProcedure, string identifierName, ParserRuleContext context)
806806
{
807-
var annotations = _annotationService.FindAnnotations(enclosingProcedure.QualifiedName.QualifiedModuleName, context.Start.Line);
807+
var annotations = _identifierAnnotationService.FindAnnotations(enclosingProcedure.QualifiedName.QualifiedModuleName, context.Start.Line);
808808
var undeclaredLocal =
809809
new Declaration(
810810
new QualifiedMemberName(enclosingProcedure.QualifiedName.QualifiedModuleName, identifierName),
@@ -859,7 +859,7 @@ public void AddUnboundContext(Declaration parentDeclaration, VBAParser.LExpressi
859859
}
860860

861861
var identifier = context.GetChild<VBAParser.UnrestrictedIdentifierContext>(0);
862-
var annotations = _annotationService.FindAnnotations(parentDeclaration.QualifiedName.QualifiedModuleName, context.Start.Line);
862+
var annotations = _identifierAnnotationService.FindAnnotations(parentDeclaration.QualifiedName.QualifiedModuleName, context.Start.Line);
863863

864864
var declaration = new UnboundMemberDeclaration(parentDeclaration, identifier,
865865
(context is VBAParser.MemberAccessExprContext) ? (ParserRuleContext)context.children[0] : withExpression.Context,

Rubberduck.Parsing/VBA/DeclarationResolving/DeclarationResolveRunnerBase.cs

Lines changed: 11 additions & 35 deletions
Original file line numberDiff line numberDiff line change
@@ -159,12 +159,6 @@ protected void ResolveDeclarations(QualifiedModuleName module, IParseTree tree,
159159
{
160160
_state.AddDeclaration(createdDeclaration);
161161
}
162-
163-
//This is a hack to deal with annotations on module level variables.
164-
var memberAnnotations = declarationsListener.CreatedDeclarations
165-
.SelectMany(declaration => declaration.Annotations)
166-
.ToHashSet();
167-
moduleDeclaration.RemoveAnnotations(memberAnnotations);
168162
}
169163
catch (Exception exception)
170164
{
@@ -235,43 +229,25 @@ private static IEnumerable<IAnnotation> FindModuleAnnotations(IParseTree tree, I
235229
return null;
236230
}
237231

238-
var lastDeclarationsSectionLine = LastDeclarationsSectionLine(tree, annotations);
232+
var potentialModuleAnnotations = annotations.Where(annotation =>
233+
annotation.AnnotationType.HasFlag(AnnotationType.ModuleAnnotation));
234+
235+
var lastPossibleDeclarationsSectionLine = LastPossibleDeclarationsSectionLine(tree);
239236

240237
//There is no module body.
241-
if (lastDeclarationsSectionLine == null)
238+
if (lastPossibleDeclarationsSectionLine == null)
242239
{
243-
return annotations;
240+
return potentialModuleAnnotations;
244241
}
245242

246-
var lastPossibleModuleAnnotationLine = lastDeclarationsSectionLine.Value;
247-
var moduleAnnotations = annotations.Where(annotation => annotation.QualifiedSelection.Selection.EndLine <= lastPossibleModuleAnnotationLine);
248-
return moduleAnnotations.ToList();
243+
var lastPossibleModuleAnnotationLine = lastPossibleDeclarationsSectionLine.Value;
244+
var moduleAnnotations = potentialModuleAnnotations.Where(annotation => annotation.QualifiedSelection.Selection.EndLine <= lastPossibleModuleAnnotationLine);
245+
return moduleAnnotations;
249246
}
250247

251-
private static int? LastDeclarationsSectionLine(IParseTree tree, ICollection<IAnnotation> annotations)
248+
private static int? LastPossibleDeclarationsSectionLine(IParseTree tree)
252249
{
253-
var firstModuleBodyElementLine = FirstModuleBodyElementLine(tree);
254-
255-
if (firstModuleBodyElementLine == null)
256-
{
257-
return null;
258-
}
259-
260-
//The VBE uses 1-based lines.
261-
for (var currentLine = firstModuleBodyElementLine.Value - 1; currentLine >= 1; currentLine--)
262-
{
263-
if (annotations.Any(annotation => annotation.QualifiedSelection.Selection.StartLine <= currentLine
264-
&& annotation.QualifiedSelection.Selection.EndLine >=
265-
currentLine))
266-
{
267-
continue;
268-
}
269-
270-
return currentLine;
271-
}
272-
273-
//There is no declaration section.
274-
return 0;
250+
return FirstModuleBodyElementLine(tree) - 1;
275251
}
276252

277253
private static int? FirstModuleBodyElementLine(IParseTree tree)

0 commit comments

Comments
 (0)