Skip to content

Commit c9d4b03

Browse files
committed
Modified to use AllUserDeclarations list to rather than evalate the parse tree. Removes QuickFixHelper.cs as the content was no longer refereferenced
1 parent f0c8a50 commit c9d4b03

File tree

6 files changed

+13
-162
lines changed

6 files changed

+13
-162
lines changed

RetailCoder.VBE/Inspections/AssignedByValParameterInspection.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ namespace Rubberduck.Inspections
1212
public sealed class AssignedByValParameterInspection : InspectionBase
1313
{
1414
private readonly IAssignedByValParameterQuickFixDialogFactory _dialogFactory;
15-
private RubberduckParserState _parserState;
15+
private readonly RubberduckParserState _parserState;
1616
public AssignedByValParameterInspection(RubberduckParserState state, IAssignedByValParameterQuickFixDialogFactory dialogFactory)
1717
: base(state)
1818
{

RetailCoder.VBE/Inspections/QuickFixes/AssignedByValParameterMakeLocalCopyQuickFix.cs

Lines changed: 9 additions & 93 deletions
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,6 @@
99
using Rubberduck.Common;
1010
using Antlr4.Runtime;
1111
using System.Collections.Generic;
12-
using Antlr4.Runtime.Tree;
1312
using Rubberduck.Parsing.VBA;
1413

1514
namespace Rubberduck.Inspections.QuickFixes
@@ -28,7 +27,7 @@ public AssignedByValParameterMakeLocalCopyQuickFix(Declaration target, Qualified
2827
_target = target;
2928
_dialogFactory = dialogFactory;
3029
_parserState = parserState;
31-
_forbiddenNames = GetIdentifierNamesAccessibleToProcedureContext(target.Context.Parent.Parent);
30+
_forbiddenNames = GetIdentifierNamesAccessibleToProcedureContext();
3231
_localCopyVariableName = ComputeSuggestedName();
3332
}
3433

@@ -98,16 +97,10 @@ private void ReplaceAssignedByValParameterReferences()
9897
}
9998

10099
private void InsertLocalVariableDeclarationAndAssignment()
101-
{
102-
var block = QuickFixHelper.GetBlockStmtContexts(_target.Context.Parent.Parent).FirstOrDefault();
103-
if (block == null)
104-
{
105-
return;
106-
}
107-
100+
{
108101
string[] lines = { BuildLocalCopyDeclaration(), BuildLocalCopyAssignment() };
109102
var module = Selection.QualifiedName.Component.CodeModule;
110-
module.InsertLines(block.Start.Line, lines);
103+
module.InsertLines(((VBAParser.ArgListContext)_target.Context.Parent).Stop.Line+1, lines);
111104
}
112105

113106
private string BuildLocalCopyDeclaration()
@@ -121,36 +114,23 @@ private string BuildLocalCopyAssignment()
121114
+ _localCopyVariableName + " = " + _target.IdentifierName;
122115
}
123116

124-
private IEnumerable<string> GetIdentifierNamesAccessibleToProcedureContext(RuleContext ruleContext)
117+
private IEnumerable<string> GetIdentifierNamesAccessibleToProcedureContext()
125118
{
126119
var allIdentifiers = new HashSet<string>();
127120

128-
//Locally declared variable names
129-
var blocks = QuickFixHelper.GetBlockStmtContexts(ruleContext);
130-
131-
var blockStmtIdentifierContexts = GetIdentifierContexts(blocks);
132-
var blockStmtIdentifiers = GetVariableNamesFromRuleContexts(blockStmtIdentifierContexts.ToArray());
133-
134-
allIdentifiers.UnionWith(blockStmtIdentifiers);
135-
136-
//The parameters of the procedure that are unreferenced in the procedure body
137-
var args = QuickFixHelper.GetArgContexts(ruleContext);
138-
139-
var potentiallyUnreferencedIdentifierContexts = GetIdentifierContexts(args);
140-
var potentiallyUnreferencedParameters = GetVariableNamesFromRuleContexts(potentiallyUnreferencedIdentifierContexts.ToArray());
121+
var allParametersAndLocalVariables = _parserState.AllUserDeclarations
122+
.Where(item => item.ParentScope == _target.ParentScope)
123+
.ToList();
141124

142-
allIdentifiers.UnionWith(potentiallyUnreferencedParameters);
125+
allIdentifiers.UnionWith(allParametersAndLocalVariables.Select(d => d.IdentifierName));
143126

144-
//All declarations within the same module, but outside of all procedures (e.g., member variables, procedure names)
145127
var sameModuleDeclarations = _parserState.AllUserDeclarations
146128
.Where(item => item.ComponentName == _target.ComponentName
147129
&& !IsProceduralContext(item.ParentDeclaration.Context))
148130
.ToList();
149131

150132
allIdentifiers.UnionWith(sameModuleDeclarations.Select(d => d.IdentifierName));
151133

152-
//Public declarations anywhere within the project other than Public members and
153-
//procedures of Class modules
154134
var allPublicDeclarations = _parserState.AllUserDeclarations
155135
.Where(item => (item.Accessibility == Accessibility.Public
156136
|| ((item.Accessibility == Accessibility.Implicit)
@@ -160,71 +140,7 @@ private IEnumerable<string> GetIdentifierNamesAccessibleToProcedureContext(RuleC
160140

161141
allIdentifiers.UnionWith(allPublicDeclarations.Select(d => d.IdentifierName));
162142

163-
return allIdentifiers.ToArray();
164-
}
165-
166-
private HashSet<string> GetVariableNamesFromRuleContexts(RuleContext[] ruleContexts)
167-
{
168-
var tokenValues = typeof(Tokens).GetFields().Select(item => item.GetValue(null)).Cast<string>().Select(item => item);
169-
var results = new HashSet<string>();
170-
171-
foreach( var ruleContext in ruleContexts)
172-
{
173-
var name = Identifier.GetName((VBAParser.IdentifierContext)ruleContext);
174-
if (!tokenValues.Contains(name))
175-
{
176-
results.Add(name);
177-
}
178-
}
179-
return results;
180-
}
181-
182-
private HashSet<RuleContext> GetIdentifierContexts(IReadOnlyList<RuleContext> ruleContexts)
183-
{
184-
var identifiers = new HashSet<RuleContext>();
185-
foreach (RuleContext ruleContext in ruleContexts)
186-
{
187-
var identifiersForThisContext = GetIdentifierContexts(ruleContext);
188-
identifiers.UnionWith(identifiersForThisContext);
189-
}
190-
return identifiers;
191-
}
192-
193-
private HashSet<RuleContext> GetIdentifierContexts(RuleContext ruleContext)
194-
{
195-
// note: this looks like something that's already handled somewhere else...
196-
197-
//Recursively work through the tree to get all IdentifierContexts
198-
var results = new HashSet<RuleContext>();
199-
var children = GetChildren(ruleContext);
200-
201-
foreach (var child in children)
202-
{
203-
var context = child as VBAParser.IdentifierContext;
204-
if (context != null)
205-
{
206-
//var childName = Identifier.GetName((VBAParser.IdentifierContext)child);
207-
results.Add((RuleContext)child);
208-
}
209-
else
210-
{
211-
if (!(child is TerminalNodeImpl))
212-
{
213-
results.UnionWith(GetIdentifierContexts((RuleContext)child));
214-
}
215-
}
216-
}
217-
return results;
218-
}
219-
220-
private static IEnumerable<IParseTree> GetChildren(IParseTree tree)
221-
{
222-
var result = new List<IParseTree>();
223-
for (var index = 0; index < tree.ChildCount; index++)
224-
{
225-
result.Add(tree.GetChild(index));
226-
}
227-
return result;
143+
return allIdentifiers.ToList();
228144
}
229145
private bool IsProceduralContext(RuleContext context)
230146
{

RetailCoder.VBE/Inspections/QuickFixes/PassParameterByReferenceQuickFix.cs

Lines changed: 2 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
using Antlr4.Runtime;
2+
using Antlr4.Runtime.Tree;
23
using Rubberduck.Common;
34
using Rubberduck.Inspections.Abstract;
45
using Rubberduck.Inspections.Resources;
@@ -26,11 +27,7 @@ public PassParameterByReferenceQuickFix(Declaration target, QualifiedSelection s
2627
public override void Fix()
2728
{
2829
var module = Selection.QualifiedName.Component.CodeModule;
29-
var argContext = QuickFixHelper.GetArgContexts(Context.Parent.Parent)
30-
.SingleOrDefault(parameter => Identifier.GetName(parameter.unrestrictedIdentifier())
31-
.Equals(_target.IdentifierName));
32-
33-
module.ReplaceToken(argContext.BYVAL().Symbol,Tokens.ByRef);
30+
module.ReplaceToken(((VBAParser.ArgContext)Context).BYVAL().Symbol, Tokens.ByRef);
3431
}
3532
}
3633
}

RetailCoder.VBE/Inspections/QuickFixes/QuickFixHelper.cs

Lines changed: 0 additions & 61 deletions
This file was deleted.

RetailCoder.VBE/Inspections/Results/AssignedByValParameterInspectionResult.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,7 @@ namespace Rubberduck.Inspections.Results
1212
public class AssignedByValParameterInspectionResult : InspectionResultBase
1313
{
1414
private IEnumerable<QuickFixBase> _quickFixes;
15-
private RubberduckParserState _parserState;
15+
private readonly RubberduckParserState _parserState;
1616
private readonly IAssignedByValParameterQuickFixDialogFactory _dialogFactory;
1717

1818
public AssignedByValParameterInspectionResult(IInspection inspection, Declaration target, RubberduckParserState parserState, IAssignedByValParameterQuickFixDialogFactory dialogFactory)

RetailCoder.VBE/Rubberduck.csproj

Lines changed: 0 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -349,7 +349,6 @@
349349
<Compile Include="Inspections\QuickFixes\AddIdentifierToWhiteListQuickFix.cs" />
350350
<Compile Include="Inspections\QuickFixes\ApplicationWorksheetFunctionQuickFix.cs" />
351351
<Compile Include="Inspections\QuickFixes\AssignedByValParameterMakeLocalCopyQuickFix.cs" />
352-
<Compile Include="Inspections\QuickFixes\QuickFixHelper.cs" />
353352
<Compile Include="Inspections\Resources\InspectionsUI.Designer.cs">
354353
<AutoGen>True</AutoGen>
355354
<DesignTime>True</DesignTime>

0 commit comments

Comments
 (0)