Skip to content

Commit ec3fb77

Browse files
authored
Merge branch 'next' into TestCategorization
2 parents fe0351d + a2cbae3 commit ec3fb77

File tree

141 files changed

+17177
-2668
lines changed

Some content is hidden

Large Commits have some content hidden by default. Use the searchbox below for content that may be hidden.

141 files changed

+17177
-2668
lines changed

RetailCoder.VBE/Common/DeclarationExtensions.cs

Lines changed: 3 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -364,8 +364,7 @@ public static IEnumerable<Declaration> FindFormEventHandlers(this RubberduckPars
364364
var items = state.AllDeclarations.ToList();
365365

366366
var forms = items.Where(item => item.DeclarationType == DeclarationType.ClassModule
367-
&& item.QualifiedName.QualifiedModuleName.Component != null
368-
&& item.QualifiedName.QualifiedModuleName.Component.Type == ComponentType.UserForm)
367+
&& item.QualifiedName.QualifiedModuleName.ComponentType == ComponentType.UserForm)
369368
.ToList();
370369

371370
var result = new List<Declaration>();
@@ -426,9 +425,7 @@ public static IEnumerable<Declaration> FindEventProcedures(this IEnumerable<Decl
426425
}
427426

428427
var items = declarations as IList<Declaration> ?? declarations.ToList();
429-
var type = items.SingleOrDefault(item => item.DeclarationType == DeclarationType.ClassModule
430-
&& item.Project != null
431-
&& item.IdentifierName == withEventsDeclaration.AsTypeName.Split('.').Last());
428+
var type = withEventsDeclaration.AsTypeDeclaration;
432429

