Skip to content

Commit

Permalink
Merge branch 'next' into next
Browse files Browse the repository at this point in the history
  • Loading branch information
comintern committed Mar 2, 2017
2 parents f377889 + 427ef60 commit 0e8690b
Show file tree
Hide file tree
Showing 22 changed files with 337 additions and 296 deletions.
21 changes: 11 additions & 10 deletions RetailCoder.VBE/Inspections/Abstract/InspectionBase.cs
Expand Up @@ -116,28 +116,29 @@ protected bool IsIgnoringInspectionResultFor(IVBComponent component, int line)

protected bool IsIgnoringInspectionResultFor(Declaration declaration, string inspectionName)
{
var module = Declaration.GetModuleParent(declaration);
if (module == null) { return false; }

var isIgnoredAtModuleLevel = module.Annotations
.Any(annotation => annotation.AnnotationType == AnnotationType.IgnoreModule
&& ((IgnoreModuleAnnotation) annotation).IsIgnored(inspectionName));


if (declaration.DeclarationType == DeclarationType.Parameter)
{
return declaration.ParentDeclaration.Annotations.Any(annotation =>
return isIgnoredAtModuleLevel || declaration.ParentDeclaration.Annotations.Any(annotation =>
annotation.AnnotationType == AnnotationType.Ignore
&& ((IgnoreAnnotation)annotation).IsIgnored(inspectionName));
}

return declaration.Annotations.Any(annotation =>
return isIgnoredAtModuleLevel || declaration.Annotations.Any(annotation =>
annotation.AnnotationType == AnnotationType.Ignore
&& ((IgnoreAnnotation)annotation).IsIgnored(inspectionName));
}

protected bool IsIgnoringInspectionResultFor(IdentifierReference reference, string inspectionName)
{
if (reference == null)
{
return false;
}

return reference.Annotations.Any(annotation =>
annotation.AnnotationType == AnnotationType.Ignore
&& ((IgnoreAnnotation)annotation).IsIgnored(inspectionName));
return reference != null && reference.IsIgnoringInspectionResultFor(inspectionName);
}

public int CompareTo(IInspection other)
Expand Down
Expand Up @@ -3,7 +3,6 @@
using Rubberduck.Inspections.Abstract;
using Rubberduck.Inspections.Resources;
using Rubberduck.Inspections.Results;
using Rubberduck.Parsing.Grammar;
using Rubberduck.Parsing.Symbols;
using Rubberduck.Parsing.VBA;
using Rubberduck.UI.Refactorings;
Expand All @@ -12,7 +11,7 @@ namespace Rubberduck.Inspections
{
public sealed class AssignedByValParameterInspection : InspectionBase
{
private IAssignedByValParameterQuickFixDialogFactory _dialogFactory;
private readonly IAssignedByValParameterQuickFixDialogFactory _dialogFactory;
public AssignedByValParameterInspection(RubberduckParserState state, IAssignedByValParameterQuickFixDialogFactory dialogFactory)
: base(state)
{
Expand Down
@@ -1,6 +1,5 @@
using Rubberduck.Inspections.Abstract;
using System.Linq;
using Rubberduck.Parsing;
using Rubberduck.VBEditor;
using Rubberduck.Inspections.Resources;
using Rubberduck.Parsing.Grammar;
Expand All @@ -18,16 +17,16 @@ public class AssignedByValParameterMakeLocalCopyQuickFix : QuickFixBase
{
private readonly Declaration _target;
private readonly IAssignedByValParameterQuickFixDialogFactory _dialogFactory;
private readonly IEnumerable<string> _forbiddenNames;
private string _localCopyVariableName;
private string[] _variableNamesAccessibleToProcedureContext;

public AssignedByValParameterMakeLocalCopyQuickFix(Declaration target, QualifiedSelection selection, IAssignedByValParameterQuickFixDialogFactory dialogFactory)
: base(target.Context, selection, InspectionsUI.AssignedByValParameterMakeLocalCopyQuickFix)
{
_target = target;
_dialogFactory = dialogFactory;
_variableNamesAccessibleToProcedureContext = GetVariableNamesAccessibleToProcedureContext(_target.Context.Parent.Parent);
SetValidLocalCopyVariableNameSuggestion();
_forbiddenNames = GetIdentifierNamesAccessibleToProcedureContext(target.Context.Parent.Parent);
_localCopyVariableName = ComputeSuggestedName();
}

public override bool CanFixInModule { get { return false; } }
Expand All @@ -49,10 +48,9 @@ public override void Fix()

private void RequestLocalCopyVariableName()
{
using( var view = _dialogFactory.Create(_target.IdentifierName, _target.DeclarationType.ToString()))
using( var view = _dialogFactory.Create(_target.IdentifierName, _target.DeclarationType.ToString(), _forbiddenNames))
{
view.NewName = _localCopyVariableName;
view.IdentifierNamesAlreadyDeclared = _variableNamesAccessibleToProcedureContext;
view.ShowDialog();
IsCancelled = view.DialogResult == DialogResult.Cancel;
if (!IsCancelled)
Expand All @@ -62,63 +60,65 @@ private void RequestLocalCopyVariableName()
}
}

private void SetValidLocalCopyVariableNameSuggestion()
private string ComputeSuggestedName()
{
_localCopyVariableName = "x" + _target.IdentifierName.CapitalizeFirstLetter();
if (VariableNameIsValid(_localCopyVariableName)) { return; }
var newName = "local" + _target.IdentifierName.CapitalizeFirstLetter();
if (VariableNameIsValid(newName))
{
return newName;
}

//If the initial suggestion is not valid, keep pre-pending x's until it is
for ( int attempt = 2; attempt < 10; attempt++)
for ( var attempt = 2; attempt < 10; attempt++)
{
_localCopyVariableName = "x" + _localCopyVariableName;
if (VariableNameIsValid(_localCopyVariableName))
var result = newName + attempt;
if (VariableNameIsValid(result))
{
return;
return result;
}
}
//if "xxFoo" to "xxxxxxxxxxFoo" isn't unique, give up and go with the original suggestion.
//The QuickFix will leave the code as-is unless it receives a name that is free of conflicts
_localCopyVariableName = "x" + _target.IdentifierName.CapitalizeFirstLetter();
return newName;
}

private bool VariableNameIsValid(string variableName)
{
var validator = new VariableNameValidator(variableName);
return validator.IsValidName()
&& !_variableNamesAccessibleToProcedureContext
.Any(name => name.Equals(variableName, System.StringComparison.InvariantCultureIgnoreCase));
return VariableNameValidator.IsValidName(variableName)
&& !_forbiddenNames.Any(name => name.Equals(variableName, System.StringComparison.InvariantCultureIgnoreCase));
}

private void ReplaceAssignedByValParameterReferences()
{
var module = Selection.QualifiedName.Component.CodeModule;
foreach (IdentifierReference identifierReference in _target.References)
foreach (var identifierReference in _target.References)
{
module.ReplaceIdentifierReferenceName(identifierReference, _localCopyVariableName);
}
}

private void InsertLocalVariableDeclarationAndAssignment()
{
var blocks = QuickFixHelper.GetBlockStmtContextsForContext(_target.Context.Parent.Parent);
var block = QuickFixHelper.GetBlockStmtContextsForContext(_target.Context.Parent.Parent).FirstOrDefault();
if (block == null)
{
return;
}

string[] lines = { BuildLocalCopyDeclaration(), BuildLocalCopyAssignment() };
var module = Selection.QualifiedName.Component.CodeModule;
module.InsertLines(blocks.FirstOrDefault().Start.Line, lines);
module.InsertLines(block.Start.Line, lines);
}

private string BuildLocalCopyDeclaration()
{
return Tokens.Dim + " " + _localCopyVariableName + " " + Tokens.As
+ " " + _target.AsTypeName;
return Tokens.Dim + " " + _localCopyVariableName + " " + Tokens.As + " " + _target.AsTypeName;
}

private string BuildLocalCopyAssignment()
{
return (SymbolList.ValueTypes.Contains(_target.AsTypeName) ? string.Empty : Tokens.Set + " ")
return (_target.AsTypeDeclaration is ClassModuleDeclaration ? Tokens.Set + " " : string.Empty)
+ _localCopyVariableName + " = " + _target.IdentifierName;
}

private string[] GetVariableNamesAccessibleToProcedureContext(RuleContext ruleContext)
private IEnumerable<string> GetIdentifierNamesAccessibleToProcedureContext(RuleContext ruleContext)
{
var allIdentifiers = new HashSet<string>();

Expand All @@ -137,29 +137,31 @@ private string[] GetVariableNamesAccessibleToProcedureContext(RuleContext ruleCo
return allIdentifiers.ToArray();
}

private HashSet<string> GetIdentifierNames(IReadOnlyList<RuleContext> ruleContexts)
private IEnumerable<string> GetIdentifierNames(IEnumerable<RuleContext> ruleContexts)
{
var identifiers = new HashSet<string>();
foreach (RuleContext ruleContext in ruleContexts)
foreach (var identifiersForThisContext in ruleContexts.Select(GetIdentifierNames))
{
var identifiersForThisContext = GetIdentifierNames(ruleContext);
identifiers.UnionWith(identifiersForThisContext);
}
return identifiers;
}

private HashSet<string> GetIdentifierNames(RuleContext ruleContext)
private static HashSet<string> GetIdentifierNames(RuleContext ruleContext)
{
// note: this looks like something that's already handled somewhere else...

//Recursively work through the tree to get all IdentifierContexts
var results = new HashSet<string>();
var tokenValues = typeof(Tokens).GetFields().Select(item => item.GetValue(null)).Cast<string>().Select(item => item);
var tokenValues = typeof(Tokens).GetFields().Select(item => item.GetValue(null)).Cast<string>().Select(item => item).ToArray();
var children = GetChildren(ruleContext);

foreach (IParseTree child in children)
foreach (var child in children)
{
if (child is VBAParser.IdentifierContext)
var context = child as VBAParser.IdentifierContext;
if (context != null)
{
var childName = Identifier.GetName((VBAParser.IdentifierContext)child);
var childName = Identifier.GetName(context);
if (!tokenValues.Contains(childName))
{
results.Add(childName);
Expand All @@ -176,12 +178,12 @@ private HashSet<string> GetIdentifierNames(RuleContext ruleContext)
return results;
}

private static List<IParseTree> GetChildren(RuleContext ruleCtx)
private static IEnumerable<IParseTree> GetChildren(IParseTree tree)
{
var result = new List<IParseTree>();
for (int index = 0; index < ruleCtx.ChildCount; index++)
for (var index = 0; index < tree.ChildCount; index++)
{
result.Add(ruleCtx.GetChild(index));
result.Add(tree.GetChild(index));
}
return result;
}
Expand Down
Expand Up @@ -11,7 +11,7 @@ namespace Rubberduck.Inspections.Results
public class AssignedByValParameterInspectionResult : InspectionResultBase
{
private IEnumerable<QuickFixBase> _quickFixes;
private IAssignedByValParameterQuickFixDialogFactory _dialogFactory;
private readonly IAssignedByValParameterQuickFixDialogFactory _dialogFactory;

public AssignedByValParameterInspectionResult(IInspection inspection, Declaration target, IAssignedByValParameterQuickFixDialogFactory dialogFactory)
: base(inspection, target)
Expand Down
8 changes: 1 addition & 7 deletions RetailCoder.VBE/Inspections/UseMeaningfulNameInspection.cs
Expand Up @@ -51,17 +51,11 @@ public override IEnumerable<InspectionResultBase> GetInspectionResults()
!IgnoreDeclarationTypes.Contains(declaration.ParentDeclaration.DeclarationType) &&
!handlers.Contains(declaration.ParentDeclaration)) &&
!whitelistedNames.Contains(declaration.IdentifierName) &&
IsBadIdentifier(declaration.IdentifierName))
!VariableNameValidator.IsMeaningfulName(declaration.IdentifierName))
.Select(issue => new IdentifierNameInspectionResult(this, issue, State, _messageBox, _settings))
.ToList();

return issues;
}

private static bool IsBadIdentifier(string identifier)
{
var validator = new VariableNameValidator(identifier);
return !validator.IsMeaningfulName();
}
}
}

0 comments on commit 0e8690b

Please sign in to comment.