433430
if (type == null)
434431
{
@@ -449,7 +446,7 @@ public static IEnumerable<Declaration> FindEventProcedures(this IEnumerable<Decl
449446

450447
private static IEnumerable<Declaration> GetTypeMembers(this IEnumerable<Declaration> declarations, Declaration type)
451448
{
452-
return declarations.Where(item => item.Project != null && item.ProjectId == type.ProjectId && item.ParentScope == type.Scope);
449+
return declarations.Where(item => Equals(item.ParentScopeDeclaration, type));
453450
}
454451

455452
/// <summary>

RetailCoder.VBE/Inspections/Abstract/InspectionResultBase.cs

Lines changed: 5 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -21,31 +21,29 @@ protected InspectionResultBase(IInspection inspection, Declaration target)
2121
/// <summary>
2222
/// Creates a comment inspection result.
2323
/// </summary>
24-
protected InspectionResultBase(IInspection inspection, CommentNode comment)
25-
: this(inspection, comment.QualifiedSelection.QualifiedName, null, comment)
24+
protected InspectionResultBase(IInspection inspection, QualifiedModuleName qualifiedName)
25+
: this(inspection, qualifiedName, null)
2626
{ }
2727

2828
/// <summary>
2929
/// Creates an inspection result.
3030
/// </summary>
31-
protected InspectionResultBase(IInspection inspection, QualifiedModuleName qualifiedName, ParserRuleContext context, CommentNode comment = null)
31+
protected InspectionResultBase(IInspection inspection, QualifiedModuleName qualifiedName, ParserRuleContext context)
3232
{
3333
_inspection = inspection;
3434
_qualifiedName = qualifiedName;
3535
_context = context;
36-
_comment = comment;
3736
}
3837

3938
/// <summary>
4039
/// Creates an inspection result.
4140
/// </summary>
42-
protected InspectionResultBase(IInspection inspection, QualifiedModuleName qualifiedName, ParserRuleContext context, Declaration declaration, CommentNode comment = null)
41+
protected InspectionResultBase(IInspection inspection, QualifiedModuleName qualifiedName, ParserRuleContext context, Declaration declaration)
4342
{
4443
_inspection = inspection;
4544
_qualifiedName = qualifiedName;
4645
_context = context;
4746
_target = declaration;
48-
_comment = comment;
4947
}
5048

5149
private readonly IInspection _inspection;
@@ -59,9 +57,6 @@ protected InspectionResultBase(IInspection inspection, QualifiedModuleName quali
5957
private readonly ParserRuleContext _context;
6058
public ParserRuleContext Context { get { return _context; } }
6159

62-
private readonly CommentNode _comment;
63-
public CommentNode Comment { get { return _comment; } }
64-
6560
private readonly Declaration _target;
6661
public Declaration Target { get { return _target; } }
6762

@@ -72,12 +67,8 @@ public virtual QualifiedSelection QualifiedSelection
7267
{
7368
get
7469
{
75-
if (_context == null && _comment == null)
76-
{
77-
return _target.QualifiedSelection;
78-
}
7970
return _context == null
80-
? _comment.QualifiedSelection
71+
? _target.QualifiedSelection
8172
: new QualifiedSelection(_qualifiedName, _context.GetSelection());
8273
}
8374
}

RetailCoder.VBE/Inspections/Concrete/Inspector.cs

Lines changed: 26 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -119,25 +119,46 @@ before moving them into the ParseTreeResults after qualifying them
119119
*/
120120
var obsoleteCallStatementListener = IsDisabled<ObsoleteCallStatementInspection>(settings) ? null : new ObsoleteCallStatementInspection.ObsoleteCallStatementListener();
121121
var obsoleteLetStatementListener = IsDisabled<ObsoleteLetStatementInspection>(settings) ? null : new ObsoleteLetStatementInspection.ObsoleteLetStatementListener();
122+
var obsoleteCommentSyntaxListener = IsDisabled<ObsoleteCommentSyntaxInspection>(settings) ? null : new ObsoleteCommentSyntaxInspection.ObsoleteCommentSyntaxListener();
122123
var emptyStringLiteralListener = IsDisabled<EmptyStringLiteralInspection>(settings) ? null : new EmptyStringLiteralInspection.EmptyStringLiteralListener();
123124
var argListWithOneByRefParamListener = IsDisabled<ProcedureCanBeWrittenAsFunctionInspection>(settings) ? null : new ProcedureCanBeWrittenAsFunctionInspection.SingleByRefParamArgListListener();
124125
var invalidAnnotationListener = IsDisabled<MissingAnnotationArgumentInspection>(settings) ? null : new MissingAnnotationArgumentInspection.InvalidAnnotationStatementListener();
125126

126127
var combinedListener = new CombinedParseTreeListener(new IParseTreeListener[]{
127128
obsoleteCallStatementListener,
128129
obsoleteLetStatementListener,
130+
obsoleteCommentSyntaxListener,
129131
emptyStringLiteralListener,
130132
argListWithOneByRefParamListener,
131133
invalidAnnotationListener
132134
});
133135

134136
ParseTreeWalker.Default.Walk(combinedListener, componentTreePair.Value);
135137

136-
result.AddRange(argListWithOneByRefParamListener.Contexts.Select(context => new QualifiedContext<VBAParser.ArgListContext>(componentTreePair.Key, context)));
137-
result.AddRange(emptyStringLiteralListener.Contexts.Select(context => new QualifiedContext<VBAParser.LiteralExpressionContext>(componentTreePair.Key, context)));
138-
result.AddRange(obsoleteLetStatementListener.Contexts.Select(context => new QualifiedContext<VBAParser.LetStmtContext>(componentTreePair.Key, context)));
139-
result.AddRange(obsoleteCallStatementListener.Contexts.Select(context => new QualifiedContext<VBAParser.CallStmtContext>(componentTreePair.Key, context)));
140-
result.AddRange(invalidAnnotationListener.Contexts.Select(context => new QualifiedContext<VBAParser.AnnotationContext>(componentTreePair.Key, context)));
138+
if (argListWithOneByRefParamListener != null)
139+
{
140+
result.AddRange(argListWithOneByRefParamListener.Contexts.Select(context => new QualifiedContext<VBAParser.ArgListContext>(componentTreePair.Key, context)));
141+
}
142+
if (emptyStringLiteralListener != null)
143+
{
144+
result.AddRange(emptyStringLiteralListener.Contexts.Select(context => new QualifiedContext<VBAParser.LiteralExpressionContext>(componentTreePair.Key, context)));
145+
}
146+
if (obsoleteLetStatementListener != null)
147+
{
148+
result.AddRange(obsoleteLetStatementListener.Contexts.Select(context => new QualifiedContext<VBAParser.LetStmtContext>(componentTreePair.Key, context)));
149+
}
150+
if (obsoleteCommentSyntaxListener != null)
151+
{
152+
result.AddRange(obsoleteCommentSyntaxListener.Contexts.Select(context => new QualifiedContext<VBAParser.RemCommentContext>(componentTreePair.Key, context)));
153+
}
154+
if (obsoleteCallStatementListener != null)
155+
{
156+
result.AddRange(obsoleteCallStatementListener.Contexts.Select(context => new QualifiedContext<VBAParser.CallStmtContext>(componentTreePair.Key, context)));
157+
}
158+
if (invalidAnnotationListener != null)
159+
{
160+
result.AddRange(invalidAnnotationListener.Contexts.Select(context => new QualifiedContext<VBAParser.AnnotationContext>(componentTreePair.Key, context)));
161+
}
141162
}
142163
return result;
143164
}
Lines changed: 28 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,28 @@
1+
using System.Collections.Generic;
2+
using System.Linq;
3+
using Rubberduck.Inspections.Abstract;
4+
using Rubberduck.Inspections.Resources;
5+
using Rubberduck.Inspections.Results;
6+
using Rubberduck.Parsing.Symbols;
7+
using Rubberduck.Parsing.VBA;
8+
9+
namespace Rubberduck.Inspections
10+
{
11+
public sealed class HostSpecificExpressionInspection : InspectionBase
12+
{
13+
public HostSpecificExpressionInspection(RubberduckParserState state)
14+
: base(state)
15+
{
16+
}
17+
18+
public override string Meta { get { return InspectionsUI.HostSpecificExpressionInspectionMeta; } }
19+
public override string Description { get { return InspectionsUI.HostSpecificExpressionInspectionName; } }
20+
public override CodeInspectionType InspectionType { get { return CodeInspectionType.LanguageOpportunities; } }
21+
22+
public override IEnumerable<InspectionResultBase> GetInspectionResults()
23+
{
24+
return Declarations.Where(item => item.DeclarationType == DeclarationType.BracketedExpression)
25+
.Select(item => new HostSpecificExpressionInspectionResult(this, item)).ToList();
26+
}
27+
}
28+
}

RetailCoder.VBE/Inspections/MemberNotOnInterfaceInspection.cs

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -18,9 +18,7 @@ public sealed class MemberNotOnInterfaceInspection : InspectionBase
1818
private static readonly List<Type> InterestingTypes = new List<Type>
1919
{
2020
typeof(VBAParser.MemberAccessExprContext),
21-
typeof(VBAParser.WithMemberAccessExprContext),
22-
typeof(VBAParser.DictionaryAccessExprContext),
23-
typeof(VBAParser.WithDictionaryAccessExprContext)
21+
typeof(VBAParser.WithMemberAccessExprContext)
2422
};
2523

2624
public MemberNotOnInterfaceInspection(RubberduckParserState state, CodeInspectionSeverity defaultSeverity = CodeInspectionSeverity.Warning)
@@ -34,7 +32,8 @@ public MemberNotOnInterfaceInspection(RubberduckParserState state, CodeInspectio
3432

3533
public override IEnumerable<InspectionResultBase> GetInspectionResults()
3634
{
37-
var targets = Declarations.Where(decl => decl.AsTypeDeclaration != null &&
35+
var targets = Declarations.Where(decl => decl.AsTypeDeclaration != null &&
36+
decl.ParentDeclaration.DeclarationType != DeclarationType.Project &&
3837
decl.AsTypeDeclaration.DeclarationType == DeclarationType.ClassModule &&
3938
((ClassModuleDeclaration)decl.AsTypeDeclaration).IsExtensible &&
4039
decl.References.Any(usage => InterestingTypes.Contains(usage.Context.Parent.GetType())))

RetailCoder.VBE/Inspections/MoveFieldCloserToUsageInspection.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -26,7 +26,7 @@ public override IEnumerable<InspectionResultBase> GetInspectionResults()
2626
.Where(declaration =>
2727
{
2828

29-
if (declaration.DeclarationType != DeclarationType.Variable ||
29+
if (declaration.DeclarationType != DeclarationType.Variable || declaration.IsWithEvents ||
3030
!new[] {DeclarationType.ClassModule, DeclarationType.ProceduralModule}.Contains(declaration.ParentDeclaration.DeclarationType))
3131
{
3232
return false;
Lines changed: 36 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -1,32 +1,56 @@
11
using System.Collections.Generic;
22
using System.Linq;
3+
using Antlr4.Runtime;
34
using Rubberduck.Inspections.Abstract;
45
using Rubberduck.Inspections.Resources;
56
using Rubberduck.Inspections.Results;
7+
using Rubberduck.Parsing;
68
using Rubberduck.Parsing.Grammar;
79
using Rubberduck.Parsing.VBA;
810

911
namespace Rubberduck.Inspections
1012
{
11-
public sealed class ObsoleteCommentSyntaxInspection : InspectionBase
13+
public sealed class ObsoleteCommentSyntaxInspection : InspectionBase, IParseTreeInspection<VBAParser.RemCommentContext>
1214
{
13-
/// <summary>
14-
/// Parameterless constructor required for discovery of implemented code inspections.
15-
/// </summary>
16-
public ObsoleteCommentSyntaxInspection(RubberduckParserState state)
17-
: base(state, CodeInspectionSeverity.Suggestion)
18-
{
19-
}
15+
private IEnumerable<QualifiedContext> _results;
16+
17+
public ObsoleteCommentSyntaxInspection(RubberduckParserState state) : base(state, CodeInspectionSeverity.Suggestion) { }
2018

2119
public override string Meta { get { return InspectionsUI.ObsoleteCommentSyntaxInspectionMeta; } }
2220
public override string Description { get { return InspectionsUI.ObsoleteCommentSyntaxInspectionName; } }
23-
public override CodeInspectionType InspectionType { get {return CodeInspectionType.LanguageOpportunities; } }
21+
public override CodeInspectionType InspectionType { get { return CodeInspectionType.LanguageOpportunities; } }
2422

2523
public override IEnumerable<InspectionResultBase> GetInspectionResults()
2624
{
27-
return State.AllComments.Where(comment => comment.Marker == Tokens.Rem &&
28-
!IsInspectionDisabled(comment.QualifiedSelection.QualifiedName.Component, comment.QualifiedSelection.Selection.StartLine))
29-
.Select(comment => new ObsoleteCommentSyntaxInspectionResult(this, comment));
25+
if (ParseTreeResults == null)
26+
{
27+
return new InspectionResultBase[] { };
28+
}
29+
return ParseTreeResults.Where(context => !IsInspectionDisabled(context.ModuleName.Component, context.Context.Start.Line))
30+
.Select(context => new ObsoleteCommentSyntaxInspectionResult(this, new QualifiedContext<ParserRuleContext>(context.ModuleName, context.Context)));
31+
}
32+
33+
public void SetResults(IEnumerable<QualifiedContext> results)
34+
{
35+
_results = results;
36+
}
37+
38+
public IEnumerable<QualifiedContext<VBAParser.RemCommentContext>> ParseTreeResults { get { return _results.OfType<QualifiedContext<VBAParser.RemCommentContext>>(); } }
39+
40+
41+
public class ObsoleteCommentSyntaxListener : VBAParserBaseListener
42+
{
43+
private readonly IList<VBAParser.RemCommentContext> _contexts = new List<VBAParser.RemCommentContext>();
44+
45+
public IEnumerable<VBAParser.RemCommentContext> Contexts
46+
{
47+
get { return _contexts; }
48+
}
49+
50+
public override void ExitRemComment(VBAParser.RemCommentContext context)
51+
{
52+
_contexts.Add(context);
53+
}
3054
}
3155
}
3256
}

RetailCoder.VBE/Inspections/ObsoleteLetStatementInspection.cs

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -35,8 +35,7 @@ public override IEnumerable<InspectionResultBase> GetInspectionResults()
3535
{
3636
return new InspectionResultBase[] { };
3737
}
38-
return ParseTreeResults.OfType<QualifiedContext<VBAParser.LetStmtContext>>()
39-
.Where(context => !IsInspectionDisabled(context.ModuleName.Component, context.Context.Start.Line))
38+
return ParseTreeResults.Where(context => !IsInspectionDisabled(context.ModuleName.Component, context.Context.Start.Line))
4039
.Select(context => new ObsoleteLetStatementUsageInspectionResult(this, new QualifiedContext<ParserRuleContext>(context.ModuleName, context.Context)));
4140
}
4241

RetailCoder.VBE/Inspections/OptionExplicitInspection.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ public override IEnumerable<InspectionResultBase> GetInspectionResults()
3939
.Where(declaration => ModuleTypes.Contains(declaration.DeclarationType));
4040

4141
var issues = modules.Where(module => !options.Select(option => option.Scope).Contains(module.Scope))
42-
.Select(issue => new OptionExplicitInspectionResult(this, issue.QualifiedName.QualifiedModuleName));
42+
.Select(issue => new OptionExplicitInspectionResult(this, issue));
4343

4444
return issues;
4545
}

RetailCoder.VBE/Inspections/ProcedureNotUsedInspection.cs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -43,10 +43,10 @@ public override IEnumerable<InspectionResultBase> GetInspectionResults()
4343
.SelectMany(control => declarations.FindEventHandlers(control)).ToList();
4444

4545
var withEventFields = declarations.Where(item => item.DeclarationType == DeclarationType.Variable && item.IsWithEvents);
46-
handlers.AddRange(withEventFields.SelectMany(declarations.FindEventProcedures));
46+
handlers.AddRange(withEventFields.SelectMany(Declarations.FindEventProcedures));
4747

4848
var forms = declarations.Where(item => item.DeclarationType == DeclarationType.ClassModule
49-
&& item.QualifiedName.QualifiedModuleName.Component.Type == ComponentType.UserForm)
49+
&& item.QualifiedName.QualifiedModuleName.ComponentType == ComponentType.UserForm)
5050
.ToList();
5151

5252
if (forms.Any())
@@ -159,7 +159,7 @@ private IEnumerable<string> GetImplementedInterfaceMembers(IEnumerable<Declarati
159159
{
160160
var interfaces = classes.Where(item => item.References.Any(reference =>
161161
ParserRuleContextHelper.HasParent<VBAParser.ImplementsStmtContext>(reference.Context.Parent)
162-
&& reference.QualifiedModuleName.Component.Name == componentName));
162+
&& reference.QualifiedModuleName.ComponentName == componentName));
163163

164164
var members = interfaces.SelectMany(declarations.InScope)
165165
.Select(member => member.ComponentName + "_" + member.IdentifierName);

0 commit comments

Comments
 (0)