diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitByRefModifierInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitByRefModifierInspection.cs index 686a8fb83d..72a01905bb 100644 --- a/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitByRefModifierInspection.cs +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitByRefModifierInspection.cs @@ -3,6 +3,7 @@ using Rubberduck.Parsing.VBA; using Rubberduck.Parsing.VBA.DeclarationCaching; using Rubberduck.Resources.Inspections; +using System.Linq; namespace Rubberduck.CodeAnalysis.Inspections.Concrete { @@ -10,8 +11,11 @@ namespace Rubberduck.CodeAnalysis.Inspections.Concrete /// Highlights implicit ByRef modifiers in user code. /// /// - /// In modern VB (VB.NET), the implicit modifier is ByVal, as it is in most other programming languages. - /// Making the ByRef modifiers explicit can help surface potentially unexpected language defaults. + /// VBA parameters are implicitly ByRef, which differs from modern VB (VB.NET) and most other programming languages which are implicitly ByVal. + /// So, explicitly identifing VBA parameter mechanisms (the ByRef and ByVal modifiers) can help surface potentially unexpected language results. + /// The inspection does not flag an implicit parameter mechanism for the last parameter of Property mutators (Let or Set). + /// VBA applies a ByVal parameter mechanism to the last parameter in the absence (or presence!) of a modifier. + /// Exception: UserDefinedType parameters must always be passed as ByRef. /// /// /// @@ -31,6 +35,16 @@ namespace Rubberduck.CodeAnalysis.Inspections.Concrete /// ]]> /// /// + /// + /// + /// + /// + /// internal sealed class ImplicitByRefModifierInspection : DeclarationInspectionBase { public ImplicitByRefModifierInspection(IDeclarationFinderProvider declarationFinderProvider) @@ -41,21 +55,23 @@ protected override bool IsResultDeclaration(Declaration declaration, Declaration { if (!(declaration is ParameterDeclaration parameter) || !parameter.IsImplicitByRef - || parameter.IsParamArray) + || parameter.IsParamArray + //Exclude parameters of Declare statements + || !(parameter.ParentDeclaration is ModuleBodyElementDeclaration enclosingMethod)) { return false; } - var parentDeclaration = parameter.ParentDeclaration; - - if (parentDeclaration is ModuleBodyElementDeclaration enclosingMethod) - { - return !enclosingMethod.IsInterfaceImplementation - && !finder.FindEventHandlers().Contains(enclosingMethod); - } + return !IsPropertyMutatorRHSParameter(enclosingMethod, parameter) + && !enclosingMethod.IsInterfaceImplementation + && !finder.FindEventHandlers().Contains(enclosingMethod); + } - return parentDeclaration.DeclarationType != DeclarationType.LibraryFunction - && parentDeclaration.DeclarationType != DeclarationType.LibraryProcedure; + private static bool IsPropertyMutatorRHSParameter(ModuleBodyElementDeclaration enclosingMethod, ParameterDeclaration implicitByRefParameter) + { + return (enclosingMethod.DeclarationType.HasFlag(DeclarationType.PropertyLet) + || enclosingMethod.DeclarationType.HasFlag(DeclarationType.PropertySet)) + && enclosingMethod.Parameters.Last().Equals(implicitByRefParameter); } protected override string ResultDescription(Declaration declaration) diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/MisleadingByRefParameterInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/MisleadingByRefParameterInspection.cs new file mode 100644 index 0000000000..7c58237a9d --- /dev/null +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/MisleadingByRefParameterInspection.cs @@ -0,0 +1,68 @@ +using Rubberduck.CodeAnalysis.Inspections.Abstract; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Parsing.VBA.DeclarationCaching; +using Rubberduck.Resources.Inspections; +using System.Linq; + +namespace Rubberduck.CodeAnalysis.Inspections.Concrete +{ + /// + /// Flags the value-parameter of a property mutators that are declared with an explict ByRef modifier. + /// + /// + /// Regardless of the presence or absence of an explicit ByRef or ByVal modifier, the value-parameter + /// of a property mutator is always treated as though it had an explicit ByVal modifier. + /// Exception: UserDefinedType parameters are always passed by reference. + /// + /// + /// + /// + /// + /// + /// + /// + /// + /// + /// + internal sealed class MisleadingByRefParameterInspection : DeclarationInspectionBase + { + public MisleadingByRefParameterInspection(IDeclarationFinderProvider declarationFinderProvider) + : base(declarationFinderProvider, DeclarationType.Parameter) + { } + + protected override bool IsResultDeclaration(Declaration declaration, DeclarationFinder finder) + { + return declaration is ParameterDeclaration parameter + && !(parameter.AsTypeDeclaration?.DeclarationType.HasFlag(DeclarationType.UserDefinedType) ?? false) + && parameter.ParentDeclaration is ModuleBodyElementDeclaration enclosingMethod + && (enclosingMethod.DeclarationType.HasFlag(DeclarationType.PropertyLet) + || enclosingMethod.DeclarationType.HasFlag(DeclarationType.PropertySet)) + && enclosingMethod.Parameters.Last() == parameter + && parameter.IsByRef && !parameter.IsImplicitByRef; + } + + protected override string ResultDescription(Declaration declaration) + { + return string.Format( + InspectionResults.MisleadingByRefParameterInspection, + declaration.IdentifierName, declaration.ParentDeclaration.QualifiedName.MemberName); + } + } +} diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/ThunderCode/NegativeLineNumberInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/ThunderCode/NegativeLineNumberInspection.cs index d0f7eac9a8..76c391197a 100644 --- a/Rubberduck.CodeAnalysis/Inspections/Concrete/ThunderCode/NegativeLineNumberInspection.cs +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/ThunderCode/NegativeLineNumberInspection.cs @@ -1,9 +1,12 @@ -using Antlr4.Runtime; +using System.Linq; +using Antlr4.Runtime; using Antlr4.Runtime.Tree; using Rubberduck.CodeAnalysis.Inspections.Abstract; using Rubberduck.Parsing; using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Symbols; using Rubberduck.Parsing.VBA; +using Rubberduck.Parsing.VBA.DeclarationCaching; using Rubberduck.Resources.Inspections; namespace Rubberduck.CodeAnalysis.Inspections.Concrete.ThunderCode @@ -31,6 +34,27 @@ protected override string ResultDescription(QualifiedContext return InspectionResults.NegativeLineNumberInspection.ThunderCodeFormat(); } + protected override bool IsResultContext(QualifiedContext context, DeclarationFinder finder) + { + return !IsOnErrorGotoMinusOne(context.Context) + || ProcedureHasMinusOneLabel(finder, context); + } + + private static bool IsOnErrorGotoMinusOne(ParserRuleContext context) + { + return context is VBAParser.OnErrorStmtContext onErrorStatement + && "-1".Equals(onErrorStatement.expression()?.GetText().Trim()); + } + + private static bool ProcedureHasMinusOneLabel(DeclarationFinder finder, QualifiedContext context) + { + return finder.Members(context.ModuleName, DeclarationType.LineLabel) + .Any(label => label.IdentifierName.Equals("-1") + && (label.ParentScopeDeclaration + .Context?.GetSelection() + .Contains(context.Context.GetSelection()) ?? false)); + } + private class NegativeLineNumberKeywordsListener : InspectionListenerBase { public override void EnterOnErrorStmt(VBAParser.OnErrorStmtContext context) diff --git a/Rubberduck.CodeAnalysis/QuickFixes/Concrete/PassParameterByValueQuickFix.cs b/Rubberduck.CodeAnalysis/QuickFixes/Concrete/PassParameterByValueQuickFix.cs index a036e0e318..90e2ae795f 100644 --- a/Rubberduck.CodeAnalysis/QuickFixes/Concrete/PassParameterByValueQuickFix.cs +++ b/Rubberduck.CodeAnalysis/QuickFixes/Concrete/PassParameterByValueQuickFix.cs @@ -38,7 +38,7 @@ internal sealed class PassParameterByValueQuickFix : QuickFixBase private readonly IDeclarationFinderProvider _declarationFinderProvider; public PassParameterByValueQuickFix(IDeclarationFinderProvider declarationFinderProvider) - : base(typeof(ParameterCanBeByValInspection)) + : base(typeof(ParameterCanBeByValInspection), typeof(MisleadingByRefParameterInspection)) { _declarationFinderProvider = declarationFinderProvider; } diff --git a/Rubberduck.Main/Root/RubberduckIoCInstaller.cs b/Rubberduck.Main/Root/RubberduckIoCInstaller.cs index 7438914169..97f4845c49 100644 --- a/Rubberduck.Main/Root/RubberduckIoCInstaller.cs +++ b/Rubberduck.Main/Root/RubberduckIoCInstaller.cs @@ -380,7 +380,14 @@ private void RegisterSpecialFactories(IWindsorContainer container) container.Register(Component.For() .ImplementedBy() .LifestyleSingleton()); + + container.Register(Component.For() + .ImplementedBy() + .LifestyleSingleton()); + RegisterUnreachableCaseFactories(container); + + RegisterEncapsulateFieldRefactoringFactories(container); } private void RegisterUnreachableCaseFactories(IWindsorContainer container) @@ -390,6 +397,21 @@ private void RegisterUnreachableCaseFactories(IWindsorContainer container) .LifestyleSingleton()); } + private void RegisterEncapsulateFieldRefactoringFactories(IWindsorContainer container) + { + container.Register(Component.For() + .ImplementedBy() + .LifestyleSingleton()); + container.Register(Component.For() + .ImplementedBy() + .LifestyleSingleton()); + container.Register(Component.For() + .ImplementedBy() + .LifestyleSingleton()); + container.Register(Component.For() + .ImplementedBy() + .LifestyleSingleton()); + } private void RegisterQuickFixes(IWindsorContainer container, Assembly[] assembliesToRegister) { diff --git a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs index e7d819492c..70d959abb0 100644 --- a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs +++ b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs @@ -356,8 +356,11 @@ declared type. private static bool ArgumentListIsCompatible(ICollection parameters, ArgumentList argumentList) { return (parameters.Count >= (argumentList?.Arguments.Count ?? 0) - || parameters.Any(parameter => parameter.IsParamArray)) - && parameters.Count(parameter => !parameter.IsOptional && !parameter.IsParamArray) <= (argumentList?.Arguments.Count ?? 0); + || parameters.Any(parameter => parameter.IsParamArray)) + && parameters.Count(parameter => !parameter.IsOptional && !parameter.IsParamArray) <= (argumentList?.Arguments.Count ?? 0) + || parameters.Count == 0 + && argumentList?.Arguments.Count == 1 + && argumentList.Arguments.Single().ArgumentType == ArgumentListArgumentType.Missing; } private IBoundExpression ResolveRecursiveDefaultMember(Declaration defaultMember, ExpressionClassification defaultMemberClassification, ArgumentList argumentList, ParserRuleContext expression, Declaration parent, int defaultMemberResolutionRecursionDepth, RecursiveDefaultMemberAccessExpression containedExpression) diff --git a/Rubberduck.Parsing/VBA/DeclarationResolving/DeclarationSymbolsListener.cs b/Rubberduck.Parsing/VBA/DeclarationResolving/DeclarationSymbolsListener.cs index 02c4c87328..6e9d19ffe6 100644 --- a/Rubberduck.Parsing/VBA/DeclarationResolving/DeclarationSymbolsListener.cs +++ b/Rubberduck.Parsing/VBA/DeclarationResolving/DeclarationSymbolsListener.cs @@ -646,8 +646,8 @@ private void AddIdentifierStatementLabelDeclaration(VBAParser.IdentifierStatemen private void AddLineNumberLabelDeclaration(VBAParser.LineNumberLabelContext context) { - var statementText = context.numberLiteral().GetText(); - var statementSelection = context.numberLiteral().GetSelection(); + var statementText = context.GetText().Trim(); + var statementSelection = context.GetSelection(); AddDeclaration( CreateDeclaration( diff --git a/Rubberduck.Refactorings/Abstract/RefactoringPreviewProviderWrapperBase.cs b/Rubberduck.Refactorings/Abstract/RefactoringPreviewProviderWrapperBase.cs index 5d4be37753..1ddfbfd46b 100644 --- a/Rubberduck.Refactorings/Abstract/RefactoringPreviewProviderWrapperBase.cs +++ b/Rubberduck.Refactorings/Abstract/RefactoringPreviewProviderWrapperBase.cs @@ -20,7 +20,7 @@ public abstract class RefactoringPreviewProviderWrapperBase : IRefactori protected abstract QualifiedModuleName ComponentToShow(TModel model); - public string Preview(TModel model) + public virtual string Preview(TModel model) { var rewriteSession = RewriteSession(RewriteSessionCodeKind); _refactoringAction.Refactor(model, rewriteSession); diff --git a/Rubberduck.Refactorings/Common/CodeBuilder.cs b/Rubberduck.Refactorings/Common/CodeBuilder.cs index 1f884a1fd3..aff28204e7 100644 --- a/Rubberduck.Refactorings/Common/CodeBuilder.cs +++ b/Rubberduck.Refactorings/Common/CodeBuilder.cs @@ -1,6 +1,7 @@ -using Rubberduck.Common; +using Rubberduck.Parsing; using Rubberduck.Parsing.Grammar; using Rubberduck.Parsing.Symbols; +using Rubberduck.SmartIndenter; using System; using System.Collections.Generic; using System.Linq; @@ -20,9 +21,9 @@ public interface ICodeBuilder /// /// Main body content/logic of the member string BuildMemberBlockFromPrototype(ModuleBodyElementDeclaration declaration, - string content = null, - string accessibility = null, - string newIdentifier = null); + string content = null, + Accessibility accessibility = Accessibility.Public, + string newIdentifier = null); /// /// Returns the argument list for the input ModuleBodyElementDeclaration with the following improvements: @@ -34,90 +35,116 @@ public interface ICodeBuilder /// /// Generates a Property Get codeblock based on the prototype declaration /// - /// VariableDeclaration or UserDefinedTypeMember - /// Member body content. Formatting is the responsibility of the caller + /// DeclarationType with flags: Variable, Constant, UserDefinedTypeMember, or Function + /// Member body content. /// Defaults to 'Value' unless otherwise specified bool TryBuildPropertyGetCodeBlock(Declaration prototype, - string propertyIdentifier, - out string codeBlock, - string accessibility = null, - string content = null); + string propertyIdentifier, + out string codeBlock, + Accessibility accessibility = Accessibility.Public, + string content = null); /// /// Generates a Property Let codeblock based on the prototype declaration /// - /// VariableDeclaration or UserDefinedTypeMember - /// Member body content. Formatting is the responsibility of the caller - /// Defaults to 'Value' unless otherwise specified + /// DeclarationType with flags: Variable, Constant, UserDefinedTypeMember, or Function + /// Member body content. + /// Defaults to 'RHS' unless otherwise specified bool TryBuildPropertyLetCodeBlock(Declaration prototype, - string propertyIdentifier, - out string codeBlock, - string accessibility = null, - string content = null, - string parameterIdentifier = null); + string propertyIdentifier, + out string codeBlock, + Accessibility accessibility = Accessibility.Public, + string content = null, + string parameterIdentifier = null); /// /// Generates a Property Set codeblock based on the prototype declaration /// - /// VariableDeclaration or UserDefinedTypeMember - /// Member body content. Formatting is the responsibility of the caller - /// Defaults to 'Value' unless otherwise specified + /// DeclarationType with flags: Variable, Constant, UserDefinedTypeMember, or Function + /// Member body content. + /// Defaults to 'RHS' unless otherwise specified bool TryBuildPropertySetCodeBlock(Declaration prototype, - string propertyIdentifier, - out string codeBlock, - string accessibility = null, - string content = null, - string parameterIdentifier = null); + string propertyIdentifier, + out string codeBlock, + Accessibility accessibility = Accessibility.Public, + string content = null, + string parameterIdentifier = null); + + /// + /// Generates a UserDefinedType (UDT) declaration using the prototype declarations for + /// creating the UserDefinedTypeMember declarations. + /// + /// + /// No validation or conflict analysis is applied to the identifiers. + /// + /// DeclarationTypes with flags: Variable, Constant, UserDefinedTypeMember, or Function + bool TryBuildUserDefinedTypeDeclaration(string udtIdentifier, IEnumerable<(Declaration Prototype, string UDTMemberIdentifier)> memberPrototypes, out string declaration, Accessibility accessibility = Accessibility.Private); + + /// + /// Generates a UserDefinedTypeMember declaration expression based on the prototype declaration + /// + /// + /// No validation or conflict analysis is applied to the identifiers. + /// + /// DeclarationType with flags: Variable, Constant, UserDefinedTypeMember, or Function + bool TryBuildUDTMemberDeclaration(Declaration prototype, string identifier, out string declaration); + + IIndenter Indenter { get; } } public class CodeBuilder : ICodeBuilder { - public string BuildMemberBlockFromPrototype(ModuleBodyElementDeclaration declaration, - string content = null, - string accessibility = null, - string newIdentifier = null) + public CodeBuilder(IIndenter indenter) { + Indenter = indenter; + } + + public IIndenter Indenter { get; } + public string BuildMemberBlockFromPrototype(ModuleBodyElementDeclaration declaration, + string content = null, + Accessibility accessibility = Accessibility.Public, + string newIdentifier = null) + { var elements = new List() { ImprovedFullMemberSignatureInternal(declaration, accessibility, newIdentifier), Environment.NewLine, string.IsNullOrEmpty(content) ? null : $"{content}{Environment.NewLine}", - ProcedureEndStatement(declaration.DeclarationType), + EndStatement(declaration.DeclarationType), Environment.NewLine, }; return string.Concat(elements); } - public bool TryBuildPropertyGetCodeBlock(Declaration prototype, string propertyIdentifier, out string codeBlock, string accessibility = null, string content = null) + public bool TryBuildPropertyGetCodeBlock(Declaration prototype, string propertyIdentifier, out string codeBlock, Accessibility accessibility = Accessibility.Public, string content = null) => TryBuildPropertyBlockFromTarget(prototype, DeclarationType.PropertyGet, propertyIdentifier, out codeBlock, accessibility, content); - public bool TryBuildPropertyLetCodeBlock(Declaration prototype, string propertyIdentifier, out string codeBlock, string accessibility = null, string content = null, string parameterIdentifier = null) + public bool TryBuildPropertyLetCodeBlock(Declaration prototype, string propertyIdentifier, out string codeBlock, Accessibility accessibility = Accessibility.Public, string content = null, string parameterIdentifier = null) => TryBuildPropertyBlockFromTarget(prototype, DeclarationType.PropertyLet, propertyIdentifier, out codeBlock, accessibility, content, parameterIdentifier); - public bool TryBuildPropertySetCodeBlock(Declaration prototype, string propertyIdentifier, out string codeBlock, string accessibility = null, string content = null, string parameterIdentifier = null) + public bool TryBuildPropertySetCodeBlock(Declaration prototype, string propertyIdentifier, out string codeBlock, Accessibility accessibility = Accessibility.Public, string content = null, string parameterIdentifier = null) => TryBuildPropertyBlockFromTarget(prototype, DeclarationType.PropertySet, propertyIdentifier, out codeBlock, accessibility, content, parameterIdentifier); - private bool TryBuildPropertyBlockFromTarget(T prototype, DeclarationType letSetGetType, string propertyIdentifier, out string codeBlock, string accessibility = null, string content = null, string parameterIdentifier = null) where T : Declaration + private bool TryBuildPropertyBlockFromTarget(T prototype, DeclarationType letSetGetType, string propertyIdentifier, out string codeBlock, Accessibility accessibility, string content = null, string parameterIdentifier = null) where T : Declaration { codeBlock = string.Empty; - if (!letSetGetType.HasFlag(DeclarationType.Property)) - { - throw new ArgumentException(); - } - - if (!(prototype is VariableDeclaration || prototype.DeclarationType.HasFlag(DeclarationType.UserDefinedTypeMember))) + if (!letSetGetType.HasFlag(DeclarationType.Property) + || !IsValidPrototypeDeclarationType(prototype.DeclarationType)) { return false; } var propertyValueParam = parameterIdentifier ?? Resources.Refactorings.Refactorings.CodeBuilder_DefaultPropertyRHSParam; + //TODO: Improve generated Array properties + //Add logic to conditionally return Arrays or Variant depending on Office version. + //Ability to return an Array from a Function or Property was added in Office 2000 http://www.cpearson.com/excel/passingandreturningarrays.htm var asType = prototype.IsArray ? $"{Tokens.Variant}" : IsEnumField(prototype) && prototype.AsTypeDeclaration.Accessibility.Equals(Accessibility.Private) - ? $"{Tokens.Long}" - : $"{prototype.AsTypeName}"; + ? $"{Tokens.Long}" + : $"{prototype.AsTypeName}"; var asTypeClause = $"{Tokens.As} {asType}"; @@ -126,34 +153,32 @@ public bool TryBuildPropertySetCodeBlock(Declaration prototype, string propertyI var letSetParamExpression = $"{paramMechanism} {propertyValueParam} {asTypeClause}"; codeBlock = letSetGetType.HasFlag(DeclarationType.PropertyGet) - ? string.Join(Environment.NewLine, $"{accessibility ?? Tokens.Public} {ProcedureTypeStatement(letSetGetType)} {propertyIdentifier}() {asTypeClause}", content, ProcedureEndStatement(letSetGetType)) - : string.Join(Environment.NewLine, $"{accessibility ?? Tokens.Public} {ProcedureTypeStatement(letSetGetType)} {propertyIdentifier}({letSetParamExpression})", content, ProcedureEndStatement(letSetGetType)); + ? string.Join(Environment.NewLine, $"{AccessibilityToken(accessibility)} {TypeToken(letSetGetType)} {propertyIdentifier}() {asTypeClause}", content, EndStatement(letSetGetType)) + : string.Join(Environment.NewLine, $"{AccessibilityToken(accessibility)} {TypeToken(letSetGetType)} {propertyIdentifier}({letSetParamExpression})", content, EndStatement(letSetGetType)); + + codeBlock = string.Join(Environment.NewLine, Indenter.Indent(codeBlock)); return true; } public string ImprovedFullMemberSignature(ModuleBodyElementDeclaration declaration) - => ImprovedFullMemberSignatureInternal(declaration); + => ImprovedFullMemberSignatureInternal(declaration, declaration.Accessibility); - private string ImprovedFullMemberSignatureInternal(ModuleBodyElementDeclaration declaration, string accessibility = null, string newIdentifier = null) + private string ImprovedFullMemberSignatureInternal(ModuleBodyElementDeclaration declaration, Accessibility accessibility, string newIdentifier = null) { - var accessibilityToken = declaration.Accessibility.Equals(Accessibility.Implicit) - ? Tokens.Public - : $"{declaration.Accessibility.ToString()}"; - var asTypeName = string.IsNullOrEmpty(declaration.AsTypeName) - ? string.Empty - : $" {Tokens.As} {declaration.AsTypeName}"; - + ? string.Empty + : $" {Tokens.As} {declaration.AsTypeName}"; + var elements = new List() { - accessibility ?? accessibilityToken, - $" {ProcedureTypeStatement(declaration.DeclarationType)} ", + AccessibilityToken(accessibility), + $" {TypeToken(declaration.DeclarationType)} ", newIdentifier ?? declaration.IdentifierName, $"({ImprovedArgumentList(declaration)})", asTypeName }; - return string.Concat(elements).Trim(); + return string.Concat(elements).Trim(); } public string ImprovedArgumentList(ModuleBodyElementDeclaration declaration) @@ -164,11 +189,12 @@ public string ImprovedArgumentList(ModuleBodyElementDeclaration declaration) arguments = parameterizedDeclaration.Parameters .OrderBy(parameter => parameter.Selection) .Select(parameter => BuildParameterDeclaration( - parameter, - parameter.Equals(parameterizedDeclaration.Parameters.LastOrDefault()) - && declaration.DeclarationType.HasFlag(DeclarationType.Property) - && !declaration.DeclarationType.Equals(DeclarationType.PropertyGet))); + parameter, + parameter.Equals(parameterizedDeclaration.Parameters.LastOrDefault()) + && declaration.DeclarationType.HasFlag(DeclarationType.Property) + && !declaration.DeclarationType.Equals(DeclarationType.PropertyGet))); } + return $"{string.Join(", ", arguments)}"; } @@ -183,8 +209,8 @@ private static string BuildParameterDeclaration(ParameterDeclaration parameter, : parameter.IsByRef ? Tokens.ByRef : Tokens.ByVal; if (forceExplicitByValAccess - && (string.IsNullOrEmpty(paramMechanism) || paramMechanism.Equals(Tokens.ByRef)) - && !IsUserDefinedType(parameter)) + && (string.IsNullOrEmpty(paramMechanism) || paramMechanism.Equals(Tokens.ByRef)) + && !IsUserDefinedType(parameter)) { paramMechanism = Tokens.ByVal; } @@ -206,48 +232,93 @@ private static string BuildParameterDeclaration(ParameterDeclaration parameter, } private static string FormatOptionalElement(string element) - => string.IsNullOrEmpty(element) ? string.Empty : $"{element} "; + => string.IsNullOrEmpty(element) ? string.Empty : $"{element} "; private static string FormatAsTypeName(string AsTypeName) - => string.IsNullOrEmpty(AsTypeName) ? string.Empty : $"As {AsTypeName} "; + => string.IsNullOrEmpty(AsTypeName) ? string.Empty : $"As {AsTypeName} "; private static string FormatDefaultValue(string DefaultValue) - => string.IsNullOrEmpty(DefaultValue) ? string.Empty : $"= {DefaultValue}"; + => string.IsNullOrEmpty(DefaultValue) ? string.Empty : $"= {DefaultValue}"; + + private static Dictionary _declarationTypeTokens + = new Dictionary() + { + [DeclarationType.Function] = (Tokens.Function, $"{Tokens.End} {Tokens.Function}"), + [DeclarationType.Procedure] = (Tokens.Sub, $"{Tokens.End} {Tokens.Sub}"), + [DeclarationType.PropertyGet] = ($"{Tokens.Property} {Tokens.Get}", $"{Tokens.End} {Tokens.Property}"), + [DeclarationType.PropertyLet] = ($"{Tokens.Property} {Tokens.Let}", $"{Tokens.End} {Tokens.Property}"), + [DeclarationType.PropertySet] = ($"{Tokens.Property} {Tokens.Set}", $"{Tokens.End} {Tokens.Property}"), + }; + + private static string EndStatement(DeclarationType declarationType) + => _declarationTypeTokens[declarationType].EndStatement; + + private static string TypeToken(DeclarationType declarationType) + => _declarationTypeTokens[declarationType].TypeToken; - private static string ProcedureEndStatement(DeclarationType declarationType) + public bool TryBuildUserDefinedTypeDeclaration(string udtIdentifier, IEnumerable<(Declaration Prototype, string UDTMemberIdentifier)> memberPrototypes, out string declaration, Accessibility accessibility = Accessibility.Private) { - switch (declarationType) + if (udtIdentifier is null + ||!memberPrototypes.Any() + || memberPrototypes.Any(p => p.Prototype is null || p.UDTMemberIdentifier is null) + || memberPrototypes.Any(mp => !IsValidPrototypeDeclarationType(mp.Prototype.DeclarationType))) { - case DeclarationType.Function: - return $"{Tokens.End} {Tokens.Function}"; - case DeclarationType.Procedure: - return $"{Tokens.End} {Tokens.Sub}"; - case DeclarationType.PropertyGet: - case DeclarationType.PropertyLet: - case DeclarationType.PropertySet: - return $"{Tokens.End} {Tokens.Property}"; - default: - throw new ArgumentException(); + declaration = string.Empty; + return false; } + + var blockLines = memberPrototypes + .Select(m => BuildUDTMemberDeclaration(m.UDTMemberIdentifier, m.Prototype)) + .ToList(); + + blockLines.Insert(0, $"{accessibility.TokenString()} {Tokens.Type} {udtIdentifier}"); + + blockLines.Add($"{Tokens.End} {Tokens.Type}"); + + declaration = string.Join(Environment.NewLine, Indenter.Indent(blockLines)); + + return true; } - private static string ProcedureTypeStatement(DeclarationType declarationType) + public bool TryBuildUDTMemberDeclaration(Declaration prototype, string udtMemberIdentifier, out string declaration) { - switch (declarationType) + declaration = string.Empty; + + if (udtMemberIdentifier is null + || prototype is null + || !IsValidPrototypeDeclarationType(prototype.DeclarationType)) { - case DeclarationType.Function: - return Tokens.Function; - case DeclarationType.Procedure: - return Tokens.Sub; - case DeclarationType.PropertyGet: - return $"{Tokens.Property} {Tokens.Get}"; - case DeclarationType.PropertyLet: - return $"{Tokens.Property} {Tokens.Let}"; - case DeclarationType.PropertySet: - return $"{Tokens.Property} {Tokens.Set}"; - default: - throw new ArgumentException(); + return false; } + + declaration = BuildUDTMemberDeclaration(udtMemberIdentifier, prototype); + return true; + } + + private static string BuildUDTMemberDeclaration(string udtMemberIdentifier, Declaration prototype) + { + var identifierExpression = udtMemberIdentifier; + if (prototype.IsArray) + { + identifierExpression = prototype.Context.TryGetChildContext(out var ctxt) + ? $"{udtMemberIdentifier}({ctxt.GetText()})" + : $"{udtMemberIdentifier}()"; + } + + return $"{identifierExpression} {Tokens.As} {prototype.AsTypeName}"; + } + + private static string AccessibilityToken(Accessibility accessibility) + => accessibility.Equals(Accessibility.Implicit) + ? Tokens.Public + : $"{accessibility.ToString()}"; + + private static bool IsValidPrototypeDeclarationType(DeclarationType declarationType) + { + return declarationType.HasFlag(DeclarationType.Variable) + || declarationType.HasFlag(DeclarationType.UserDefinedTypeMember) + || declarationType.HasFlag(DeclarationType.Constant) + || declarationType.HasFlag(DeclarationType.Function); } private static bool IsEnumField(VariableDeclaration declaration) @@ -259,10 +330,10 @@ private static bool IsEnumField(Declaration declaration) && (declaration.AsTypeDeclaration?.DeclarationType.Equals(DeclarationType.Enumeration) ?? false); private static bool IsUserDefinedType(Declaration declaration) - => (declaration.AsTypeDeclaration?.DeclarationType.Equals(DeclarationType.UserDefinedType) ?? false); + => (declaration.AsTypeDeclaration?.DeclarationType.Equals(DeclarationType.UserDefinedType) ?? false); private static bool IsMemberVariable(Declaration declaration) => declaration.DeclarationType.HasFlag(DeclarationType.Variable) - && !declaration.ParentDeclaration.DeclarationType.HasFlag(DeclarationType.Member); + && !declaration.ParentDeclaration.DeclarationType.HasFlag(DeclarationType.Member); } } diff --git a/Rubberduck.Refactorings/EncapsulateField/ConflictDetection/EncapsulateFieldConflictFinder.cs b/Rubberduck.Refactorings/EncapsulateField/ConflictDetection/EncapsulateFieldConflictFinder.cs new file mode 100644 index 0000000000..f73143112d --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/ConflictDetection/EncapsulateFieldConflictFinder.cs @@ -0,0 +1,324 @@ +using Rubberduck.Parsing; +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings.Common; +using Rubberduck.Refactorings.EncapsulateField.Extensions; +using Rubberduck.Resources; +using System; +using System.Collections.Generic; +using System.Linq; + +namespace Rubberduck.Refactorings.EncapsulateField +{ + public interface IEncapsulateFieldConflictFinderFactory + { + IEncapsulateFieldConflictFinder Create(IDeclarationFinderProvider declarationFinderProvider, + IEnumerable candidates, + IEnumerable objectStateUDTs); + } + + public interface IEncapsulateFieldConflictFinder + { + bool IsConflictingIdentifier(IEncapsulateFieldCandidate field, string identifierToCompare, out string errorMessage); + (bool IsValid, string ValidationError) ValidateEncapsulationAttributes(IEncapsulateFieldCandidate field); + void AssignNoConflictIdentifiers(IEncapsulateFieldCandidate candidate); + void AssignNoConflictIdentifiers(IObjectStateUDT stateUDT); + void AssignNoConflictIdentifiers(IEnumerable candidates); + void AssignNoConflictBackingFieldIdentifier(IEncapsulateFieldCandidate candidate); + } + + public class EncapsulateFieldConflictFinder : IEncapsulateFieldConflictFinder + { + private static List _declarationTypesThatNeverConflictWithFieldAndPropertyIdentifiers = new List() + { + DeclarationType.Project, + DeclarationType.ProceduralModule, + DeclarationType.ClassModule, + DeclarationType.Parameter, + DeclarationType.Enumeration, + DeclarationType.UserDefinedType, + DeclarationType.UserDefinedTypeMember + }; + + private readonly IDeclarationFinderProvider _declarationFinderProvider; + private readonly List _fieldCandidates; + private readonly List _udtMemberCandidates; + private readonly List _allCandidates; + private readonly List _objectStateUDTs; + private readonly List _members; + private readonly List _membersThatCanConflictWithFieldAndPropertyIdentifiers; + private readonly List _existingUserUDTsAndEnums; + + public EncapsulateFieldConflictFinder(IDeclarationFinderProvider declarationFinderProvider, IEnumerable candidates, IEnumerable objectStateUDTs) + { + _declarationFinderProvider = declarationFinderProvider; + + _fieldCandidates = candidates.ToList(); + + _udtMemberCandidates = new List(); + + _fieldCandidates.ForEach(c => LoadUDTMemberCandidates(c, _udtMemberCandidates)); + + _allCandidates = _fieldCandidates.Concat(_udtMemberCandidates).ToList(); + + _objectStateUDTs = objectStateUDTs.ToList(); + + _members = _declarationFinderProvider.DeclarationFinder.Members(_allCandidates.First().QualifiedModuleName).ToList(); + + _membersThatCanConflictWithFieldAndPropertyIdentifiers = + _members.Where(m => !_declarationTypesThatNeverConflictWithFieldAndPropertyIdentifiers.Contains(m.DeclarationType)).ToList(); + + _existingUserUDTsAndEnums = _members.Where(m => m.DeclarationType.HasFlag(DeclarationType.UserDefinedType) + || m.DeclarationType.HasFlag(DeclarationType.Enumeration)).ToList(); + } + + public (bool IsValid, string ValidationError) ValidateEncapsulationAttributes(IEncapsulateFieldCandidate field) + { + if (!field.EncapsulateFlag) + { + return (true, string.Empty); + } + + var declarationType = field is IEncapsulateFieldAsUDTMemberCandidate + ? DeclarationType.UserDefinedTypeMember + : field.Declaration.DeclarationType; + + var errorMessage = string.Empty; + + if (field.Declaration.IsArray) + { + if (field.Declaration.References.Any(rf => rf.QualifiedModuleName != field.QualifiedModuleName + && rf.Context.TryGetAncestor(out _))) + { + errorMessage = string.Format(RubberduckUI.EncapsulateField_ArrayHasExternalRedimFormat, field.IdentifierName); + return (false, errorMessage); + } + + if (field is IEncapsulateFieldAsUDTMemberCandidate udtMember + && VBAIdentifierValidator.TryMatchInvalidIdentifierCriteria(udtMember.UserDefinedTypeMemberIdentifier, declarationType, out errorMessage, true)) + { + return (false, errorMessage); + } + } + + var hasConflictFreeValidIdentifiers = + !VBAIdentifierValidator.TryMatchInvalidIdentifierCriteria(field.PropertyIdentifier, declarationType, out errorMessage, field.Declaration.IsArray) + && !IsConflictingIdentifier(field, field.PropertyIdentifier, out errorMessage) + && !IsConflictingIdentifier(field, field.BackingIdentifier, out errorMessage) + && !(field is IEncapsulateFieldAsUDTMemberCandidate && ConflictsWithExistingUDTMembers(SelectedObjectStateUDT(), field.BackingIdentifier, out errorMessage)); + + return (hasConflictFreeValidIdentifiers, errorMessage); + } + + public bool IsConflictingIdentifier(IEncapsulateFieldCandidate field, string identifierToCompare, out string errorMessage) + { + errorMessage = string.Empty; + if (HasConflictIdentifiers(field, identifierToCompare)) + { + errorMessage = RubberduckUI.EncapsulateField_NameConflictDetected; + } + return !string.IsNullOrEmpty(errorMessage); + } + + public void AssignNoConflictIdentifiers(IEnumerable candidates) + { + foreach (var candidate in candidates.Where(c => c.EncapsulateFlag)) + { + ResolveIdentifierConflicts(candidate); + } + } + + private void ResolveIdentifierConflicts(IEncapsulateFieldCandidate candidate) + { + AssignNoConflictIdentifiers(candidate); + if (candidate is IUserDefinedTypeCandidate udtCandidate) + { + ResolveUDTMemberIdentifierConflicts(udtCandidate.Members); + } + } + + private void ResolveUDTMemberIdentifierConflicts(IEnumerable members) + { + foreach (var member in members) + { + AssignNoConflictIdentifiers(member); + if (member.WrappedCandidate is IUserDefinedTypeCandidate childUDT + && childUDT.Declaration.AsTypeDeclaration.HasPrivateAccessibility()) + { + ResolveIdentifierConflicts(childUDT); + } + } + } + + public void AssignNoConflictIdentifiers(IEncapsulateFieldCandidate candidate) + { + if (candidate is IEncapsulateFieldAsUDTMemberCandidate udtMember) + { + AssignIdentifier( + () => ConflictsWithExistingUDTMembers(SelectedObjectStateUDT(), udtMember.UserDefinedTypeMemberIdentifier, out _), + () => udtMember.UserDefinedTypeMemberIdentifier = udtMember.UserDefinedTypeMemberIdentifier.IncrementEncapsulationIdentifier()); + return; + } + + AssignNoConflictPropertyIdentifier(candidate); + AssignNoConflictBackingFieldIdentifier(candidate); + } + + public void AssignNoConflictIdentifiers(IObjectStateUDT stateUDT) + { + AssignIdentifier( + () => _existingUserUDTsAndEnums.Any(m => m.IdentifierName.IsEquivalentVBAIdentifierTo(stateUDT.TypeIdentifier)), + () => stateUDT.TypeIdentifier = stateUDT.TypeIdentifier.IncrementEncapsulationIdentifier()); + + AssignIdentifier( + () => HasConflictingFieldIdentifier(stateUDT, stateUDT.FieldIdentifier), + () => stateUDT.FieldIdentifier = stateUDT.FieldIdentifier.IncrementEncapsulationIdentifier()); + } + + private IObjectStateUDT SelectedObjectStateUDT() + => _objectStateUDTs.SingleOrDefault(os => os.IsSelected); + + private static bool ConflictsWithExistingUDTMembers(IObjectStateUDT objectStateUDT, string identifier, out string errorMessage) + { + errorMessage = string.Empty; + if (objectStateUDT?.ExistingMembers.Any(nm => nm.IdentifierName.IsEquivalentVBAIdentifierTo(identifier)) ?? false) + { + errorMessage = RubberduckUI.EncapsulateField_NameConflictDetected; + } + return !string.IsNullOrEmpty(errorMessage); + } + + private void AssignNoConflictPropertyIdentifier(IEncapsulateFieldCandidate candidate) + { + AssignIdentifier( + () => IsConflictingIdentifier(candidate, candidate.PropertyIdentifier, out _), + () => candidate.PropertyIdentifier = candidate.PropertyIdentifier.IncrementEncapsulationIdentifier()); + } + + public void AssignNoConflictBackingFieldIdentifier(IEncapsulateFieldCandidate candidate) + { + if (candidate.BackingIdentifierMutator != null) + { + AssignIdentifier( + () => IsConflictingIdentifier(candidate, candidate.BackingIdentifier, out _), + () => candidate.BackingIdentifierMutator(candidate.BackingIdentifier.IncrementEncapsulationIdentifier())); + } + } + + private static void AssignIdentifier(Func hasConflict, Action incrementIdentifier, int maxAttempts = 20) + { + var guard = 0; + while (guard++ < maxAttempts && hasConflict()) + { + incrementIdentifier(); + } + + if (guard >= maxAttempts) + { + throw new OverflowException("Unable to assign a non conflicting identifier"); + } + } + + private bool HasConflictIdentifiers(IEncapsulateFieldCandidate candidate, string identifierToCompare) + { + return HasInternalPropertyAndBackingFieldConflict(candidate) + || HasConflictsWithOtherEncapsulationPropertyIdentifiers(candidate, identifierToCompare) + || HasConflictsWithUnmodifiedPropertyAndFieldIdentifiers(candidate, identifierToCompare) + || HasConflictWithLocalDeclarationIdentifiers(candidate, identifierToCompare); + } + + private bool HasInternalPropertyAndBackingFieldConflict(IEncapsulateFieldCandidate candidate) + => candidate.BackingIdentifierMutator != null + && candidate.EncapsulateFlag + && candidate.PropertyIdentifier.IsEquivalentVBAIdentifierTo(candidate.BackingIdentifier); + + private bool HasConflictsWithOtherEncapsulationPropertyIdentifiers(IEncapsulateFieldCandidate candidate, string identifierToCompare) + => _allCandidates.Where(c => c.TargetID != candidate.TargetID + && c.EncapsulateFlag + && c.PropertyIdentifier.IsEquivalentVBAIdentifierTo(identifierToCompare)).Any(); + + private bool HasConflictsWithUnmodifiedPropertyAndFieldIdentifiers(IEncapsulateFieldCandidate candidate, string identifierToCompare) + { + var membersToEvaluate = _members.Where(d => d != candidate.Declaration); + + if (candidate is IEncapsulateFieldAsUDTMemberCandidate) + { + membersToEvaluate = membersToEvaluate.Except( + _fieldCandidates.Where(fc => fc.EncapsulateFlag && fc.Declaration.DeclarationType.HasFlag(DeclarationType.Variable)) + .Select(f => f.Declaration)); + } + + var nameConflictCandidates = membersToEvaluate.Where(member => !(member.IsLocalVariable() || member.IsLocalConstant() + || _declarationTypesThatNeverConflictWithFieldAndPropertyIdentifiers.Contains(member.DeclarationType))); + + return nameConflictCandidates.Any(m => m.IdentifierName.IsEquivalentVBAIdentifierTo(identifierToCompare)); + } + + private bool HasConflictWithLocalDeclarationIdentifiers(IEncapsulateFieldCandidate candidate, string identifierToCompare) + { + var membersToEvaluate = _members.Where(d => d != candidate.Declaration); + + if (candidate is IEncapsulateFieldAsUDTMemberCandidate) + { + membersToEvaluate = membersToEvaluate.Except( + _fieldCandidates.Where(fc => fc.EncapsulateFlag && fc.Declaration.DeclarationType.HasFlag(DeclarationType.Variable)) + .Select(f => f.Declaration)); + } + + //Only check IdentifierReferences in the declaring module because encapsulated field + //references in other modules will be module-qualified. + var candidateLocalReferences = candidate.Declaration.References.Where(rf => rf.QualifiedModuleName == candidate.QualifiedModuleName); + + var localDeclarationConflictCandidates = membersToEvaluate.Where(localDec => candidateLocalReferences + .Any(cr => cr.ParentScoping == localDec.ParentScopeDeclaration)); + + return localDeclarationConflictCandidates.Any(m => m.IdentifierName.IsEquivalentVBAIdentifierTo(identifierToCompare)); + } + + private bool HasConflictingFieldIdentifier(IObjectStateUDT candidate, string identifierToCompare) + { + if (candidate.IsExistingDeclaration) + { + return false; + } + + if (_allCandidates.Where(c => c.EncapsulateFlag + && c.PropertyIdentifier.IsEquivalentVBAIdentifierTo(identifierToCompare)).Any()) + { + return true; + } + + var fieldsToRemoveFromConflictCandidates = _fieldCandidates + .Where(fc => fc.EncapsulateFlag && fc.Declaration.DeclarationType.HasFlag(DeclarationType.Variable)) + .Select(fc => fc.Declaration); + + var nameConflictCandidates = + _members.Except(fieldsToRemoveFromConflictCandidates) + .Where(member => !(member.IsLocalVariable() || member.IsLocalConstant() + || _declarationTypesThatNeverConflictWithFieldAndPropertyIdentifiers.Contains(member.DeclarationType))); + + return nameConflictCandidates.Any(m => m.IdentifierName.IsEquivalentVBAIdentifierTo(identifierToCompare)); + } + + private void LoadUDTMemberCandidates(IEncapsulateFieldCandidate candidate, List udtMemberCandidates) + { + if (!(candidate is IUserDefinedTypeCandidate udtCandidate)) + { + return; + } + + foreach (var member in udtCandidate.Members) + { + udtMemberCandidates.Add(member); + + if (member.WrappedCandidate is IUserDefinedTypeCandidate childUDT + && childUDT.Declaration.AsTypeDeclaration.HasPrivateAccessibility()) + { + //recursive till a non-UserDefinedType member is found + LoadUDTMemberCandidates(childUDT, udtMemberCandidates); + } + } + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldCandidateSetsProvider.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldCandidateSetsProvider.cs new file mode 100644 index 0000000000..f5a705d79c --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldCandidateSetsProvider.cs @@ -0,0 +1,65 @@ +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.VBEditor; +using System.Collections.Generic; +using System.Linq; + +namespace Rubberduck.Refactorings.EncapsulateField +{ + public interface IEncapsulateFieldCandidateSetsProviderFactory + { + IEncapsulateFieldCandidateSetsProvider Create(IDeclarationFinderProvider declarationFinderProvider, + IEncapsulateFieldCandidateFactory encapsulateFieldCandidateFactory, + QualifiedModuleName qualifiedModuleName); + } + + public interface IEncapsulateFieldCandidateSetsProvider + { + IReadOnlyCollection EncapsulateFieldUseBackingFieldCandidates { get; } + IReadOnlyCollection EncapsulateFieldUseBackingUDTMemberCandidates { get; } + IReadOnlyCollection ObjectStateFieldCandidates { get; } + } + + /// + /// EncapsulateFieldCandidateSetsProvider provides access to a sets of + /// EncapsulateField candidate instances to be shared among EncapsulateFieldRefactoringActions. + /// + public class EncapsulateFieldCandidateSetsProvider : IEncapsulateFieldCandidateSetsProvider + { + public EncapsulateFieldCandidateSetsProvider(IDeclarationFinderProvider declarationFinderProvider, + IEncapsulateFieldCandidateFactory encapsulateFieldCandidateFactory, + QualifiedModuleName qualifiedModuleName) + { + EncapsulateFieldUseBackingFieldCandidates = declarationFinderProvider.DeclarationFinder.Members(qualifiedModuleName, DeclarationType.Variable) + .Where(v => v.ParentDeclaration is ModuleDeclaration + && !v.IsWithEvents) + .Select(f => encapsulateFieldCandidateFactory.CreateFieldCandidate(f)) + .ToList(); + + var objectStateUDTCandidates = EncapsulateFieldUseBackingFieldCandidates + .OfType() + .Where(fc => fc.Declaration.Accessibility == Accessibility.Private + && fc.Declaration.AsTypeDeclaration.Accessibility == Accessibility.Private) + .Select(udtc => encapsulateFieldCandidateFactory.CreateObjectStateField(udtc)) + //If multiple fields of the same UserDefinedType exist, they are all disqualified as candidates to host a module's state. + .ToLookup(objectStateUDTCandidate => objectStateUDTCandidate.Declaration.AsTypeDeclaration.IdentifierName) + .Where(osc => osc.Count() == 1) + .SelectMany(osc => osc) + .ToList(); + + var defaultObjectStateUDT = encapsulateFieldCandidateFactory.CreateDefaultObjectStateField(qualifiedModuleName); + objectStateUDTCandidates.Add(defaultObjectStateUDT); + ObjectStateFieldCandidates = objectStateUDTCandidates; + + EncapsulateFieldUseBackingUDTMemberCandidates = EncapsulateFieldUseBackingFieldCandidates + .Select(fc => encapsulateFieldCandidateFactory.CreateUDTMemberCandidate(fc, defaultObjectStateUDT)) + .ToList(); + } + + public IReadOnlyCollection EncapsulateFieldUseBackingFieldCandidates { get; } + + public IReadOnlyCollection EncapsulateFieldUseBackingUDTMemberCandidates { get; } + + public IReadOnlyCollection ObjectStateFieldCandidates { get; } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldElementsBuilder.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldElementsBuilder.cs deleted file mode 100644 index 6b36b7bb02..0000000000 --- a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldElementsBuilder.cs +++ /dev/null @@ -1,162 +0,0 @@ -using Rubberduck.Parsing.Symbols; -using Rubberduck.Parsing.VBA; -using Rubberduck.Refactorings.Common; -using Rubberduck.VBEditor; -using System; -using System.Collections.Generic; -using System.Diagnostics; -using System.Linq; - -namespace Rubberduck.Refactorings.EncapsulateField -{ - public class EncapsulateFieldElementsBuilder - { - private readonly IDeclarationFinderProvider _declarationFinderProvider; - private QualifiedModuleName _targetQMN; - private string _defaultObjectStateUDTTypeName; - private ICodeBuilder _codeBuilder; - - public EncapsulateFieldElementsBuilder(IDeclarationFinderProvider declarationFinderProvider, QualifiedModuleName targetQMN) - { - _declarationFinderProvider = declarationFinderProvider; - _targetQMN = targetQMN; - _defaultObjectStateUDTTypeName = $"T{_targetQMN.ComponentName}"; - _codeBuilder = new CodeBuilder(); - CreateRefactoringElements(); - } - - public IObjectStateUDT DefaultObjectStateUDT { private set; get; } - - public IObjectStateUDT ObjectStateUDT { private set; get; } - - public IEncapsulateFieldValidationsProvider ValidationsProvider { private set; get; } - - public IEnumerable Candidates { private set; get; } - - public IEnumerable ObjectStateUDTCandidates { private set; get; } = new List(); - - private void CreateRefactoringElements() - { - var fieldDeclarations = _declarationFinderProvider.DeclarationFinder - .Members(_targetQMN) - .Where(v => v.IsMemberVariable() && !v.IsWithEvents); - - var defaultNamesValidator = EncapsulateFieldValidationsProvider.NameOnlyValidator(NameValidators.Default); - - var candidates = new List(); - foreach (var fieldDeclaration in fieldDeclarations) - { - Debug.Assert(!fieldDeclaration.DeclarationType.Equals(DeclarationType.UserDefinedTypeMember)); - - var fieldEncapsulationCandidate = CreateCandidate(fieldDeclaration, defaultNamesValidator); - - candidates.Add(fieldEncapsulationCandidate); - } - - Candidates = candidates; - - ObjectStateUDTCandidates = BuildObjectStateUDTCandidates(candidates).ToList(); - - ObjectStateUDT = ObjectStateUDTCandidates.FirstOrDefault(os => os.AsTypeDeclaration.IdentifierName.StartsWith(_defaultObjectStateUDTTypeName, StringComparison.InvariantCultureIgnoreCase)); - - DefaultObjectStateUDT = CreateStateUDTField(); - DefaultObjectStateUDT.IsSelected = true; - if (ObjectStateUDT != null) - { - ObjectStateUDT.IsSelected = true; - DefaultObjectStateUDT.IsSelected = false; - } - - ObjectStateUDTCandidates = ObjectStateUDTCandidates.Concat(new IObjectStateUDT[] { DefaultObjectStateUDT }); - - ValidationsProvider = new EncapsulateFieldValidationsProvider(Candidates, ObjectStateUDTCandidates); - - var conflictsFinder = ValidationsProvider.ConflictDetector(EncapsulateFieldStrategy.UseBackingFields, _declarationFinderProvider); - foreach (var candidate in candidates) - { - candidate.ConflictFinder = conflictsFinder; - } - } - - private IEnumerable BuildObjectStateUDTCandidates(IEnumerable candidates) - { - var udtCandidates = candidates.Where(c => c is IUserDefinedTypeCandidate udt - && udt.CanBeObjectStateUDT); - - var objectStateUDTs = new List(); - foreach (var udt in udtCandidates) - { - objectStateUDTs.Add(new ObjectStateUDT(udt as IUserDefinedTypeCandidate)); - } - - var objectStateUDT = objectStateUDTs.FirstOrDefault(os => os.AsTypeDeclaration.IdentifierName.StartsWith(_defaultObjectStateUDTTypeName, StringComparison.InvariantCultureIgnoreCase)); - - return objectStateUDTs; - } - - private IObjectStateUDT CreateStateUDTField() - { - var stateUDT = new ObjectStateUDT(_targetQMN) as IObjectStateUDT; - - EncapsulateFieldValidationsProvider.AssignNoConflictIdentifiers(stateUDT, _declarationFinderProvider); - - stateUDT.IsSelected = true; - - return stateUDT; - } - - private IEncapsulateFieldCandidate CreateCandidate(Declaration target, IValidateVBAIdentifiers validator) - { - if (target.IsUserDefinedType()) - { - var udtValidator = EncapsulateFieldValidationsProvider.NameOnlyValidator(NameValidators.UserDefinedType); - var udtField = new UserDefinedTypeCandidate(target, udtValidator) as IUserDefinedTypeCandidate; - - (Declaration udtDeclaration, IEnumerable udtMembers) = GetUDTAndMembersForField(udtField); - - udtField.TypeDeclarationIsPrivate = udtDeclaration.HasPrivateAccessibility(); - - udtField.NameValidator = udtValidator; - - foreach (var udtMemberDeclaration in udtMembers) - { - var udtMemberValidator = EncapsulateFieldValidationsProvider.NameOnlyValidator(NameValidators.UserDefinedTypeMember); - if (udtMemberDeclaration.IsArray) - { - udtMemberValidator = EncapsulateFieldValidationsProvider.NameOnlyValidator(NameValidators.UserDefinedTypeMemberArray); - } - var candidateUDTMember = new UserDefinedTypeMemberCandidate(CreateCandidate(udtMemberDeclaration, udtMemberValidator), udtField) as IUserDefinedTypeMemberCandidate; - - udtField.AddMember(candidateUDTMember); - } - - var udtVariablesOfSameType = _declarationFinderProvider.DeclarationFinder.UserDeclarations(DeclarationType.Variable) - .Where(v => v.AsTypeDeclaration == udtDeclaration); - - udtField.CanBeObjectStateUDT = udtField.TypeDeclarationIsPrivate - && udtField.Declaration.HasPrivateAccessibility() - && udtVariablesOfSameType.Count() == 1; - - return udtField; - } - else if (target.IsArray) - { - return new ArrayCandidate(target, validator); - } - - var candidate = new EncapsulateFieldCandidate(target, validator); - return candidate; - } - - private (Declaration TypeDeclaration, IEnumerable Members) GetUDTAndMembersForField(IUserDefinedTypeCandidate udtField) - { - var userDefinedTypeDeclaration = udtField.Declaration.AsTypeDeclaration; - - var udtMembers = _declarationFinderProvider.DeclarationFinder - .UserDeclarations(DeclarationType.UserDefinedTypeMember) - .Where(utm => userDefinedTypeDeclaration == utm.ParentDeclaration); - - return (userDefinedTypeDeclaration, udtMembers); - } - } -} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldInsertNewCode/EncapsulateFieldCodeBuilder.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldInsertNewCode/EncapsulateFieldCodeBuilder.cs new file mode 100644 index 0000000000..944bf911f1 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldInsertNewCode/EncapsulateFieldCodeBuilder.cs @@ -0,0 +1,95 @@ +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Symbols; +using System; +using System.Collections.Generic; +using System.Linq; + +namespace Rubberduck.Refactorings.EncapsulateField +{ + public interface IEncapsulateFieldCodeBuilder + { + (string Get, string Let, string Set) BuildPropertyBlocks(PropertyAttributeSet propertyAttributeSet); + string BuildUserDefinedTypeDeclaration(IObjectStateUDT objectStateUDT, IEnumerable candidates); + string BuildObjectStateFieldDeclaration(IObjectStateUDT objectStateUDT); + string BuildFieldDeclaration(Declaration target, string identifier); + } + + /// + /// EncapsulateFieldCodeBuilder wraps an ICodeBuilder instance to extend it for the + /// specific needs of an EncapsulateField refactoring action. + /// + public class EncapsulateFieldCodeBuilder : IEncapsulateFieldCodeBuilder + { + private readonly ICodeBuilder _codeBuilder; + + public EncapsulateFieldCodeBuilder(ICodeBuilder codeBuilder) + { + _codeBuilder = codeBuilder; + } + + public (string Get, string Let, string Set) BuildPropertyBlocks(PropertyAttributeSet propertyAttributes) + { + if (!(propertyAttributes.Declaration.DeclarationType.HasFlag(DeclarationType.Variable) + || propertyAttributes.Declaration.DeclarationType.HasFlag(DeclarationType.UserDefinedTypeMember))) + { + throw new ArgumentException("Invalid prototype DeclarationType", nameof(propertyAttributes)); + } + + (string Get, string Let, string Set) blocks = (string.Empty, string.Empty, string.Empty); + + var mutatorBody = $"{propertyAttributes.BackingField} = {propertyAttributes.RHSParameterIdentifier}"; + + if (propertyAttributes.GeneratePropertyLet) + { + _codeBuilder.TryBuildPropertyLetCodeBlock(propertyAttributes.Declaration, propertyAttributes.PropertyName, out blocks.Let, content: mutatorBody); + } + + if (propertyAttributes.GeneratePropertySet) + { + _codeBuilder.TryBuildPropertySetCodeBlock(propertyAttributes.Declaration, propertyAttributes.PropertyName, out blocks.Set, content: $"{Tokens.Set} {mutatorBody}"); + } + + var propertyGetBody = propertyAttributes.UsesSetAssignment + ? $"{Tokens.Set} {propertyAttributes.PropertyName} = {propertyAttributes.BackingField}" + : $"{propertyAttributes.PropertyName} = {propertyAttributes.BackingField}"; + + if (propertyAttributes.AsTypeName.Equals(Tokens.Variant) && !propertyAttributes.Declaration.IsArray) + { + propertyGetBody = string.Join( + $"{Tokens.If} IsObject({propertyAttributes.BackingField}) {Tokens.Then}", + $"{Tokens.Set} {propertyAttributes.PropertyName} = {propertyAttributes.BackingField}", + Tokens.Else, + $"{propertyAttributes.PropertyName} = {propertyAttributes.BackingField}", + $"{Tokens.End} {Tokens.If}"); + } + + _codeBuilder.TryBuildPropertyGetCodeBlock(propertyAttributes.Declaration, propertyAttributes.PropertyName, out blocks.Get, content: propertyGetBody); + + return (blocks.Get, blocks.Let, blocks.Set); + } + + public string BuildUserDefinedTypeDeclaration(IObjectStateUDT objectStateUDT, IEnumerable candidates) + { + var newUDTMembers = candidates.Where(c => c.EncapsulateFlag) + .Select(m => (m.Declaration, m.BackingIdentifier)); + + if (_codeBuilder.TryBuildUserDefinedTypeDeclaration(objectStateUDT.AsTypeName, newUDTMembers, out var declaration)) + { + return declaration; + } + + return string.Empty; + } + + public string BuildObjectStateFieldDeclaration(IObjectStateUDT objectStateUDT) + => $"{Accessibility.Private} {objectStateUDT.IdentifierName} {Tokens.As} {objectStateUDT.AsTypeName}"; + + public string BuildFieldDeclaration(Declaration target, string identifier) + { + var identifierExpressionSansVisibility = target.Context.GetText().Replace(target.IdentifierName, identifier); + return target.IsTypeSpecified + ? $"{Tokens.Private} {identifierExpressionSansVisibility}" + : $"{Tokens.Private} {identifierExpressionSansVisibility} {Tokens.As} {target.AsTypeName}"; + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldInsertNewCode/EncapsulateFieldInsertNewCodeModel.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldInsertNewCode/EncapsulateFieldInsertNewCodeModel.cs new file mode 100644 index 0000000000..04a6d76d73 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldInsertNewCode/EncapsulateFieldInsertNewCodeModel.cs @@ -0,0 +1,31 @@ +using Rubberduck.VBEditor; +using System.Collections.Generic; +using System.Linq; +using Rubberduck.Refactorings.EncapsulateField; + +namespace Rubberduck.Refactorings.EncapsulateFieldInsertNewCode +{ + public class EncapsulateFieldInsertNewCodeModel : IRefactoringModel + { + public EncapsulateFieldInsertNewCodeModel(IEnumerable selectedFieldCandidates) + { + SelectedFieldCandidates = selectedFieldCandidates.ToList(); + if (SelectedFieldCandidates.Any()) + { + QualifiedModuleName = SelectedFieldCandidates.First().QualifiedModuleName; + } + } + + public INewContentAggregator NewContentAggregator { set; get; } + + public QualifiedModuleName QualifiedModuleName { get; } = new QualifiedModuleName(); + + public bool CreateNewObjectStateUDT => !ObjectStateUDTField?.IsExistingDeclaration ?? false; + + public IObjectStateUDT ObjectStateUDTField { set; get; } + + public IReadOnlyCollection SelectedFieldCandidates { get; } + + public IEnumerable CandidatesRequiringNewBackingFields { set; get; } = Enumerable.Empty(); + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldInsertNewCode/EncapsulateFieldInsertNewCodeRefactoringAction.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldInsertNewCode/EncapsulateFieldInsertNewCodeRefactoringAction.cs new file mode 100644 index 0000000000..98fb44da45 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldInsertNewCode/EncapsulateFieldInsertNewCodeRefactoringAction.cs @@ -0,0 +1,116 @@ +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings.Common; +using Rubberduck.Resources; +using System; +using System.Diagnostics; +using System.Linq; +using Rubberduck.Refactorings.EncapsulateField; +using System.Collections.Generic; + +namespace Rubberduck.Refactorings.EncapsulateFieldInsertNewCode +{ + /// + /// EncapsulateFieldInsertNewCodeRefactoringAction is a refactoring action dedicated to + /// the insertion of new code content generated by EncapsulateField refactoring actions + /// + public class EncapsulateFieldInsertNewCodeRefactoringAction : CodeOnlyRefactoringActionBase + { + private readonly IDeclarationFinderProvider _declarationFinderProvider; + private readonly IPropertyAttributeSetsGenerator _propertyAttributeSetsGenerator; + private readonly IEncapsulateFieldCodeBuilder _encapsulateFieldCodeBuilder; + + public EncapsulateFieldInsertNewCodeRefactoringAction( + IDeclarationFinderProvider declarationFinderProvider, + IRewritingManager rewritingManager, + IPropertyAttributeSetsGenerator propertyAttributeSetsGenerator, + IEncapsulateFieldCodeBuilder encapsulateFieldCodeBuilder) + : base(rewritingManager) + { + _declarationFinderProvider = declarationFinderProvider; + _propertyAttributeSetsGenerator = propertyAttributeSetsGenerator; + _encapsulateFieldCodeBuilder = encapsulateFieldCodeBuilder; + } + + public override void Refactor(EncapsulateFieldInsertNewCodeModel model, IRewriteSession rewriteSession) + { + if (model.CreateNewObjectStateUDT) + { + CreateObjectStateUDTElements(model, rewriteSession); + } + + CreateBackingFields(model, rewriteSession); + + CreatePropertyBlocks(model, rewriteSession); + + InsertBlocks(model, rewriteSession); + } + + private void CreateObjectStateUDTElements(EncapsulateFieldInsertNewCodeModel model, IRewriteSession rewriteSession) + { + var objectStateFieldDeclaration = _encapsulateFieldCodeBuilder.BuildObjectStateFieldDeclaration(model.ObjectStateUDTField); + model.NewContentAggregator.AddNewContent(NewContentType.DeclarationBlock, objectStateFieldDeclaration); + + var objectStateTypeDeclarationBlock = _encapsulateFieldCodeBuilder.BuildUserDefinedTypeDeclaration(model.ObjectStateUDTField, model.SelectedFieldCandidates); + model.NewContentAggregator.AddNewContent(NewContentType.UserDefinedTypeDeclaration, objectStateTypeDeclarationBlock); + } + + private void CreateBackingFields(EncapsulateFieldInsertNewCodeModel model, IRewriteSession rewriteSession) + { + foreach (var field in model.CandidatesRequiringNewBackingFields) + { + var newFieldDeclaration = _encapsulateFieldCodeBuilder.BuildFieldDeclaration(field.Declaration, field.BackingIdentifier); + model.NewContentAggregator.AddNewContent(NewContentType.DeclarationBlock, newFieldDeclaration); + } + } + + private void CreatePropertyBlocks(EncapsulateFieldInsertNewCodeModel model, IRewriteSession rewriteSession) + { + var propAttributeSets = model.SelectedFieldCandidates + .SelectMany(f => _propertyAttributeSetsGenerator.GeneratePropertyAttributeSets(f)).ToList(); + + foreach (var propertyAttributeSet in propAttributeSets) + { + Debug.Assert(propertyAttributeSet.Declaration.DeclarationType.HasFlag(DeclarationType.Variable) || propertyAttributeSet.Declaration.DeclarationType.HasFlag(DeclarationType.UserDefinedTypeMember)); + + var (Get, Let, Set) = _encapsulateFieldCodeBuilder.BuildPropertyBlocks(propertyAttributeSet); + + var blocks = new List() { Get, Let, Set }; + blocks.ForEach(s => model.NewContentAggregator.AddNewContent(NewContentType.CodeSectionBlock, s)); + } + } + + private void InsertBlocks(EncapsulateFieldInsertNewCodeModel model, IRewriteSession rewriteSession) + { + + var newDeclarationSectionBlock = model.NewContentAggregator.RetrieveBlock(NewContentType.UserDefinedTypeDeclaration, NewContentType.DeclarationBlock, NewContentType.CodeSectionBlock); + if (string.IsNullOrEmpty(newDeclarationSectionBlock)) + { + return; + } + + var allNewContent = string.Join(NewLines.DOUBLE_SPACE, new string[] { newDeclarationSectionBlock }); + + var previewMarker = model.NewContentAggregator.RetrieveBlock(RubberduckUI.EncapsulateField_PreviewMarker); + if (!string.IsNullOrEmpty(previewMarker)) + { + allNewContent = $"{allNewContent}{Environment.NewLine}{previewMarker}"; + } + + var rewriter = rewriteSession.CheckOutModuleRewriter(model.QualifiedModuleName); + + var codeSectionStartIndex = _declarationFinderProvider.DeclarationFinder + .Members(model.QualifiedModuleName).Where(m => m.IsMember()) + .OrderBy(c => c.Selection) + .FirstOrDefault()?.Context.Start.TokenIndex; + + if (codeSectionStartIndex.HasValue) + { + rewriter.InsertBefore(codeSectionStartIndex.Value, $"{allNewContent}{NewLines.DOUBLE_SPACE}"); + return; + } + rewriter.InsertBefore(rewriter.TokenStream.Size - 1, $"{NewLines.DOUBLE_SPACE}{allNewContent}"); + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldInsertNewCode/NewContentAggregator.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldInsertNewCode/NewContentAggregator.cs new file mode 100644 index 0000000000..09924c6198 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldInsertNewCode/NewContentAggregator.cs @@ -0,0 +1,146 @@ +using System; +using System.Collections.Generic; +using System.Linq; +using Rubberduck.Resources; + +namespace Rubberduck.Refactorings.EncapsulateField +{ + public enum NewContentType + { + UserDefinedTypeDeclaration, + DeclarationBlock, + CodeSectionBlock, + } + + public interface INewContentAggregatorFactory + { + INewContentAggregator Create(); + } + + public interface INewContentAggregator + { + /// + /// Allows gouping content blocks by NewContentType. + /// + void AddNewContent(NewContentType contentType, string block); + /// + /// Allows gouping content blocks by an adhoc identifier. + /// + void AddNewContent(string contentIdentifier, string block); + /// + /// Retrieves a block of content aggregated by NewContentType. + /// + /// NewContentType blocks to aggregate + string RetrieveBlock(params NewContentType[] newContentTypes); + /// + /// Retrieves a block of content aggregated by a user-determined identifier. + /// + /// NewContentType blocks to aggregate + string RetrieveBlock(params string[] contentIdentifiers); + /// + /// Sets default number of NewLines between blocks of code after + /// all retrieving block(s) of code. The default value is 2. + /// + int NewLineLimit { set; get; } + } + + /// + /// NewContentAggregator provides a repository for caching generated code blocks + /// and retrieving them as an aggregated single block of code organized by NewContentType. + /// + public class NewContentAggregator : INewContentAggregator + { + private readonly Dictionary> _newContent; + private Dictionary> _unStructuredContent; + + public NewContentAggregator() + { + _newContent = new Dictionary> + { + { NewContentType.UserDefinedTypeDeclaration, new List() }, + { NewContentType.DeclarationBlock, new List() }, + { NewContentType.CodeSectionBlock, new List() }, + }; + + _unStructuredContent = new Dictionary>(); + } + + public void AddNewContent(NewContentType contentType, string newContent) + { + if (!string.IsNullOrEmpty(newContent)) + { + _newContent[contentType].Add(newContent); + } + } + + public void AddNewContent(string contentIdentifier, string newContent) + { + if (!string.IsNullOrEmpty(newContent)) + { + if (!_unStructuredContent.ContainsKey(contentIdentifier)) + { + _unStructuredContent.Add(contentIdentifier, new List()); + } + _unStructuredContent[contentIdentifier].Add(newContent); + } + } + + public string RetrieveBlock(params NewContentType[] newContentTypes) + { + var block = string.Empty; + foreach (var newContentType in newContentTypes) + { + var newContent = string.Join(NewLines.DOUBLE_SPACE, _newContent[newContentType]); + if (!string.IsNullOrEmpty(newContent)) + { + block = string.IsNullOrEmpty(block) + ? newContent + : $"{block}{NewLines.DOUBLE_SPACE}{newContent}"; + } + } + return LimitNewLines(block.Trim(), NewLineLimit); + } + + public string RetrieveBlock(params string[] contentIdentifiers) + { + var block = string.Empty; + foreach (var identifier in contentIdentifiers) + { + if (_unStructuredContent.TryGetValue(identifier, out var adHocContent)) + { + var newContent = string.Join(NewLines.DOUBLE_SPACE, adHocContent); + if (!string.IsNullOrEmpty(newContent)) + { + block = string.IsNullOrEmpty(block) + ? newContent + : $"{block}{NewLines.DOUBLE_SPACE}{newContent}"; + } + } + } + + return string.IsNullOrEmpty(block) + ? null + : LimitNewLines(block.Trim(), NewLineLimit); + } + + public int NewLineLimit { set; get; } = 2; + + private static string LimitNewLines(string content, int maxConsecutiveNewlines = 2) + { + var target = string.Concat(Enumerable.Repeat(Environment.NewLine, maxConsecutiveNewlines + 1).ToList()); + var replacement = string.Concat(Enumerable.Repeat(Environment.NewLine, maxConsecutiveNewlines).ToList()); + var guard = 0; + var maxAttempts = 100; + while (++guard < maxAttempts && content.Contains(target)) + { + content = content.Replace(target, replacement); + } + + if (guard >= maxAttempts) + { + throw new FormatException($"Unable to limit consecutive '{Environment.NewLine}' strings to {maxConsecutiveNewlines}"); + } + return content; + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldModel.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldModel.cs index bdc19145c6..181a743582 100644 --- a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldModel.cs +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldModel.cs @@ -1,194 +1,83 @@ -using System; +using Rubberduck.Refactorings.EncapsulateFieldUseBackingField; +using Rubberduck.Refactorings.EncapsulateFieldUseBackingUDTMember; +using System; using System.Collections.Generic; using System.Linq; -using Rubberduck.Parsing.Symbols; -using Rubberduck.Parsing.VBA; -using Rubberduck.VBEditor; namespace Rubberduck.Refactorings.EncapsulateField { + /// + /// The EncapsulateFieldModel provides a facade to the EncapsulateFieldRefactoring + /// by aggregating and simplifying access to the EncapsulateFieldUseBackingFieldModel + /// and the EncapsulateFieldUseBackingUDTMemberModel. + /// public class EncapsulateFieldModel : IRefactoringModel { - private readonly Func _previewDelegate; - private QualifiedModuleName _targetQMN; - private IDeclarationFinderProvider _declarationFinderProvider; - private IEncapsulateFieldValidationsProvider _validationsProvider; - private IObjectStateUDT _newObjectStateUDT; - - private List _convertedFields; - private HashSet _objStateCandidates; - - private IDictionary)> _udtFieldToUdtDeclarationMap = new Dictionary)>(); - - public EncapsulateFieldModel( - Declaration target, - IEnumerable candidates, - IEnumerable objectStateUDTCandidates, - IObjectStateUDT stateUDTField, - Func previewDelegate, - IDeclarationFinderProvider declarationFinderProvider, - IEncapsulateFieldValidationsProvider validationsProvider) + public EncapsulateFieldModel(EncapsulateFieldUseBackingFieldModel backingFieldModel, + EncapsulateFieldUseBackingUDTMemberModel udtModel, + IEncapsulateFieldConflictFinder conflictFinder) { - _previewDelegate = previewDelegate; - _targetQMN = target.QualifiedModuleName; - _newObjectStateUDT = stateUDTField; - _declarationFinderProvider = declarationFinderProvider; - _validationsProvider = validationsProvider; - - _useBackingFieldCandidates = candidates.ToList(); - _objStateCandidates = new HashSet(objectStateUDTCandidates); - _objStateCandidates.Add(_newObjectStateUDT); - - EncapsulateFieldStrategy = EncapsulateFieldStrategy.UseBackingFields; - _activeObjectStateUDT = ObjectStateUDTField; + EncapsulateFieldUseBackingFieldModel = backingFieldModel; + EncapsulateFieldUseBackingUDTMemberModel = udtModel; + ObjectStateUDTCandidates = udtModel.ObjectStateUDTCandidates; + ConflictFinder = conflictFinder; + EncapsulateFieldUseBackingFieldModel.ConflictFinder = conflictFinder; + EncapsulateFieldUseBackingUDTMemberModel.ConflictFinder = conflictFinder; } - public QualifiedModuleName QualifiedModuleName => _targetQMN; + public EncapsulateFieldUseBackingUDTMemberModel EncapsulateFieldUseBackingUDTMemberModel { get; } - public string PreviewRefactoring() => _previewDelegate(this); + public EncapsulateFieldUseBackingFieldModel EncapsulateFieldUseBackingFieldModel { get; } - public IEnumerable ObjectStateUDTCandidates => _objStateCandidates; + public string PreviewRefactoring() => PreviewProvider?.Preview(this) ?? string.Empty; - private EncapsulateFieldStrategy _encapsulationFieldStategy; - public EncapsulateFieldStrategy EncapsulateFieldStrategy - { - get => _encapsulationFieldStategy; - set - { - if (_encapsulationFieldStategy == value) { return; } - - _encapsulationFieldStategy = value; + public IRefactoringPreviewProvider PreviewProvider { set; get; } - if (_encapsulationFieldStategy == EncapsulateFieldStrategy.UseBackingFields) - { - UpdateFieldCandidatesForUseBackingFieldsStrategy(); - return; - } - UpdateFieldCandidatesForConvertFieldsToUDTMembersStrategy(); - } - } - - public IEncapsulateFieldValidationsProvider ValidationsProvider => _validationsProvider; - - private List _useBackingFieldCandidates; - public List EncapsulationCandidates - { - get - { - if (EncapsulateFieldStrategy == EncapsulateFieldStrategy.UseBackingFields) - { - return _useBackingFieldCandidates; - } - - if (_convertedFields is null) - { - _convertedFields = new List(); - foreach (var field in _useBackingFieldCandidates) - { - _convertedFields.Add(new ConvertToUDTMember(field, ObjectStateUDTField)); - } - } - return _convertedFields; - } - } - - public IEnumerable SelectedFieldCandidates - => EncapsulationCandidates.Where(v => v.EncapsulateFlag); + public Action StrategyChangedAction { set; get; } = (m) => { }; - public IEnumerable UDTFieldCandidates - => EncapsulationCandidates - .Where(v => v is IUserDefinedTypeCandidate) - .Cast(); + public Action ObjectStateFieldChangedAction { set; get; } = (m) => { }; - public IEnumerable SelectedUDTFieldCandidates - => SelectedFieldCandidates - .Where(v => v is IUserDefinedTypeCandidate) - .Cast(); + public IReadOnlyCollection ObjectStateUDTCandidates { private set; get; } - public IEncapsulateFieldCandidate this[string encapsulatedFieldTargetID] - => EncapsulationCandidates.Where(c => c.TargetID.Equals(encapsulatedFieldTargetID)).Single(); + public IEncapsulateFieldConflictFinder ConflictFinder { set; get; } - public IEncapsulateFieldCandidate this[Declaration fieldDeclaration] - => EncapsulationCandidates.Where(c => c.Declaration == fieldDeclaration).Single(); - - private IObjectStateUDT _activeObjectStateUDT; public IObjectStateUDT ObjectStateUDTField { - get - { - _activeObjectStateUDT = ObjectStateUDTCandidates - .SingleOrDefault(os => os.IsSelected) ?? _newObjectStateUDT; - - return _activeObjectStateUDT; - } set { - if (_activeObjectStateUDT.FieldIdentifier == (value?.FieldIdentifier ?? string.Empty)) + if (EncapsulateFieldUseBackingUDTMemberModel.ObjectStateUDTField != value) { - return; - } - - foreach (var objectStateUDT in ObjectStateUDTCandidates) - { - objectStateUDT.IsSelected = false; - } - - _activeObjectStateUDT = - ObjectStateUDTCandidates.SingleOrDefault(os => os.FieldIdentifier.Equals(value?.FieldIdentifier ?? null)) - ?? _newObjectStateUDT; - - _activeObjectStateUDT.IsSelected = true; - - if (EncapsulateFieldStrategy == EncapsulateFieldStrategy.ConvertFieldsToUDTMembers) - { - foreach (var field in EncapsulationCandidates) - { - if (field is IConvertToUDTMember convertedField) - { - convertedField.ObjectStateUDT = _activeObjectStateUDT; - convertedField.ConflictFinder = _validationsProvider.ConflictDetector(EncapsulateFieldStrategy, _declarationFinderProvider); - convertedField.ConflictFinder.AssignNoConflictIdentifiers(convertedField); - } - } + EncapsulateFieldUseBackingUDTMemberModel.ObjectStateUDTField = value; + ObjectStateFieldChangedAction(this); } } + get => EncapsulateFieldStrategy == EncapsulateFieldStrategy.ConvertFieldsToUDTMembers + ? EncapsulateFieldUseBackingUDTMemberModel.ObjectStateUDTField + : null; } - private void UpdateFieldCandidatesForUseBackingFieldsStrategy() + private EncapsulateFieldStrategy _strategy; + public EncapsulateFieldStrategy EncapsulateFieldStrategy { - foreach (var candidate in EncapsulationCandidates) + set { - switch (candidate) + if (_strategy != value) { - case IUserDefinedTypeCandidate udt: - candidate.NameValidator = EncapsulateFieldValidationsProvider.NameOnlyValidator(NameValidators.UserDefinedType); - break; - case IUserDefinedTypeMemberCandidate udtm: - candidate.NameValidator = candidate.Declaration.IsArray - ? EncapsulateFieldValidationsProvider.NameOnlyValidator(NameValidators.UserDefinedTypeMemberArray) - : EncapsulateFieldValidationsProvider.NameOnlyValidator(NameValidators.UserDefinedTypeMember); - break; - default: - candidate.NameValidator = EncapsulateFieldValidationsProvider.NameOnlyValidator(NameValidators.Default); - break; + _strategy = value; + StrategyChangedAction(this); } - candidate.ConflictFinder = _validationsProvider.ConflictDetector(EncapsulateFieldStrategy, _declarationFinderProvider); - candidate.ConflictFinder.AssignNoConflictIdentifiers(candidate); } + get => _strategy; } - private void UpdateFieldCandidatesForConvertFieldsToUDTMembersStrategy() - { - foreach (var candidate in EncapsulationCandidates.Cast()) - { - candidate.ObjectStateUDT = ObjectStateUDTField; - candidate.NameValidator = candidate.Declaration.IsArray - ? EncapsulateFieldValidationsProvider.NameOnlyValidator(NameValidators.UserDefinedTypeMemberArray) - : EncapsulateFieldValidationsProvider.NameOnlyValidator(NameValidators.UserDefinedTypeMember); + public IReadOnlyCollection EncapsulationCandidates => EncapsulateFieldStrategy == EncapsulateFieldStrategy.UseBackingFields + ? EncapsulateFieldUseBackingFieldModel.EncapsulationCandidates + : EncapsulateFieldUseBackingUDTMemberModel.EncapsulationCandidates; - candidate.ConflictFinder = _validationsProvider.ConflictDetector(EncapsulateFieldStrategy, _declarationFinderProvider); - candidate.ConflictFinder.AssignNoConflictIdentifiers(candidate); - } - } + public IEnumerable SelectedFieldCandidates + => EncapsulationCandidates.Where(v => v.EncapsulateFlag); + + public IEncapsulateFieldCandidate this[string encapsulatedFieldTargetID] + => EncapsulationCandidates.Where(c => c.TargetID.Equals(encapsulatedFieldTargetID)).Single(); } } diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldModelFactory.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldModelFactory.cs new file mode 100644 index 0000000000..5e7a97d221 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldModelFactory.cs @@ -0,0 +1,74 @@ +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings.EncapsulateField; +using System; +using System.Collections.Generic; + +namespace Rubberduck.Refactorings +{ + public interface IEncapsulateFieldModelFactory + { + /// + /// Creates the supporting EncapsulateFieldRefactoringAction models for the EncapsulateFieldRefactoring. + /// + EncapsulateFieldModel Create(Declaration target); + } + + public class EncapsulateFieldModelFactory : IEncapsulateFieldModelFactory + { + private readonly IDeclarationFinderProvider _declarationFinderProvider; + private readonly IEncapsulateFieldCandidateFactory _candidatesFactory; + private readonly IEncapsulateFieldUseBackingUDTMemberModelFactory _useBackingUDTMemberModelFactory; + private readonly IEncapsulateFieldUseBackingFieldModelFactory _useBackingFieldModelFactory; + private readonly IEncapsulateFieldCandidateSetsProviderFactory _candidateSetsFactory; + private readonly IEncapsulateFieldConflictFinderFactory _encapsulateFieldConflictFinderFactory; + + public EncapsulateFieldModelFactory(IDeclarationFinderProvider declarationFinderProvider, + IEncapsulateFieldCandidateFactory candidatesFactory, + IEncapsulateFieldUseBackingUDTMemberModelFactory encapsulateFieldUseBackingUDTMemberModelFactory, + IEncapsulateFieldUseBackingFieldModelFactory encapsulateFieldUseBackingFieldModelFactory, + IEncapsulateFieldCandidateSetsProviderFactory candidateSetsProviderFactory, + IEncapsulateFieldConflictFinderFactory encapsulateFieldConflictFinderFactory) + { + _declarationFinderProvider = declarationFinderProvider; + _candidatesFactory = candidatesFactory; + _useBackingUDTMemberModelFactory = encapsulateFieldUseBackingUDTMemberModelFactory as IEncapsulateFieldUseBackingUDTMemberModelFactory; + _useBackingFieldModelFactory = encapsulateFieldUseBackingFieldModelFactory; + _candidateSetsFactory = candidateSetsProviderFactory; + _encapsulateFieldConflictFinderFactory = encapsulateFieldConflictFinderFactory; + } + + public EncapsulateFieldModel Create(Declaration target) + { + if (!(target is VariableDeclaration targetField)) + { + throw new ArgumentException(); + } + + var fieldEncapsulationModels = new List() + { + new FieldEncapsulationModel(targetField) + }; + + var contextCollections = _candidateSetsFactory.Create(_declarationFinderProvider, _candidatesFactory, target.QualifiedModuleName); + + var useBackingFieldModel = _useBackingFieldModelFactory.Create(contextCollections, fieldEncapsulationModels); + var useBackingUDTMemberModel = _useBackingUDTMemberModelFactory.Create(contextCollections, fieldEncapsulationModels); + + var initialStrategy = useBackingUDTMemberModel.ObjectStateUDTField.IsExistingDeclaration + ? EncapsulateFieldStrategy.ConvertFieldsToUDTMembers + : EncapsulateFieldStrategy.UseBackingFields; + + var conflictFinder = _encapsulateFieldConflictFinderFactory.Create(_declarationFinderProvider, + contextCollections.EncapsulateFieldUseBackingFieldCandidates, + contextCollections.ObjectStateFieldCandidates); + + var model = new EncapsulateFieldModel(useBackingFieldModel, useBackingUDTMemberModel, conflictFinder) + { + EncapsulateFieldStrategy = initialStrategy, + }; + + return model; + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldPreviewProvider.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldPreviewProvider.cs new file mode 100644 index 0000000000..8c6765cfe2 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldPreviewProvider.cs @@ -0,0 +1,28 @@ +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings.EncapsulateFieldUseBackingField; +using Rubberduck.Refactorings.EncapsulateFieldUseBackingUDTMember; + +namespace Rubberduck.Refactorings.EncapsulateField +{ + public class EncapsulateFieldPreviewProvider : IRefactoringPreviewProvider + { + private readonly EncapsulateFieldUseBackingFieldPreviewProvider _useBackingFieldPreviewer; + private readonly EncapsulateFieldUseBackingUDTMemberPreviewProvider _useBackingUDTMemberPreviewer; + public EncapsulateFieldPreviewProvider( + EncapsulateFieldUseBackingFieldPreviewProvider useBackingFieldPreviewProvider, + EncapsulateFieldUseBackingUDTMemberPreviewProvider useBackingUDTMemberPreviewProvide) + { + _useBackingFieldPreviewer = useBackingFieldPreviewProvider; + _useBackingUDTMemberPreviewer = useBackingUDTMemberPreviewProvide; + } + + public string Preview(EncapsulateFieldModel model) + { + var preview = model.EncapsulateFieldStrategy == EncapsulateFieldStrategy.ConvertFieldsToUDTMembers + ? _useBackingUDTMemberPreviewer.Preview(model.EncapsulateFieldUseBackingUDTMemberModel) + : _useBackingFieldPreviewer.Preview(model.EncapsulateFieldUseBackingFieldModel); + + return preview; + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldRefactoring.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldRefactoring.cs index 6e99ee7304..20e3c2143e 100644 --- a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldRefactoring.cs +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldRefactoring.cs @@ -1,10 +1,8 @@ using System.Linq; -using Rubberduck.Parsing.Rewriter; using Rubberduck.Parsing.Symbols; using Rubberduck.Parsing.VBA; using Rubberduck.Refactorings.Exceptions; using Rubberduck.VBEditor; -using Rubberduck.SmartIndenter; using Rubberduck.VBEditor.Utility; namespace Rubberduck.Refactorings.EncapsulateField @@ -17,40 +15,35 @@ public enum EncapsulateFieldStrategy public class EncapsulateFieldRefactoring : InteractiveRefactoringBase { - private readonly IDeclarationFinderProvider _declarationFinderProvider; private readonly ISelectedDeclarationProvider _selectedDeclarationProvider; - private readonly IIndenter _indenter; - private readonly ICodeBuilder _codeBuilder; - private readonly IRewritingManager _rewritingManager; + private readonly EncapsulateFieldRefactoringAction _refactoringAction; + private readonly EncapsulateFieldPreviewProvider _previewProvider; + private readonly IEncapsulateFieldModelFactory _modelFactory; public EncapsulateFieldRefactoring( - IDeclarationFinderProvider declarationFinderProvider, - IIndenter indenter, - RefactoringUserInteraction userInteraction, - IRewritingManager rewritingManager, - ISelectionProvider selectionProvider, - ISelectedDeclarationProvider selectedDeclarationProvider, - ICodeBuilder codeBuilder) - :base(selectionProvider, userInteraction) + EncapsulateFieldRefactoringAction refactoringAction, + EncapsulateFieldPreviewProvider previewProvider, + IEncapsulateFieldModelFactory encapsulateFieldModelFactory, + RefactoringUserInteraction userInteraction, + ISelectionProvider selectionProvider, + ISelectedDeclarationProvider selectedDeclarationProvider) + :base(selectionProvider, userInteraction) { - _declarationFinderProvider = declarationFinderProvider; + _refactoringAction = refactoringAction; + _previewProvider = previewProvider; _selectedDeclarationProvider = selectedDeclarationProvider; - _indenter = indenter; - _codeBuilder = codeBuilder; - _rewritingManager = rewritingManager; + _modelFactory = encapsulateFieldModelFactory; } protected override Declaration FindTargetDeclaration(QualifiedSelection targetSelection) { var selectedDeclaration = _selectedDeclarationProvider.SelectedDeclaration(targetSelection); - if (selectedDeclaration == null + + var isInvalidSelection = selectedDeclaration == null || selectedDeclaration.DeclarationType != DeclarationType.Variable - || selectedDeclaration.ParentScopeDeclaration.DeclarationType.HasFlag(DeclarationType.Member)) - { - return null; - } + || selectedDeclaration.ParentScopeDeclaration.DeclarationType.HasFlag(DeclarationType.Member); - return selectedDeclaration; + return isInvalidSelection ? null : selectedDeclaration; } protected override EncapsulateFieldModel InitializeModel(Declaration target) @@ -65,58 +58,49 @@ protected override EncapsulateFieldModel InitializeModel(Declaration target) throw new InvalidDeclarationTypeException(target); } - var builder = new EncapsulateFieldElementsBuilder(_declarationFinderProvider, target.QualifiedModuleName); + var model = _modelFactory.Create(target); - var selected = builder.Candidates.Single(c => c.Declaration == target); - selected.EncapsulateFlag = true; + model.PreviewProvider = _previewProvider; - var model = new EncapsulateFieldModel( - target, - builder.Candidates, - builder.ObjectStateUDTCandidates, - builder.DefaultObjectStateUDT, - PreviewRewrite, - _declarationFinderProvider, - builder.ValidationsProvider); + model.StrategyChangedAction = OnStrategyChanged; - if (builder.ObjectStateUDT != null) - { - model.EncapsulateFieldStrategy = EncapsulateFieldStrategy.ConvertFieldsToUDTMembers; - model.ObjectStateUDTField = builder.ObjectStateUDT; - } + model.ObjectStateFieldChangedAction = OnObjectStateUDTChanged; + + model.ConflictFinder.AssignNoConflictIdentifiers(model.EncapsulationCandidates); return model; } protected override void RefactorImpl(EncapsulateFieldModel model) { - var executableRewriteSession = _rewritingManager.CheckOutCodePaneSession(); - - RefactorRewrite(model, executableRewriteSession); - - if (!executableRewriteSession.TryRewrite()) + if (!model.SelectedFieldCandidates.Any()) { - throw new RewriteFailedException(executableRewriteSession); + return; } + + _refactoringAction.Refactor(model); } - private string PreviewRewrite(EncapsulateFieldModel model) + private void OnStrategyChanged(EncapsulateFieldModel model) { - var previewSession = RefactorRewrite(model, _rewritingManager.CheckOutCodePaneSession(), true); + if (model.EncapsulateFieldStrategy == EncapsulateFieldStrategy.UseBackingFields) + { + foreach (var objectStateCandidate in model.EncapsulateFieldUseBackingUDTMemberModel.ObjectStateUDTCandidates) + { + objectStateCandidate.IsSelected = !objectStateCandidate.IsExistingDeclaration; + } + } - return previewSession.CheckOutModuleRewriter(model.QualifiedModuleName) - .GetText(); + var candidates = model.EncapsulateFieldStrategy == EncapsulateFieldStrategy.UseBackingFields + ? model.EncapsulateFieldUseBackingFieldModel.EncapsulationCandidates + : model.EncapsulateFieldUseBackingUDTMemberModel.EncapsulationCandidates; + + model.ConflictFinder.AssignNoConflictIdentifiers(candidates); } - private IRewriteSession RefactorRewrite(EncapsulateFieldModel model, IRewriteSession refactorRewriteSession, bool asPreview = false) + private void OnObjectStateUDTChanged(EncapsulateFieldModel model) { - if (!model.SelectedFieldCandidates.Any()) { return refactorRewriteSession; } - - var strategy = model.EncapsulateFieldStrategy == EncapsulateFieldStrategy.ConvertFieldsToUDTMembers - ? new ConvertFieldsToUDTMembers(_declarationFinderProvider, model, _indenter, _codeBuilder) as IEncapsulateStrategy - : new UseBackingFields(_declarationFinderProvider, model, _indenter, _codeBuilder) as IEncapsulateStrategy; - - return strategy.RefactorRewrite(refactorRewriteSession, asPreview); + model.ConflictFinder.AssignNoConflictIdentifiers(model.EncapsulateFieldUseBackingUDTMemberModel.EncapsulationCandidates); } } } diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldRefactoringAction.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldRefactoringAction.cs new file mode 100644 index 0000000000..b33b298064 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldRefactoringAction.cs @@ -0,0 +1,36 @@ +using Rubberduck.Refactorings.EncapsulateFieldUseBackingField; +using Rubberduck.Refactorings.EncapsulateFieldUseBackingUDTMember; +using System.Linq; + +namespace Rubberduck.Refactorings.EncapsulateField +{ + public class EncapsulateFieldRefactoringAction : IRefactoringAction + { + private readonly EncapsulateFieldUseBackingFieldRefactoringAction _useBackingField; + private readonly EncapsulateFieldUseBackingUDTMemberRefactoringAction _useBackingUDTMember; + + public EncapsulateFieldRefactoringAction( + EncapsulateFieldUseBackingFieldRefactoringAction encapsulateFieldUseBackingField, + EncapsulateFieldUseBackingUDTMemberRefactoringAction encapsulateFieldUseUDTMember) + { + _useBackingField = encapsulateFieldUseBackingField; + _useBackingUDTMember = encapsulateFieldUseUDTMember; + } + + public void Refactor(EncapsulateFieldModel model) + { + if (!model?.EncapsulationCandidates.Any() ?? true) + { + return; + } + + if (model.EncapsulateFieldStrategy == EncapsulateFieldStrategy.ConvertFieldsToUDTMembers) + { + _useBackingUDTMember.Refactor(model.EncapsulateFieldUseBackingUDTMemberModel); + return; + } + + _useBackingField.Refactor(model.EncapsulateFieldUseBackingFieldModel); + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldRefactoringActionsProvider.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldRefactoringActionsProvider.cs new file mode 100644 index 0000000000..4e73441eeb --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldRefactoringActionsProvider.cs @@ -0,0 +1,59 @@ +using Rubberduck.Refactorings.ReplaceDeclarationIdentifier; +using Rubberduck.Refactorings.ReplaceReferences; +using Rubberduck.Refactorings.ReplacePrivateUDTMemberReferences; +using Rubberduck.Refactorings.EncapsulateFieldInsertNewCode; +using Rubberduck.Refactorings.ModifyUserDefinedType; + +namespace Rubberduck.Refactorings.EncapsulateField +{ + public interface IEncapsulateFieldRefactoringActionsProvider + { + ICodeOnlyRefactoringAction ReplaceReferences { get; } + ICodeOnlyRefactoringAction ReplaceUDTMemberReferences { get; } + ICodeOnlyRefactoringAction ReplaceDeclarationIdentifiers { get; } + ICodeOnlyRefactoringAction ModifyUserDefinedType { get; } + ICodeOnlyRefactoringAction EncapsulateFieldInsertNewCode { get; } + } + + /// + /// EncapsulateFieldRefactoringActionsProvider reduces the number of EncapsulateField refactoring action + /// constructor parameters. It provides Refactoring Actions common to the EncapsulateFieldRefactoringActions + /// + public class EncapsulateFieldRefactoringActionsProvider : IEncapsulateFieldRefactoringActionsProvider + { + private readonly ReplaceReferencesRefactoringAction _replaceReferences; + private readonly ReplaceDeclarationIdentifierRefactoringAction _replaceDeclarationIdentifiers; + private readonly ReplacePrivateUDTMemberReferencesRefactoringAction _replaceUDTMemberReferencesRefactoringAction; + private readonly ModifyUserDefinedTypeRefactoringAction _modifyUDTRefactoringAction; + private readonly EncapsulateFieldInsertNewCodeRefactoringAction _encapsulateFieldInsertNewCodeRefactoringAction; + + public EncapsulateFieldRefactoringActionsProvider( + ReplaceReferencesRefactoringAction replaceReferencesRefactoringAction, + ReplacePrivateUDTMemberReferencesRefactoringAction replaceUDTMemberReferencesRefactoringAction, + ReplaceDeclarationIdentifierRefactoringAction replaceDeclarationIdentifierRefactoringAction, + ModifyUserDefinedTypeRefactoringAction modifyUserDefinedTypeRefactoringAction, + EncapsulateFieldInsertNewCodeRefactoringAction encapsulateFieldInsertNewCodeRefactoringAction) + { + _replaceReferences = replaceReferencesRefactoringAction; + _replaceUDTMemberReferencesRefactoringAction = replaceUDTMemberReferencesRefactoringAction; + _replaceDeclarationIdentifiers = replaceDeclarationIdentifierRefactoringAction; + _modifyUDTRefactoringAction = modifyUserDefinedTypeRefactoringAction; + _encapsulateFieldInsertNewCodeRefactoringAction = encapsulateFieldInsertNewCodeRefactoringAction; + } + + public ICodeOnlyRefactoringAction ReplaceReferences + => _replaceReferences; + + public ICodeOnlyRefactoringAction ReplaceDeclarationIdentifiers + => _replaceDeclarationIdentifiers; + + public ICodeOnlyRefactoringAction ReplaceUDTMemberReferences + => _replaceUDTMemberReferencesRefactoringAction; + + public ICodeOnlyRefactoringAction ModifyUserDefinedType + => _modifyUDTRefactoringAction; + + public ICodeOnlyRefactoringAction EncapsulateFieldInsertNewCode + => _encapsulateFieldInsertNewCodeRefactoringAction; + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldModel.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldModel.cs new file mode 100644 index 0000000000..647ff2e2a2 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldModel.cs @@ -0,0 +1,30 @@ +using System.Collections.Generic; +using System.Linq; +using Rubberduck.VBEditor; +using Rubberduck.Refactorings.EncapsulateField; + +namespace Rubberduck.Refactorings.EncapsulateFieldUseBackingField +{ + public class EncapsulateFieldUseBackingFieldModel : IRefactoringModel + { + public EncapsulateFieldUseBackingFieldModel(IEnumerable candidates) + { + EncapsulationCandidates = candidates.ToList(); + if (EncapsulationCandidates.Any()) + { + QualifiedModuleName = EncapsulationCandidates.First().QualifiedModuleName; + } + } + + public INewContentAggregator NewContentAggregator { set; get; } + + public IEncapsulateFieldConflictFinder ConflictFinder { set; get; } + + public IReadOnlyCollection EncapsulationCandidates { get; } + + public IReadOnlyCollection SelectedFieldCandidates + => EncapsulationCandidates.Where(c => c.EncapsulateFlag).ToList(); + + public QualifiedModuleName QualifiedModuleName { get; } = new QualifiedModuleName(); + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldModelFactory.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldModelFactory.cs new file mode 100644 index 0000000000..9c7a81bbc3 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldModelFactory.cs @@ -0,0 +1,81 @@ +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings.EncapsulateField; +using Rubberduck.Refactorings.EncapsulateFieldUseBackingField; +using System.Collections.Generic; +using System.Linq; + +namespace Rubberduck.Refactorings +{ + public interface IEncapsulateFieldUseBackingFieldModelFactory + { + /// + /// Creates an EncapsulateFieldUseBackingFieldModel used by the EncapsulateFieldUseBackingFieldRefactoringAction. + /// + EncapsulateFieldUseBackingFieldModel Create(IEnumerable fieldModels); + + /// + /// Creates an EncapsulateFieldUseBackingFieldModel based upon collection of + /// IEncapsulateFieldCandidate instances. + /// This function is intended for exclusive use by the EncapsulateFieldModelFactory + /// + EncapsulateFieldUseBackingFieldModel Create(IEncapsulateFieldCandidateSetsProvider contextCollections, IEnumerable fieldModels); + } + + public class EncapsulateFieldUseBackingFieldModelFactory : IEncapsulateFieldUseBackingFieldModelFactory + { + private readonly IDeclarationFinderProvider _declarationFinderProvider; + private readonly IEncapsulateFieldCandidateFactory _candidatesFactory; + private readonly IEncapsulateFieldCandidateSetsProviderFactory _candidateSetsFactory; + private readonly IEncapsulateFieldConflictFinderFactory _conflictFinderFactory; + + public EncapsulateFieldUseBackingFieldModelFactory(IDeclarationFinderProvider declarationFinderProvider, + IEncapsulateFieldCandidateFactory candidatesFactory, + IEncapsulateFieldCandidateSetsProviderFactory candidateSetsFactory, + IEncapsulateFieldConflictFinderFactory encapsulateFieldConflictFinderFactory) + { + _declarationFinderProvider = declarationFinderProvider; + _candidatesFactory = candidatesFactory; + _candidateSetsFactory = candidateSetsFactory; + _conflictFinderFactory = encapsulateFieldConflictFinderFactory; + } + + public EncapsulateFieldUseBackingFieldModel Create(IEnumerable fieldModels) + { + if (!fieldModels.Any()) + { + return new EncapsulateFieldUseBackingFieldModel(Enumerable.Empty()); + } + + var contextCollections = _candidateSetsFactory.Create(_declarationFinderProvider, _candidatesFactory, fieldModels.First().Declaration.QualifiedModuleName); + + return Create(contextCollections, fieldModels); + } + + public EncapsulateFieldUseBackingFieldModel Create(IEncapsulateFieldCandidateSetsProvider contextCollections, IEnumerable fieldModels) + { + var fieldCandidates = contextCollections.EncapsulateFieldUseBackingFieldCandidates.ToList(); + + foreach (var fieldModel in fieldModels) + { + var candidate = fieldCandidates.Single(c => c.Declaration.Equals(fieldModel.Declaration)); + candidate.EncapsulateFlag = true; + candidate.IsReadOnly = fieldModel.IsReadOnly; + if (fieldModel.PropertyIdentifier != null) + { + candidate.PropertyIdentifier = fieldModel.PropertyIdentifier; + } + } + + var conflictsFinder = _conflictFinderFactory.Create(_declarationFinderProvider, + contextCollections.EncapsulateFieldUseBackingFieldCandidates, + contextCollections.ObjectStateFieldCandidates); + + fieldCandidates.ForEach(c => c.ConflictFinder = conflictsFinder); + + return new EncapsulateFieldUseBackingFieldModel(fieldCandidates) + { + ConflictFinder = conflictsFinder + }; + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldPreviewProvider.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldPreviewProvider.cs new file mode 100644 index 0000000000..26ee695e82 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldPreviewProvider.cs @@ -0,0 +1,32 @@ +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Refactorings.EncapsulateField; +using Rubberduck.Resources; +using Rubberduck.VBEditor; + +namespace Rubberduck.Refactorings.EncapsulateFieldUseBackingField +{ + public class EncapsulateFieldUseBackingFieldPreviewProvider : RefactoringPreviewProviderWrapperBase + { + private readonly INewContentAggregatorFactory _aggregatorFactory; + + public EncapsulateFieldUseBackingFieldPreviewProvider(EncapsulateFieldUseBackingFieldRefactoringAction refactoringAction, + IRewritingManager rewritingManager, + INewContentAggregatorFactory aggregatorFactory) + : base(refactoringAction, rewritingManager) + { + _aggregatorFactory = aggregatorFactory; + } + + public override string Preview(EncapsulateFieldUseBackingFieldModel model) + { + model.NewContentAggregator = _aggregatorFactory.Create(); + model.NewContentAggregator.AddNewContent(RubberduckUI.EncapsulateField_PreviewMarker, RubberduckUI.EncapsulateField_PreviewMarker); + return base.Preview(model); + } + + protected override QualifiedModuleName ComponentToShow(EncapsulateFieldUseBackingFieldModel model) + { + return model.QualifiedModuleName; + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldRefactoringAction.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldRefactoringAction.cs new file mode 100644 index 0000000000..b41fff423a --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldRefactoringAction.cs @@ -0,0 +1,208 @@ +using Rubberduck.Parsing; +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Refactorings.Common; +using Rubberduck.Refactorings.ReplaceDeclarationIdentifier; +using Rubberduck.Refactorings.ReplaceReferences; +using Rubberduck.Refactorings.ReplacePrivateUDTMemberReferences; +using System; +using System.Collections.Generic; +using System.Linq; +using Rubberduck.Refactorings.EncapsulateField; +using Rubberduck.Refactorings.EncapsulateFieldInsertNewCode; + +namespace Rubberduck.Refactorings.EncapsulateFieldUseBackingField +{ + public class EncapsulateFieldUseBackingFieldRefactoringAction : CodeOnlyRefactoringActionBase + { + private readonly ICodeOnlyRefactoringAction _replaceUDTMemberReferencesRefactoringAction; + private readonly ICodeOnlyRefactoringAction _replaceReferencesRefactoringAction; + private readonly ICodeOnlyRefactoringAction _replaceDeclarationIdentifiers; + private readonly ICodeOnlyRefactoringAction _encapsulateFieldInsertNewCodeRefactoringAction; + private readonly IReplacePrivateUDTMemberReferencesModelFactory _replaceUDTMemberReferencesModelFactory; + private readonly INewContentAggregatorFactory _newContentAggregatorFactory; + + public EncapsulateFieldUseBackingFieldRefactoringAction( + IEncapsulateFieldRefactoringActionsProvider refactoringActionsProvider, + IReplacePrivateUDTMemberReferencesModelFactory replaceUDTMemberReferencesModelFactory, + IRewritingManager rewritingManager, + INewContentAggregatorFactory newContentAggregatorFactory) + :base(rewritingManager) + { + _replaceUDTMemberReferencesRefactoringAction = refactoringActionsProvider.ReplaceUDTMemberReferences; + _replaceReferencesRefactoringAction = refactoringActionsProvider.ReplaceReferences; + _replaceDeclarationIdentifiers = refactoringActionsProvider.ReplaceDeclarationIdentifiers; + _encapsulateFieldInsertNewCodeRefactoringAction = refactoringActionsProvider.EncapsulateFieldInsertNewCode; + _replaceUDTMemberReferencesModelFactory = replaceUDTMemberReferencesModelFactory; + _newContentAggregatorFactory = newContentAggregatorFactory; + } + + public override void Refactor(EncapsulateFieldUseBackingFieldModel model, IRewriteSession rewriteSession) + { + if (!model.SelectedFieldCandidates.Any()) + { + return; + } + + var publicFieldsDeclaredInListsToReDeclareAsPrivateBackingFields + = model.SelectedFieldCandidates + .Where(f => f.Declaration.IsDeclaredInList() + && !f.Declaration.HasPrivateAccessibility()) + .ToList(); + + ModifyFields(model, publicFieldsDeclaredInListsToReDeclareAsPrivateBackingFields, rewriteSession); + + ModifyReferences(model, rewriteSession); + + InsertNewContent(model, publicFieldsDeclaredInListsToReDeclareAsPrivateBackingFields, rewriteSession); + } + + private void ModifyFields(EncapsulateFieldUseBackingFieldModel model, List publicFieldsToRemove, IRewriteSession rewriteSession) + { + var rewriter = rewriteSession.CheckOutModuleRewriter(model.QualifiedModuleName); + rewriter.RemoveVariables(publicFieldsToRemove.Select(f => f.Declaration) + .Cast()); + + var retainedFieldDeclarations = model.SelectedFieldCandidates + .Except(publicFieldsToRemove) + .ToList(); + + if (retainedFieldDeclarations.Any()) + { + MakeImplicitDeclarationTypeExplicit(retainedFieldDeclarations, rewriter); + + SetPrivateVariableVisiblity(retainedFieldDeclarations, rewriter); + + Rename(retainedFieldDeclarations, rewriteSession); + } + } + + private void ModifyReferences(EncapsulateFieldUseBackingFieldModel model, IRewriteSession rewriteSession) + { + var privateUdtInstances = model.SelectedFieldCandidates + .Where(f => (f.Declaration.AsTypeDeclaration?.DeclarationType.HasFlag(DeclarationType.UserDefinedType) ?? false) + && f.Declaration.AsTypeDeclaration.Accessibility == Accessibility.Private); + + ReplaceUDTMemberReferencesOfPrivateUDTFields(privateUdtInstances, rewriteSession); + + ReplaceEncapsulatedFieldReferences(model.SelectedFieldCandidates.Except(privateUdtInstances), rewriteSession); + } + + private void InsertNewContent(EncapsulateFieldUseBackingFieldModel model, List candidatesRequiringNewBackingFields, IRewriteSession rewriteSession) + { + var aggregator = model.NewContentAggregator ?? _newContentAggregatorFactory.Create(); + model.NewContentAggregator = null; + + var encapsulateFieldInsertNewCodeModel = new EncapsulateFieldInsertNewCodeModel(model.SelectedFieldCandidates) + { + CandidatesRequiringNewBackingFields = candidatesRequiringNewBackingFields, + NewContentAggregator = aggregator + }; + + _encapsulateFieldInsertNewCodeRefactoringAction.Refactor(encapsulateFieldInsertNewCodeModel, rewriteSession); + } + + private void ReplaceEncapsulatedFieldReferences(IEnumerable fieldCandidates, IRewriteSession rewriteSession) + { + var model = new ReplaceReferencesModel() + { + ModuleQualifyExternalReferences = true + }; + + foreach (var field in fieldCandidates) + { + InitializeModel(model, field); + } + + _replaceReferencesRefactoringAction.Refactor(model, rewriteSession); + } + + private void ReplaceUDTMemberReferencesOfPrivateUDTFields(IEnumerable udtFieldCandidates, IRewriteSession rewriteSession) + { + if (!udtFieldCandidates.Any()) + { + return; + } + + var replacePrivateUDTMemberReferencesModel + = _replaceUDTMemberReferencesModelFactory.Create(udtFieldCandidates.Select(f => f.Declaration).Cast()); + + foreach (var udtfield in udtFieldCandidates) + { + InitializeModel(replacePrivateUDTMemberReferencesModel, udtfield); + } + _replaceUDTMemberReferencesRefactoringAction.Refactor(replacePrivateUDTMemberReferencesModel, rewriteSession); + } + + private void InitializeModel(ReplaceReferencesModel model, IEncapsulateFieldCandidate field) + { + foreach (var idRef in field.Declaration.References) + { + var replacementExpression = field.PropertyIdentifier; + + if (idRef.QualifiedModuleName == field.QualifiedModuleName && field.Declaration.IsArray) + { + replacementExpression = field.BackingIdentifier; + } + + model.AssignReferenceReplacementExpression(idRef, replacementExpression); + } + } + + private void InitializeModel(ReplacePrivateUDTMemberReferencesModel model, IEncapsulateFieldCandidate udtfield) + { + foreach (var udtMember in model.UDTMembers) + { + var udtExpressions = new PrivateUDTMemberReferenceReplacementExpressions($"{udtfield.IdentifierName}.{udtMember.IdentifierName}") + { + LocalReferenceExpression = udtMember.IdentifierName, + }; + + model.AssignUDTMemberReferenceExpressions(udtfield.Declaration as VariableDeclaration, udtMember, udtExpressions); + } + } + + private static void MakeImplicitDeclarationTypeExplicit(IReadOnlyCollection fields, IModuleRewriter rewriter) + { + var fieldsToChange = fields.Where(f => !f.Declaration.Context.TryGetChildContext(out _)) + .Select(f => f.Declaration); + + foreach (var field in fieldsToChange) + { + rewriter.InsertAfter(field.Context.Stop.TokenIndex, $" {Tokens.As} {field.AsTypeName}"); + } + } + + private static void SetPrivateVariableVisiblity(IReadOnlyCollection fields, IModuleRewriter rewriter) + { + var visibility = Accessibility.Private.TokenString(); + foreach (var element in fields.Where(f => !f.Declaration.HasPrivateAccessibility()).Select(f => f.Declaration)) + { + if (!element.IsVariable()) + { + throw new ArgumentException(); + } + + var variableStmtContext = element.Context.GetAncestor(); + var visibilityContext = variableStmtContext.GetChild(); + + if (visibilityContext != null) + { + rewriter.Replace(visibilityContext, visibility); + continue; + } + rewriter.InsertBefore(element.Context.Start.TokenIndex, $"{visibility} "); + } + } + + private void Rename(IReadOnlyCollection fields, IRewriteSession rewriteSession) + { + var fieldToNewNamePairs = fields.Where(f => !f.BackingIdentifier.Equals(f.Declaration.IdentifierName, StringComparison.InvariantCultureIgnoreCase)) + .Select(f => (f.Declaration, f.BackingIdentifier)); + + var model = new ReplaceDeclarationIdentifierModel(fieldToNewNamePairs); + _replaceDeclarationIdentifiers.Refactor(model, rewriteSession); + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberModel.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberModel.cs new file mode 100644 index 0000000000..7dae8bb453 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberModel.cs @@ -0,0 +1,60 @@ +using System.Collections.Generic; +using System.Linq; +using Rubberduck.VBEditor; +using Rubberduck.Refactorings.EncapsulateField; + +namespace Rubberduck.Refactorings.EncapsulateFieldUseBackingUDTMember +{ + public class EncapsulateFieldUseBackingUDTMemberModel : IRefactoringModel + { + private List _encapsulateAsUDTMemberCandidates; + + public EncapsulateFieldUseBackingUDTMemberModel(IObjectStateUDT targetObjectStateUserDefinedTypeField, + IEnumerable encapsulateAsUDTMemberCandidates, + IEnumerable objectStateUserDefinedTypeCandidates) + { + _encapsulateAsUDTMemberCandidates = encapsulateAsUDTMemberCandidates.ToList(); + EncapsulationCandidates = _encapsulateAsUDTMemberCandidates.Cast().ToList(); + + ObjectStateUDTField = targetObjectStateUserDefinedTypeField; + + ObjectStateUDTCandidates = objectStateUserDefinedTypeCandidates.ToList(); + + QualifiedModuleName = encapsulateAsUDTMemberCandidates.First().QualifiedModuleName; + } + + public INewContentAggregator NewContentAggregator { set; get; } + + public IReadOnlyCollection ObjectStateUDTCandidates { get; } + + public IEncapsulateFieldConflictFinder ConflictFinder { set; get; } + + public IReadOnlyCollection EncapsulationCandidates { get; } + + public IReadOnlyCollection SelectedFieldCandidates + => _encapsulateAsUDTMemberCandidates + .Where(v => v.EncapsulateFlag) + .ToList(); + + public QualifiedModuleName QualifiedModuleName { get; } + + public IObjectStateUDT ObjectStateUDTField + { + set + { + if (ObjectStateUDTField != null) + { + ObjectStateUDTField.IsSelected = false; + } + + if (value != null) + { + value.IsSelected = true; + } + + _encapsulateAsUDTMemberCandidates.ForEach(cf => cf.ObjectStateUDT = value); + } + get => _encapsulateAsUDTMemberCandidates.FirstOrDefault()?.ObjectStateUDT; + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberModelFactory.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberModelFactory.cs new file mode 100644 index 0000000000..f9456aa6b5 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberModelFactory.cs @@ -0,0 +1,130 @@ +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings.EncapsulateField; +using Rubberduck.Refactorings.EncapsulateFieldUseBackingUDTMember; +using System; +using System.Collections.Generic; +using System.Linq; + +namespace Rubberduck.Refactorings +{ + public interface IEncapsulateFieldUseBackingUDTMemberModelFactory + { + /// + /// Creates an EncapsulateFieldUseBackingUDTMemberModel used by the EncapsulateFieldUseBackingUDTMemberRefactoringAction. + /// + /// Optional: UserDefinedType Field to host the Encapsulated Field(s) + EncapsulateFieldUseBackingUDTMemberModel Create(IEnumerable fieldModels, Declaration objectStateField = null); + + /// + /// Creates an EncapsulateFieldUseBackingUDTMemberModel based upon collection of + /// IEncapsulateFieldCandidate instances. + /// This function is intended for exclusive use by the EncapsulateFieldModelFactory + /// + /// Optional: UserDefinedType Field to host the Encapsulated Field(s) + EncapsulateFieldUseBackingUDTMemberModel Create(IEncapsulateFieldCandidateSetsProvider contextCollections, IEnumerable fieldModels, Declaration objectStateField = null); + } + + public class EncapsulateFieldUseBackingUDTMemberModelFactory : IEncapsulateFieldUseBackingUDTMemberModelFactory + { + private readonly IDeclarationFinderProvider _declarationFinderProvider; + private readonly IEncapsulateFieldCandidateFactory _candidatesFactory; + private readonly IEncapsulateFieldCandidateSetsProviderFactory _candidateSetsFactory; + private readonly IEncapsulateFieldConflictFinderFactory _conflictFinderFactory; + + public EncapsulateFieldUseBackingUDTMemberModelFactory(IDeclarationFinderProvider declarationFinderProvider, + IEncapsulateFieldCandidateFactory candidatesFactory, + IEncapsulateFieldCandidateSetsProviderFactory candidateSetsFactory, + IEncapsulateFieldConflictFinderFactory encapsulateFieldConflictFinderFactory) + { + _declarationFinderProvider = declarationFinderProvider; + _candidatesFactory = candidatesFactory; + _candidateSetsFactory = candidateSetsFactory; + _conflictFinderFactory = encapsulateFieldConflictFinderFactory; + } + + public EncapsulateFieldUseBackingUDTMemberModel Create(IEnumerable fieldModels, Declaration objectStateField) + { + if (!fieldModels.Any()) + { + throw new ArgumentException(); + } + + var contextCollections = _candidateSetsFactory.Create(_declarationFinderProvider, _candidatesFactory, fieldModels.First().Declaration.QualifiedModuleName); + + return Create(contextCollections, fieldModels, objectStateField); + } + + public EncapsulateFieldUseBackingUDTMemberModel Create(IEncapsulateFieldCandidateSetsProvider contextCollections, IEnumerable fieldModels, Declaration objectStateField = null) + { + var fieldCandidates = contextCollections.EncapsulateFieldUseBackingUDTMemberCandidates.ToList(); + + if (objectStateField != null + && (objectStateField.Accessibility != Accessibility.Private + || !fieldCandidates.Any(c => c.Declaration == objectStateField && c.WrappedCandidate is IUserDefinedTypeCandidate))) + { + throw new ArgumentException("The object state Field must be a Private UserDefinedType"); + } + + var objectStateFieldCandidates = contextCollections.ObjectStateFieldCandidates; + + var defaultObjectStateUDT = objectStateFieldCandidates.FirstOrDefault(os => !os.IsExistingDeclaration); + + var targetStateUDT = DetermineObjectStateFieldTarget(defaultObjectStateUDT, objectStateField, objectStateFieldCandidates); + + foreach (var fieldModel in fieldModels) + { + var candidate = fieldCandidates.Single(c => c.Declaration.Equals(fieldModel.Declaration)); + candidate.EncapsulateFlag = true; + candidate.IsReadOnly = fieldModel.IsReadOnly; + if (fieldModel.PropertyIdentifier != null) + { + candidate.PropertyIdentifier = fieldModel.PropertyIdentifier; + } + } + + var conflictsFinder = _conflictFinderFactory.Create(_declarationFinderProvider, + contextCollections.EncapsulateFieldUseBackingFieldCandidates, + contextCollections.ObjectStateFieldCandidates); + + fieldCandidates.ForEach(c => c.ConflictFinder = conflictsFinder); + + if (objectStateField == null && !targetStateUDT.IsExistingDeclaration) + { + conflictsFinder.AssignNoConflictIdentifiers(targetStateUDT); + } + + fieldCandidates.ForEach(c => conflictsFinder.AssignNoConflictIdentifiers(c)); + + return new EncapsulateFieldUseBackingUDTMemberModel(targetStateUDT, fieldCandidates, objectStateFieldCandidates) + { + ConflictFinder = conflictsFinder + }; + } + + IObjectStateUDT DetermineObjectStateFieldTarget(IObjectStateUDT defaultObjectStateField, Declaration objectStateFieldTarget, IReadOnlyCollection objectStateFieldCandidates) + { + var targetStateUDT = defaultObjectStateField; + + if (objectStateFieldTarget != null) + { + targetStateUDT = objectStateFieldCandidates.Single(osc => objectStateFieldTarget == osc.Declaration); + } + else + { + var preExistingDefaultUDTField = + objectStateFieldCandidates.Where(osc => osc.TypeIdentifier == defaultObjectStateField.TypeIdentifier + && osc.IsExistingDeclaration); + + if (preExistingDefaultUDTField.Any() && preExistingDefaultUDTField.Count() == 1) + { + targetStateUDT = preExistingDefaultUDTField.First(); + } + } + + targetStateUDT.IsSelected = true; + + return targetStateUDT; + } + } +} \ No newline at end of file diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberPreviewProvider.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberPreviewProvider.cs new file mode 100644 index 0000000000..28ced18cf4 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberPreviewProvider.cs @@ -0,0 +1,32 @@ +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Refactorings.EncapsulateField; +using Rubberduck.Resources; +using Rubberduck.VBEditor; + +namespace Rubberduck.Refactorings.EncapsulateFieldUseBackingUDTMember +{ + public class EncapsulateFieldUseBackingUDTMemberPreviewProvider : RefactoringPreviewProviderWrapperBase + { + private readonly INewContentAggregatorFactory _aggregatorFactory; + + public EncapsulateFieldUseBackingUDTMemberPreviewProvider(EncapsulateFieldUseBackingUDTMemberRefactoringAction refactoringAction, + IRewritingManager rewritingManager, + INewContentAggregatorFactory aggregatorFactory) + : base(refactoringAction, rewritingManager) + { + _aggregatorFactory = aggregatorFactory; + } + + public override string Preview(EncapsulateFieldUseBackingUDTMemberModel model) + { + model.NewContentAggregator = _aggregatorFactory.Create(); + model.NewContentAggregator.AddNewContent(RubberduckUI.EncapsulateField_PreviewMarker, RubberduckUI.EncapsulateField_PreviewMarker); + return base.Preview(model); + } + + protected override QualifiedModuleName ComponentToShow(EncapsulateFieldUseBackingUDTMemberModel model) + { + return model.QualifiedModuleName; + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberRefactoringAction.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberRefactoringAction.cs new file mode 100644 index 0000000000..5ca49ff474 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberRefactoringAction.cs @@ -0,0 +1,163 @@ +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Refactorings.Common; +using Rubberduck.Refactorings.ReplaceReferences; +using Rubberduck.Refactorings.ReplacePrivateUDTMemberReferences; +using System.Linq; +using Rubberduck.Refactorings.EncapsulateField; +using Rubberduck.Refactorings.EncapsulateFieldInsertNewCode; +using System.Collections.Generic; +using Rubberduck.Refactorings.ModifyUserDefinedType; + +namespace Rubberduck.Refactorings.EncapsulateFieldUseBackingUDTMember +{ + public class EncapsulateFieldUseBackingUDTMemberRefactoringAction : CodeOnlyRefactoringActionBase + { + private readonly ICodeOnlyRefactoringAction _modifyUDTRefactoringAction; + private readonly ICodeOnlyRefactoringAction _replacePrivateUDTMemberReferencesRefactoringAction; + private readonly ICodeOnlyRefactoringAction _replaceReferencesRefactoringAction; + private readonly ICodeOnlyRefactoringAction _encapsulateFieldInsertNewCodeRefactoringAction; + private readonly INewContentAggregatorFactory _newContentAggregatorFactory; + private readonly IReplacePrivateUDTMemberReferencesModelFactory _replaceUDTMemberReferencesModelFactory; + + public EncapsulateFieldUseBackingUDTMemberRefactoringAction( + IEncapsulateFieldRefactoringActionsProvider refactoringActionsProvider, + IReplacePrivateUDTMemberReferencesModelFactory replaceUDTMemberReferencesModelFactory, + IRewritingManager rewritingManager, + INewContentAggregatorFactory newContentAggregatorFactory) + : base(rewritingManager) + { + _modifyUDTRefactoringAction = refactoringActionsProvider.ModifyUserDefinedType; + _replacePrivateUDTMemberReferencesRefactoringAction = refactoringActionsProvider.ReplaceUDTMemberReferences; + _replaceReferencesRefactoringAction = refactoringActionsProvider.ReplaceReferences; + _encapsulateFieldInsertNewCodeRefactoringAction = refactoringActionsProvider.EncapsulateFieldInsertNewCode; + _replaceUDTMemberReferencesModelFactory = replaceUDTMemberReferencesModelFactory; + _newContentAggregatorFactory = newContentAggregatorFactory; + } + + public override void Refactor(EncapsulateFieldUseBackingUDTMemberModel model, IRewriteSession rewriteSession) + { + if (!model.SelectedFieldCandidates.Any()) + { + return; + } + + ModifyFields(model, rewriteSession); + + ModifyReferences(model, rewriteSession); + + InsertNewContent(model, rewriteSession); + } + + private void ModifyFields(EncapsulateFieldUseBackingUDTMemberModel encapsulateFieldModel, IRewriteSession rewriteSession) + { + var rewriter = rewriteSession.CheckOutModuleRewriter(encapsulateFieldModel.QualifiedModuleName); + + if (encapsulateFieldModel.ObjectStateUDTField.IsExistingDeclaration) + { + var model = new ModifyUserDefinedTypeModel(encapsulateFieldModel.ObjectStateUDTField.AsTypeDeclaration); + + foreach (var candidate in encapsulateFieldModel.SelectedFieldCandidates) + { + model.AddNewMemberPrototype(candidate.Declaration, candidate.BackingIdentifier); + } + + _modifyUDTRefactoringAction.Refactor(model,rewriteSession); + } + + rewriter.RemoveVariables(encapsulateFieldModel.SelectedFieldCandidates.Select(f => f.Declaration) + .Cast()); + } + + private void ModifyReferences(EncapsulateFieldUseBackingUDTMemberModel model, IRewriteSession rewriteSession) + { + var privateUDTFields = model.SelectedFieldCandidates + .Where(f => (f.Declaration.AsTypeDeclaration?.DeclarationType.HasFlag(DeclarationType.UserDefinedType) ?? false) + && f.Declaration.AsTypeDeclaration.Accessibility == Accessibility.Private); + + ReplaceUDTMemberReferencesOfPrivateUDTFields(privateUDTFields, rewriteSession); + + ReplaceEncapsulatedFieldReferences(model.SelectedFieldCandidates.Except(privateUDTFields), model.ObjectStateUDTField, rewriteSession); + } + + private void ReplaceUDTMemberReferencesOfPrivateUDTFields(IEnumerable udtFields, IRewriteSession rewriteSession) + { + if (!udtFields.Any()) + { + return; + } + + var replacePrivateUDTMemberReferencesModel + = _replaceUDTMemberReferencesModelFactory.Create(udtFields.Select(f => f.Declaration).Cast()); + + foreach (var udtfield in udtFields) + { + InitializeModel(replacePrivateUDTMemberReferencesModel, udtfield); + } + + _replacePrivateUDTMemberReferencesRefactoringAction.Refactor(replacePrivateUDTMemberReferencesModel, rewriteSession); + } + + private void ReplaceEncapsulatedFieldReferences(IEnumerable nonPrivateUDTFields, IObjectStateUDT objectStateUDTField, IRewriteSession rewriteSession) + { + if (!nonPrivateUDTFields.Any()) + { + return; + } + + var replaceReferencesModel = new ReplaceReferencesModel() + { + ModuleQualifyExternalReferences = true, + }; + + foreach (var field in nonPrivateUDTFields) + { + InitializeModel(replaceReferencesModel, field, objectStateUDTField); + } + + _replaceReferencesRefactoringAction.Refactor(replaceReferencesModel, rewriteSession); + } + + private void InitializeModel(ReplacePrivateUDTMemberReferencesModel model, IEncapsulateFieldCandidate udtfield) + { + foreach (var udtMember in model.UDTMembers) + { + var udtExpressions = new PrivateUDTMemberReferenceReplacementExpressions($"{udtfield.IdentifierName}.{udtMember.IdentifierName}") + { + LocalReferenceExpression = udtMember.IdentifierName, + }; + + model.AssignUDTMemberReferenceExpressions(udtfield.Declaration as VariableDeclaration, udtMember, udtExpressions); + } + } + + private void InitializeModel(ReplaceReferencesModel model, IEncapsulateFieldCandidate field, IObjectStateUDT objectStateUDTField) + { + foreach (var idRef in field.Declaration.References) + { + var replacementExpression = field.PropertyIdentifier; + + if (idRef.QualifiedModuleName == field.QualifiedModuleName && field.Declaration.IsArray) + { + replacementExpression = $"{objectStateUDTField.FieldIdentifier}.{field.BackingIdentifier}"; + } + + model.AssignReferenceReplacementExpression(idRef, replacementExpression); + } + } + + private void InsertNewContent(EncapsulateFieldUseBackingUDTMemberModel model, IRewriteSession rewriteSession) + { + var aggregator = model.NewContentAggregator ?? _newContentAggregatorFactory.Create(); + model.NewContentAggregator = null; + + var encapsulateFieldInsertNewCodeModel = new EncapsulateFieldInsertNewCodeModel(model.SelectedFieldCandidates) + { + NewContentAggregator = aggregator, + ObjectStateUDTField = model.ObjectStateUDTField + }; + + _encapsulateFieldInsertNewCodeRefactoringAction.Refactor(encapsulateFieldInsertNewCodeModel, rewriteSession); + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulationStrategies/ConvertFieldsToUDTMembers.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulationStrategies/ConvertFieldsToUDTMembers.cs deleted file mode 100644 index 90541ab1aa..0000000000 --- a/Rubberduck.Refactorings/EncapsulateField/EncapsulationStrategies/ConvertFieldsToUDTMembers.cs +++ /dev/null @@ -1,100 +0,0 @@ -using Rubberduck.Parsing.Rewriter; -using Rubberduck.Parsing.Symbols; -using Rubberduck.Parsing.VBA; -using Rubberduck.Refactorings.Common; -using Rubberduck.SmartIndenter; -using System.Diagnostics; -using System.Linq; - -namespace Rubberduck.Refactorings.EncapsulateField -{ - public class ConvertFieldsToUDTMembers : EncapsulateFieldStrategyBase - { - private IObjectStateUDT _stateUDTField; - - public ConvertFieldsToUDTMembers(IDeclarationFinderProvider declarationFinderProvider, EncapsulateFieldModel model, IIndenter indenter, ICodeBuilder codeBuilder) - : base(declarationFinderProvider, model, indenter, codeBuilder) - { - _stateUDTField = model.ObjectStateUDTField; - } - - protected override void ModifyFields(IRewriteSession refactorRewriteSession) - { - var rewriter = refactorRewriteSession.CheckOutModuleRewriter(_targetQMN); - - rewriter.RemoveVariables(SelectedFields.Select(f => f.Declaration) - .Cast()); - - if (_stateUDTField.IsExistingDeclaration) - { - _stateUDTField.AddMembers(SelectedFields.Cast()); - - rewriter.Replace(_stateUDTField.AsTypeDeclaration, _stateUDTField.TypeDeclarationBlock(_indenter)); - } - } - - protected override void ModifyReferences(IRewriteSession refactorRewriteSession) - { - foreach (var field in SelectedFields) - { - LoadFieldReferenceContextReplacements(field); - } - - RewriteReferences(refactorRewriteSession); - } - - protected override void LoadNewDeclarationBlocks() - { - if (_stateUDTField.IsExistingDeclaration) { return; } - - _stateUDTField.AddMembers(SelectedFields.Cast()); - - AddContentBlock(NewContentTypes.TypeDeclarationBlock, _stateUDTField.TypeDeclarationBlock(_indenter)); - - AddContentBlock(NewContentTypes.DeclarationBlock, _stateUDTField.FieldDeclarationBlock); - return; - } - - protected override void LoadFieldReferenceContextReplacements(IEncapsulateFieldCandidate field) - { - Debug.Assert(field is IConvertToUDTMember); - - var converted = field as IConvertToUDTMember; - if (converted.WrappedCandidate is IUserDefinedTypeCandidate udt && udt.TypeDeclarationIsPrivate) - { - foreach (var member in udt.Members) - { - foreach (var idRef in member.FieldContextReferences) - { - var replacementText = member.IdentifierForReference(idRef); - if (IsExternalReferenceRequiringModuleQualification(idRef)) - { - replacementText = $"{udt.QualifiedModuleName.ComponentName}.{replacementText}"; - } - - SetUDTMemberReferenceRewriteContent(idRef, replacementText); - } - } - } - else - { - foreach (var idRef in field.Declaration.References) - { - var replacementText = converted.IdentifierForReference(idRef); - - if (IsExternalReferenceRequiringModuleQualification(idRef)) - { - replacementText = $"{converted.QualifiedModuleName.ComponentName}.{replacementText}"; - } - - if (converted.Declaration.IsArray) - { - replacementText = $"{_stateUDTField.FieldIdentifier}.{replacementText}"; - } - - SetReferenceRewriteContent(idRef, replacementText); - } - } - } - } -} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulationStrategies/EncapsulateFieldStrategyBase.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulationStrategies/EncapsulateFieldStrategyBase.cs deleted file mode 100644 index 1e78eff2b5..0000000000 --- a/Rubberduck.Refactorings/EncapsulateField/EncapsulationStrategies/EncapsulateFieldStrategyBase.cs +++ /dev/null @@ -1,279 +0,0 @@ -using Antlr4.Runtime; -using Rubberduck.Parsing; -using Rubberduck.Parsing.Grammar; -using Rubberduck.Parsing.Rewriter; -using Rubberduck.Parsing.Symbols; -using Rubberduck.Parsing.VBA; -using Rubberduck.Refactorings.Common; -using Rubberduck.Refactorings.EncapsulateField.Extensions; -using Rubberduck.Resources; -using Rubberduck.SmartIndenter; -using Rubberduck.VBEditor; -using System; -using System.Collections.Generic; -using System.Diagnostics; -using System.Linq; - -namespace Rubberduck.Refactorings.EncapsulateField -{ - - public struct PropertyAttributeSet - { - public string PropertyName { get; set; } - public string BackingField { get; set; } - public string AsTypeName { get; set; } - public string ParameterName { get; set; } - public bool GenerateLetter { get; set; } - public bool GenerateSetter { get; set; } - public bool UsesSetAssignment { get; set; } - public bool IsUDTProperty { get; set; } - public Declaration Declaration { get; set; } - } - - public interface IEncapsulateStrategy - { - IRewriteSession RefactorRewrite(IRewriteSession refactorRewriteSession, bool asPreview); - } - - public abstract class EncapsulateFieldStrategyBase : IEncapsulateStrategy - { - protected readonly IIndenter _indenter; - protected QualifiedModuleName _targetQMN; - private readonly int? _codeSectionStartIndex; - protected const string _defaultIndent = " "; //4 spaces - protected ICodeBuilder _codeBuilder; - - protected Dictionary IdentifierReplacements { get; } = new Dictionary(); - - protected enum NewContentTypes { TypeDeclarationBlock, DeclarationBlock, MethodBlock, PostContentMessage }; - protected Dictionary> _newContent { set; get; } - private static string DoubleSpace => $"{Environment.NewLine}{Environment.NewLine}"; - - protected IEnumerable SelectedFields { private set; get; } - - public EncapsulateFieldStrategyBase(IDeclarationFinderProvider declarationFinderProvider, EncapsulateFieldModel model, IIndenter indenter, ICodeBuilder codeBuilder) - { - _targetQMN = model.QualifiedModuleName; - _indenter = indenter; - _codeBuilder = codeBuilder; - SelectedFields = model.SelectedFieldCandidates.ToList(); - - _codeSectionStartIndex = declarationFinderProvider.DeclarationFinder - .Members(_targetQMN).Where(m => m.IsMember()) - .OrderBy(c => c.Selection) - .FirstOrDefault()?.Context.Start.TokenIndex ?? null; - } - - public IRewriteSession RefactorRewrite(IRewriteSession refactorRewriteSession, bool asPreview) - { - ModifyFields(refactorRewriteSession); - - ModifyReferences(refactorRewriteSession); - - InsertNewContent(refactorRewriteSession, asPreview); - - return refactorRewriteSession; - } - - protected abstract void ModifyFields(IRewriteSession rewriteSession); - - protected abstract void ModifyReferences(IRewriteSession refactorRewriteSession); - - protected abstract void LoadNewDeclarationBlocks(); - - protected void RewriteReferences(IRewriteSession refactorRewriteSession) - { - foreach (var replacement in IdentifierReplacements) - { - (ParserRuleContext Context, string Text) = replacement.Value; - var rewriter = refactorRewriteSession.CheckOutModuleRewriter(replacement.Key.QualifiedModuleName); - rewriter.Replace(Context, Text); - } - } - - protected void AddContentBlock(NewContentTypes contentType, string block) - => _newContent[contentType].Add(block); - - private void InsertNewContent(IRewriteSession refactorRewriteSession, bool isPreview = false) - { - _newContent = new Dictionary> - { - { NewContentTypes.PostContentMessage, new List() }, - { NewContentTypes.DeclarationBlock, new List() }, - { NewContentTypes.MethodBlock, new List() }, - { NewContentTypes.TypeDeclarationBlock, new List() } - }; - - LoadNewDeclarationBlocks(); - - LoadNewPropertyBlocks(); - - if (isPreview) - { - AddContentBlock(NewContentTypes.PostContentMessage, RubberduckUI.EncapsulateField_PreviewMarker); - } - - var newContentBlock = string.Join(DoubleSpace, - (_newContent[NewContentTypes.TypeDeclarationBlock]) - .Concat(_newContent[NewContentTypes.DeclarationBlock]) - .Concat(_newContent[NewContentTypes.MethodBlock]) - .Concat(_newContent[NewContentTypes.PostContentMessage])) - .Trim() - .LimitNewlines(); - - var rewriter = refactorRewriteSession.CheckOutModuleRewriter(_targetQMN); - if (_codeSectionStartIndex.HasValue) - { - rewriter.InsertBefore(_codeSectionStartIndex.Value, $"{newContentBlock}{DoubleSpace}"); - } - else - { - rewriter.InsertAtEndOfFile($"{DoubleSpace}{newContentBlock}"); - } - } - - protected void LoadNewPropertyBlocks() - { - foreach (var propertyAttributes in SelectedFields.SelectMany(f => f.PropertyAttributeSets)) - { - AddPropertyCodeBlocks(propertyAttributes); - } - } - - private void AddPropertyCodeBlocks(PropertyAttributeSet propertyAttributes) - { - Debug.Assert(propertyAttributes.Declaration.DeclarationType.HasFlag(DeclarationType.Variable) || propertyAttributes.Declaration.DeclarationType.HasFlag(DeclarationType.UserDefinedTypeMember)); - - var getContent = $"{propertyAttributes.PropertyName} = {propertyAttributes.BackingField}"; - if (propertyAttributes.UsesSetAssignment) - { - getContent = $"{Tokens.Set} {getContent}"; - } - - if (propertyAttributes.AsTypeName.Equals(Tokens.Variant) && !propertyAttributes.Declaration.IsArray) - { - getContent = string.Join(Environment.NewLine, - $"{Tokens.If} IsObject({propertyAttributes.BackingField}) {Tokens.Then}", - $"{_defaultIndent}{Tokens.Set} {propertyAttributes.PropertyName} = {propertyAttributes.BackingField}", - Tokens.Else, - $"{_defaultIndent}{propertyAttributes.PropertyName} = {propertyAttributes.BackingField}", - $"{Tokens.End} {Tokens.If}", - Environment.NewLine); - } - - if (!_codeBuilder.TryBuildPropertyGetCodeBlock(propertyAttributes.Declaration, propertyAttributes.PropertyName, out var propertyGet, content: $"{_defaultIndent}{getContent}")) - { - throw new ArgumentException(); - } - AddContentBlock(NewContentTypes.MethodBlock, propertyGet); - - if (!(propertyAttributes.GenerateLetter || propertyAttributes.GenerateSetter)) - { - return; - } - - if (propertyAttributes.GenerateLetter) - { - if (!_codeBuilder.TryBuildPropertyLetCodeBlock(propertyAttributes.Declaration, propertyAttributes.PropertyName, out var propertyLet, content: $"{_defaultIndent}{propertyAttributes.BackingField} = {propertyAttributes.ParameterName}")) - { - throw new ArgumentException(); - } - AddContentBlock(NewContentTypes.MethodBlock, propertyLet); - } - - if (propertyAttributes.GenerateSetter) - { - if (!_codeBuilder.TryBuildPropertySetCodeBlock(propertyAttributes.Declaration, propertyAttributes.PropertyName, out var propertySet, content: $"{_defaultIndent}{Tokens.Set} {propertyAttributes.BackingField} = {propertyAttributes.ParameterName}")) - { - throw new ArgumentException(); - } - AddContentBlock(NewContentTypes.MethodBlock, propertySet); - } - } - - protected virtual void LoadFieldReferenceContextReplacements(IEncapsulateFieldCandidate field) - { - if (field is IUserDefinedTypeCandidate udt && udt.TypeDeclarationIsPrivate) - { - foreach (var member in udt.Members) - { - foreach (var idRef in member.FieldContextReferences) - { - var replacementText = member.IdentifierForReference(idRef); - SetUDTMemberReferenceRewriteContent(idRef, replacementText); - } - } - } - else - { - foreach (var idRef in field.Declaration.References) - { - var replacementText = field.IdentifierForReference(idRef); - if (IsExternalReferenceRequiringModuleQualification(idRef)) - { - replacementText = $"{field.QualifiedModuleName.ComponentName}.{replacementText}"; - } - SetReferenceRewriteContent(idRef, replacementText); - } - } - } - - protected bool IsExternalReferenceRequiringModuleQualification(IdentifierReference idRef) - { - var isLHSOfMemberAccess = - (idRef.Context.Parent is VBAParser.MemberAccessExprContext - || idRef.Context.Parent is VBAParser.WithMemberAccessExprContext) - && !(idRef.Context == idRef.Context.Parent.GetChild(0)); - - return idRef.QualifiedModuleName != idRef.Declaration.QualifiedModuleName - && !isLHSOfMemberAccess; - } - - protected virtual void SetReferenceRewriteContent(IdentifierReference idRef, string replacementText) - { - if (idRef.Context is VBAParser.IndexExprContext idxExpression) - { - AddIdentifierReplacement(idRef, idxExpression.children.ElementAt(0) as ParserRuleContext, replacementText); - } - else if (idRef.Context is VBAParser.UnrestrictedIdentifierContext - || idRef.Context is VBAParser.SimpleNameExprContext) - { - AddIdentifierReplacement(idRef, idRef.Context, replacementText); - } - else if (idRef.Context.TryGetAncestor(out var wmac)) - { - AddIdentifierReplacement(idRef, wmac.GetChild(), replacementText); - } - else if (idRef.Context.TryGetAncestor(out var maec)) - { - AddIdentifierReplacement(idRef, maec, replacementText); - } - } - - protected virtual void SetUDTMemberReferenceRewriteContent(IdentifierReference idRef, string replacementText) - { - if (idRef.Context is VBAParser.IndexExprContext idxExpression) - { - AddIdentifierReplacement(idRef, idxExpression.children.ElementAt(0) as ParserRuleContext, replacementText); - } - else if (idRef.Context.TryGetAncestor(out var wmac)) - { - AddIdentifierReplacement(idRef, wmac.GetChild(), replacementText); - } - else if (idRef.Context.TryGetAncestor(out var maec)) - { - AddIdentifierReplacement(idRef, maec, replacementText); - } - } - - private void AddIdentifierReplacement( IdentifierReference idRef, ParserRuleContext context, string replacementText) - { - if (IdentifierReplacements.ContainsKey(idRef)) - { - IdentifierReplacements[idRef] = (context, replacementText); - return; - } - IdentifierReplacements.Add(idRef, (context, replacementText)); - } - } -} diff --git a/Rubberduck.Refactorings/EncapsulateField/EncapsulationStrategies/UseBackingFields.cs b/Rubberduck.Refactorings/EncapsulateField/EncapsulationStrategies/UseBackingFields.cs deleted file mode 100644 index 392a806849..0000000000 --- a/Rubberduck.Refactorings/EncapsulateField/EncapsulationStrategies/UseBackingFields.cs +++ /dev/null @@ -1,69 +0,0 @@ -using Rubberduck.Parsing.Grammar; -using Rubberduck.Parsing.Rewriter; -using Rubberduck.Parsing.Symbols; -using Rubberduck.Parsing.VBA; -using Rubberduck.Refactorings.Common; -using Rubberduck.Refactorings.EncapsulateField.Extensions; -using Rubberduck.SmartIndenter; -using System.Collections.Generic; -using System.Linq; - -namespace Rubberduck.Refactorings.EncapsulateField -{ - public class UseBackingFields : EncapsulateFieldStrategyBase - { - private IEnumerable _fieldsToDeleteAndReplace; - - public UseBackingFields(IDeclarationFinderProvider declarationFinderProvider, EncapsulateFieldModel model, IIndenter indenter, ICodeBuilder codeBuilder) - : base(declarationFinderProvider, model, indenter, codeBuilder) - { - _fieldsToDeleteAndReplace = SelectedFields.Where(f => f.Declaration.IsDeclaredInList() && !f.Declaration.HasPrivateAccessibility()).ToList(); - } - - - protected override void ModifyFields(IRewriteSession refactorRewriteSession) - { - var rewriter = refactorRewriteSession.CheckOutModuleRewriter(_targetQMN); - - rewriter.RemoveVariables(_fieldsToDeleteAndReplace.Select(f => f.Declaration).Cast()); - - foreach (var field in SelectedFields.Except(_fieldsToDeleteAndReplace)) - { - if (field.Declaration.HasPrivateAccessibility() && field.BackingIdentifier.Equals(field.Declaration.IdentifierName)) - { - rewriter.MakeImplicitDeclarationTypeExplicit(field.Declaration); - continue; - } - - rewriter.Rename(field.Declaration, field.BackingIdentifier); - rewriter.SetVariableVisiblity(field.Declaration, Accessibility.Private.TokenString()); - rewriter.MakeImplicitDeclarationTypeExplicit(field.Declaration); - } - } - - protected override void ModifyReferences(IRewriteSession refactorRewriteSession) - { - foreach (var field in SelectedFields) - { - LoadFieldReferenceContextReplacements(field); - } - - RewriteReferences(refactorRewriteSession); - } - - protected override void LoadNewDeclarationBlocks() - { - //New field declarations created here were removed from their - //variable list statement within ModifyFields(...) - foreach (var field in _fieldsToDeleteAndReplace) - { - var targetIdentifier = field.Declaration.Context.GetText().Replace(field.IdentifierName, field.BackingIdentifier); - var newField = field.Declaration.IsTypeSpecified - ? $"{Tokens.Private} {targetIdentifier}" - : $"{Tokens.Private} {targetIdentifier} {Tokens.As} {field.Declaration.AsTypeName}"; - - AddContentBlock(NewContentTypes.DeclarationBlock, newField); - } - } - } -} diff --git a/Rubberduck.Refactorings/EncapsulateField/Extensions/IModuleRewriterExtensions.cs b/Rubberduck.Refactorings/EncapsulateField/Extensions/IModuleRewriterExtensions.cs deleted file mode 100644 index 8a210bfeab..0000000000 --- a/Rubberduck.Refactorings/EncapsulateField/Extensions/IModuleRewriterExtensions.cs +++ /dev/null @@ -1,52 +0,0 @@ -using Rubberduck.Parsing; -using Rubberduck.Parsing.Grammar; -using Rubberduck.Parsing.Rewriter; -using Rubberduck.Parsing.Symbols; -using Rubberduck.Refactorings.Common; -using System; - -namespace Rubberduck.Refactorings.EncapsulateField.Extensions -{ - public static class IModuleRewriterExtensions - { - public static void InsertAtEndOfFile(this IModuleRewriter rewriter, string content) - { - if (content == string.Empty) { return; } - - rewriter.InsertBefore(rewriter.TokenStream.Size - 1, content); - } - - public static void MakeImplicitDeclarationTypeExplicit(this IModuleRewriter rewriter, Declaration element) - { - if (!element.Context.TryGetChildContext(out _)) - { - rewriter.InsertAfter(element.Context.Stop.TokenIndex, $" {Tokens.As} {element.AsTypeName}"); - } - } - - public static void Rename(this IModuleRewriter rewriter, Declaration target, string newName) - { - if (!(target.Context is IIdentifierContext context)) - { - throw new ArgumentException(); - } - - rewriter.Replace(context.IdentifierTokens, newName); - } - - public static void SetVariableVisiblity(this IModuleRewriter rewriter, Declaration element, string visibility) - { - if (!element.IsVariable()) { throw new ArgumentException(); } - - var variableStmtContext = element.Context.GetAncestor(); - var visibilityContext = variableStmtContext.GetChild(); - - if (visibilityContext != null) - { - rewriter.Replace(visibilityContext, visibility); - return; - } - rewriter.InsertBefore(element.Context.Start.TokenIndex, $"{visibility} "); - } - } -} diff --git a/Rubberduck.Refactorings/EncapsulateField/Extensions/StringExtensions.cs b/Rubberduck.Refactorings/EncapsulateField/Extensions/StringExtensions.cs index 31a2a18aa2..3496b48564 100644 --- a/Rubberduck.Refactorings/EncapsulateField/Extensions/StringExtensions.cs +++ b/Rubberduck.Refactorings/EncapsulateField/Extensions/StringExtensions.cs @@ -1,5 +1,4 @@ using System; -using System.Linq; namespace Rubberduck.Refactorings.EncapsulateField.Extensions { @@ -11,7 +10,10 @@ public static bool IsEquivalentVBAIdentifierTo(this string lhs, string identifie public static string IncrementEncapsulationIdentifier(this string identifier) { var fragments = identifier.Split('_'); - if (fragments.Length == 1) { return $"{identifier}_1"; } + if (fragments.Length == 1) + { + return $"{identifier}_1"; + } var lastFragment = fragments[fragments.Length - 1]; if (long.TryParse(lastFragment, out var number)) @@ -22,23 +24,5 @@ public static string IncrementEncapsulationIdentifier(this string identifier) } return $"{identifier}_1"; ; } - - public static string LimitNewlines(this string content, int maxConsecutiveNewlines = 2) - { - var target = string.Concat(Enumerable.Repeat(Environment.NewLine, maxConsecutiveNewlines + 1).ToList()); - var replacement = string.Concat(Enumerable.Repeat(Environment.NewLine, maxConsecutiveNewlines).ToList()); - var guard = 0; - var maxAttempts = 100; - while (++guard < maxAttempts && content.Contains(target)) - { - content = content.Replace(target, replacement); - } - - if (guard >= maxAttempts) - { - throw new FormatException($"Unable to limit consecutive '{Environment.NewLine}' strings to {maxConsecutiveNewlines}"); - } - return content; - } } } diff --git a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/ArrayCandidate.cs b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/ArrayCandidate.cs deleted file mode 100644 index b2a0612f5c..0000000000 --- a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/ArrayCandidate.cs +++ /dev/null @@ -1,64 +0,0 @@ -using Rubberduck.Parsing; -using Rubberduck.Parsing.Grammar; -using Rubberduck.Parsing.Symbols; -using Rubberduck.Resources; -using System.Linq; - -namespace Rubberduck.Refactorings.EncapsulateField -{ - public interface IArrayCandidate : IEncapsulateFieldCandidate - { - string UDTMemberDeclaration { get;} - bool HasExternalRedimOperation(out string errorMessage); - } - - public class ArrayCandidate : EncapsulateFieldCandidate, IArrayCandidate - { - private string _subscripts; - public ArrayCandidate(Declaration declaration, IValidateVBAIdentifiers validator) - :base(declaration, validator) - { - ImplementLet = false; - ImplementSet = false; - PropertyAsTypeName = Tokens.Variant; - CanBeReadWrite = false; - IsReadOnly = true; - - _subscripts = string.Empty; - if (declaration.Context.TryGetChildContext(out var ctxt)) - { - _subscripts = ctxt.GetText(); - } - } - - public override bool TryValidateEncapsulationAttributes(out string errorMessage) - { - errorMessage = string.Empty; - if (!EncapsulateFlag) { return true; } - - if (HasExternalRedimOperation(out errorMessage)) - { - return false; - } - return ConflictFinder.TryValidateEncapsulationAttributes(this, out errorMessage); - } - - public string UDTMemberDeclaration - => $"{PropertyIdentifier}({_subscripts}) {Tokens.As} {Declaration.AsTypeName}"; - - protected override string IdentifierForLocalReferences(IdentifierReference idRef) - => BackingIdentifier; - - public bool HasExternalRedimOperation(out string errorMessage) - { - errorMessage = string.Empty; - if (Declaration.References.Any(rf => rf.QualifiedModuleName != QualifiedModuleName - && rf.Context.TryGetAncestor(out _))) - { - errorMessage = string.Format(RubberduckUI.EncapsulateField_ArrayHasExternalRedimFormat, IdentifierName); - return true; - } - return false; - } - } -} diff --git a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/ConvertToUDTMemberCandidate.cs b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/ConvertToUDTMemberCandidate.cs deleted file mode 100644 index bb2720dd04..0000000000 --- a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/ConvertToUDTMemberCandidate.cs +++ /dev/null @@ -1,195 +0,0 @@ -using System.Collections.Generic; -using System.Linq; -using Rubberduck.Common; -using Rubberduck.Parsing.Symbols; -using Rubberduck.VBEditor; - -namespace Rubberduck.Refactorings.EncapsulateField -{ - - public interface IConvertToUDTMember : IEncapsulateFieldCandidate - { - string UDTMemberDeclaration { get; } - IEncapsulateFieldCandidate WrappedCandidate { get; } - IObjectStateUDT ObjectStateUDT { set; get; } - } - - public class ConvertToUDTMember : IConvertToUDTMember - { - private int _hashCode; - private readonly string _uniqueID; - private readonly IEncapsulateFieldCandidate _wrapped; - public ConvertToUDTMember(IEncapsulateFieldCandidate candidate, IObjectStateUDT objStateUDT) - { - _wrapped = candidate; - PropertyIdentifier = _wrapped.PropertyIdentifier; - ObjectStateUDT = objStateUDT; - _uniqueID = BuildUniqueID(candidate, objStateUDT); - _hashCode = _uniqueID.GetHashCode(); - } - - public virtual string UDTMemberDeclaration - { - get - { - if (_wrapped is IArrayCandidate array) - { - return array.UDTMemberDeclaration; - } - return $"{BackingIdentifier} As {_wrapped.AsTypeName}"; - } - } - - public IEncapsulateFieldCandidate WrappedCandidate => _wrapped; - - public IObjectStateUDT ObjectStateUDT { set; get; } - - public string TargetID => _wrapped.TargetID; - - public Declaration Declaration => _wrapped.Declaration; - - public bool EncapsulateFlag - { - set => _wrapped.EncapsulateFlag = value; - get => _wrapped.EncapsulateFlag; - } - - public string PropertyIdentifier - { - set => _wrapped.PropertyIdentifier = value; - get => _wrapped.PropertyIdentifier; - } - - public string PropertyAsTypeName => _wrapped.PropertyAsTypeName; - - public string BackingIdentifier - { - set { } - get => PropertyIdentifier; - } - public string BackingAsTypeName => Declaration.AsTypeName; - - public bool CanBeReadWrite - { - set => _wrapped.CanBeReadWrite = value; - get => _wrapped.CanBeReadWrite; - } - - public bool ImplementLet => _wrapped.ImplementLet; - - public bool ImplementSet => _wrapped.ImplementSet; - - public bool IsReadOnly - { - set => _wrapped.IsReadOnly = value; - get => _wrapped.IsReadOnly; - } - - public string ParameterName => _wrapped.ParameterName; - - public IValidateVBAIdentifiers NameValidator - { - set => _wrapped.NameValidator = value; - get => _wrapped.NameValidator; - } - - public IEncapsulateFieldConflictFinder ConflictFinder - { - set => _wrapped.ConflictFinder = value; - get => _wrapped.ConflictFinder; - } - - private string AccessorInProperty - { - get - { - if (_wrapped is IUserDefinedTypeMemberCandidate udtm) - { - return $"{ObjectStateUDT.FieldIdentifier}.{udtm.UDTField.PropertyIdentifier}.{BackingIdentifier}"; - } - return $"{ObjectStateUDT.FieldIdentifier}.{BackingIdentifier}"; - } - } - - public string IdentifierForReference(IdentifierReference idRef) - { - if (idRef.QualifiedModuleName != QualifiedModuleName) - { - return PropertyIdentifier; - } - return BackingIdentifier; - } - - public string IdentifierName => _wrapped.IdentifierName; - - public QualifiedModuleName QualifiedModuleName => _wrapped.QualifiedModuleName; - - public string AsTypeName => _wrapped.AsTypeName; - - public bool TryValidateEncapsulationAttributes(out string errorMessage) - { - errorMessage = string.Empty; - if (!_wrapped.EncapsulateFlag) { return true; } - - if (_wrapped is IArrayCandidate ac) - { - if (ac.HasExternalRedimOperation(out errorMessage)) - { - return false; - } - } - return ConflictFinder.TryValidateEncapsulationAttributes(this, out errorMessage); - } - - public IEnumerable PropertyAttributeSets - { - get - { - var modifiedSets = new List(); - var sets = _wrapped.PropertyAttributeSets; - for (var idx = 0; idx < sets.Count(); idx++) - { - var attributeSet = sets.ElementAt(idx); - var fields = attributeSet.BackingField.Split(new char[] { '.' }); - - attributeSet.BackingField = fields.Count() > 1 - ? $"{ObjectStateUDT.FieldIdentifier}.{attributeSet.BackingField.CapitalizeFirstLetter()}" - : $"{ObjectStateUDT.FieldIdentifier}.{attributeSet.PropertyName.CapitalizeFirstLetter()}"; - - modifiedSets.Add(attributeSet); - } - return modifiedSets; - } - } - - public override bool Equals(object obj) - { - return obj != null - && obj is ConvertToUDTMember convertWrapper - && BuildUniqueID(convertWrapper, convertWrapper.ObjectStateUDT) == _uniqueID; - } - - public override int GetHashCode() => _hashCode; - - private static string BuildUniqueID(IEncapsulateFieldCandidate candidate, IObjectStateUDT field) - => $"{candidate.QualifiedModuleName.Name}.{field.IdentifierName}.{candidate.IdentifierName}"; - - private PropertyAttributeSet AsPropertyAttributeSet - { - get - { - return new PropertyAttributeSet() - { - PropertyName = PropertyIdentifier, - BackingField = AccessorInProperty, - AsTypeName = PropertyAsTypeName, - ParameterName = ParameterName, - GenerateLetter = ImplementLet, - GenerateSetter = ImplementSet, - UsesSetAssignment = Declaration.IsObject, - IsUDTProperty = true - }; - } - } - } -} diff --git a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/EncapsulateFieldAsUDTMemberCandidate.cs b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/EncapsulateFieldAsUDTMemberCandidate.cs new file mode 100644 index 0000000000..0e2ccaee2b --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/EncapsulateFieldAsUDTMemberCandidate.cs @@ -0,0 +1,112 @@ +using Rubberduck.Parsing.Symbols; +using Rubberduck.VBEditor; +using System; + +namespace Rubberduck.Refactorings.EncapsulateField +{ + public interface IEncapsulateFieldAsUDTMemberCandidate : IEncapsulateFieldCandidate + { + IObjectStateUDT ObjectStateUDT { set; get; } + IEncapsulateFieldCandidate WrappedCandidate { get; } + string UserDefinedTypeMemberIdentifier { set; get; } + } + + /// + /// EncapsulateFieldAsUDTMemberCandidate wraps an IEncapusulateFieldCandidate instance + /// for the purposes of declaring it as a new UserDefinedTypeMember + /// within an existing or new UserDefinedType + /// + public class EncapsulateFieldAsUDTMemberCandidate : IEncapsulateFieldAsUDTMemberCandidate + { + private readonly int _hashCode; + private IEncapsulateFieldCandidate _wrapped; + public EncapsulateFieldAsUDTMemberCandidate(IEncapsulateFieldCandidate candidate, IObjectStateUDT objStateUDT) + { + _wrapped = candidate; + ObjectStateUDT = objStateUDT; + _hashCode = $"{candidate.QualifiedModuleName.Name}.{candidate.IdentifierName}".GetHashCode(); + } + + public IEncapsulateFieldCandidate WrappedCandidate => _wrapped; + + private IObjectStateUDT _objectStateUDT; + public IObjectStateUDT ObjectStateUDT + { + set + { + _objectStateUDT = value; + if (_objectStateUDT?.Declaration == _wrapped.Declaration) + { + //Cannot wrap itself if it is used as the ObjectStateUDT + _wrapped.EncapsulateFlag = false; + } + } + get => _objectStateUDT; + } + + public string TargetID => _wrapped.TargetID; + + public Declaration Declaration => _wrapped.Declaration; + + public bool EncapsulateFlag + { + set => _wrapped.EncapsulateFlag = value; + get => _wrapped.EncapsulateFlag; + } + + public string UserDefinedTypeMemberIdentifier + { + set => PropertyIdentifier = value; + get => PropertyIdentifier; + } + + public string PropertyIdentifier + { + set => _wrapped.PropertyIdentifier = value; + get => _wrapped.PropertyIdentifier; + } + + public virtual Action BackingIdentifierMutator { get; } = null; + + public string BackingIdentifier => PropertyIdentifier; + + public string PropertyAsTypeName => _wrapped.PropertyAsTypeName; + + public bool CanBeReadWrite => !_wrapped.Declaration.IsArray; + + public bool IsReadOnly + { + set => _wrapped.IsReadOnly = value; + get => _wrapped.IsReadOnly; + } + + public IEncapsulateFieldConflictFinder ConflictFinder + { + set => _wrapped.ConflictFinder = value; + get => _wrapped.ConflictFinder; + } + + public string IdentifierName => _wrapped.IdentifierName; + + public QualifiedModuleName QualifiedModuleName => _wrapped.QualifiedModuleName; + + public string AsTypeName => _wrapped.AsTypeName; + + public bool TryValidateEncapsulationAttributes(out string errorMessage) + { + (bool IsValid, string ErrorMsg) = ConflictFinder?.ValidateEncapsulationAttributes(this) ?? (true, string.Empty); + errorMessage = ErrorMsg; + return IsValid; + } + + public override bool Equals(object obj) + { + return obj != null + && obj is EncapsulateFieldAsUDTMemberCandidate convertWrapper + && convertWrapper.QualifiedModuleName == QualifiedModuleName + && convertWrapper.IdentifierName == IdentifierName; + } + + public override int GetHashCode() => _hashCode; + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/EncapsulateFieldCandidate.cs b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/EncapsulateFieldCandidate.cs index 796beb86ff..990d6ac4e2 100644 --- a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/EncapsulateFieldCandidate.cs +++ b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/EncapsulateFieldCandidate.cs @@ -1,11 +1,8 @@ -using Antlr4.Runtime; -using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Grammar; using Rubberduck.Parsing.Symbols; using Rubberduck.Refactorings.Common; -using Rubberduck.Refactorings.EncapsulateField.Extensions; using Rubberduck.VBEditor; using System; -using System.Collections.Generic; namespace Rubberduck.Refactorings.EncapsulateField { @@ -21,217 +18,122 @@ public interface IEncapsulateFieldCandidate : IEncapsulateFieldRefactoringElemen string TargetID { get; } Declaration Declaration { get; } bool EncapsulateFlag { get; set; } - string BackingIdentifier { set; get; } - string BackingAsTypeName { get; } + string BackingIdentifier { get; } + Action BackingIdentifierMutator { get; } string PropertyIdentifier { set; get; } string PropertyAsTypeName { get; } - bool CanBeReadWrite { set; get; } - bool ImplementLet { get; } - bool ImplementSet { get; } + bool CanBeReadWrite { get; } bool IsReadOnly { set; get; } - string ParameterName { get; } - IValidateVBAIdentifiers NameValidator { set; get; } IEncapsulateFieldConflictFinder ConflictFinder { set; get; } bool TryValidateEncapsulationAttributes(out string errorMessage); - string IdentifierForReference(IdentifierReference idRef); - IEnumerable PropertyAttributeSets { get; } } public class EncapsulateFieldCandidate : IEncapsulateFieldCandidate { - protected Declaration _target; - protected QualifiedModuleName _qmn; - protected readonly string _uniqueID; - protected int _hashCode; - private string _identifierName; + protected readonly int _hashCode; protected EncapsulationIdentifiers _fieldAndProperty; - private string _rhsParameterIdentifierName; - public EncapsulateFieldCandidate(Declaration declaration, IValidateVBAIdentifiers identifierValidator) + public EncapsulateFieldCandidate(Declaration declaration) { - _target = declaration; - NameValidator = identifierValidator; - _rhsParameterIdentifierName = Resources.Refactorings.Refactorings.CodeBuilder_DefaultPropertyRHSParam; + Declaration = declaration; + AsTypeName = declaration.AsTypeName; + + _fieldAndProperty = new EncapsulationIdentifiers(declaration.IdentifierName); + BackingIdentifierMutator = (value) => _fieldAndProperty.Field = value; - _fieldAndProperty = new EncapsulationIdentifiers(declaration.IdentifierName, identifierValidator); IdentifierName = declaration.IdentifierName; - PropertyAsTypeName = declaration.AsTypeName; - _qmn = declaration.QualifiedModuleName; - CanBeReadWrite = true; + TargetID = IdentifierName; - _uniqueID = $"{_qmn.Name}.{declaration.IdentifierName}"; - _hashCode = _uniqueID.GetHashCode(); + QualifiedModuleName = declaration.QualifiedModuleName; - ImplementLet = true; - ImplementSet = false; - if (_target.IsEnumField() && _target.AsTypeDeclaration.HasPrivateAccessibility()) - { - //5.3.1 The declared type of a function declaration - //may not be a private enum name. - PropertyAsTypeName = Tokens.Long; - } - else if (_target.AsTypeName.Equals(Tokens.Variant) - && !_target.IsArray) - { - ImplementSet = true; - } - else if (Declaration.IsObject) - { - ImplementLet = false; - ImplementSet = true; - } - } + //5.3.1 The declared type of a function declaration may not be a private enum. + PropertyAsTypeName = declaration.IsEnumField() && declaration.AsTypeDeclaration.HasPrivateAccessibility() + ? Tokens.Long + : declaration.AsTypeName; - protected Dictionary IdentifierReplacements { get; } = new Dictionary(); + CanBeReadWrite = !Declaration.IsArray; - public Declaration Declaration => _target; + _hashCode = $"{QualifiedModuleName.Name}.{declaration.IdentifierName}".GetHashCode(); + } - public string AsTypeName => _target.AsTypeName; + public Declaration Declaration { get; } - public virtual string BackingIdentifier - { - get => _fieldAndProperty.Field; - set => _fieldAndProperty.Field = value; - } + public string IdentifierName { get; } - public string BackingAsTypeName => Declaration.AsTypeName; + public string AsTypeName { get; } - public virtual IValidateVBAIdentifiers NameValidator { set; get; } + public bool CanBeReadWrite { get; } + + public virtual bool IsReadOnly { set; get; } public virtual IEncapsulateFieldConflictFinder ConflictFinder { set; get; } - public virtual bool TryValidateEncapsulationAttributes(out string errorMessage) - => ConflictFinder.TryValidateEncapsulationAttributes(this, out errorMessage); + public string PropertyAsTypeName { get; set; } + + public QualifiedModuleName QualifiedModuleName { get; } + + public virtual bool TryValidateEncapsulationAttributes(out string errorMessage) + { + (bool IsValid, string ErrorMsg) = ConflictFinder?.ValidateEncapsulationAttributes(this) ?? (true, string.Empty); + + errorMessage = ErrorMsg; + return IsValid; + } - public virtual string TargetID => _target?.IdentifierName ?? IdentifierName; + public virtual string TargetID { get; } protected bool _encapsulateFlag; public virtual bool EncapsulateFlag { set { - var valueChanged = _encapsulateFlag != value; - - _encapsulateFlag = value; - if (!_encapsulateFlag) - { - PropertyIdentifier = _fieldAndProperty.DefaultPropertyName; - } - else if (valueChanged) + if (_encapsulateFlag != value) { - ConflictFinder.AssignNoConflictIdentifiers(this); + _encapsulateFlag = value; + if (!_encapsulateFlag) + { + PropertyIdentifier = _fieldAndProperty.DefaultPropertyName; + return; + } + + ConflictFinder?.AssignNoConflictIdentifiers(this); } } get => _encapsulateFlag; } - public virtual bool IsReadOnly { set; get; } - public bool CanBeReadWrite { set; get; } - - public override bool Equals(object obj) - { - return obj != null - && obj is IEncapsulateFieldCandidate efc - && $"{efc.QualifiedModuleName.Name}.{efc.IdentifierName}" == _uniqueID; - } - - public override int GetHashCode() => _hashCode; - - public override string ToString() - =>$"({TargetID}){Declaration.ToString()}"; - - protected string IdentifierInNewProperties - => BackingIdentifier; - - public string IdentifierForReference(IdentifierReference idRef) - { - if (idRef.QualifiedModuleName != QualifiedModuleName) - { - return PropertyIdentifier; - } - return IdentifierForLocalReferences(idRef); - } - - protected virtual string IdentifierForLocalReferences(IdentifierReference idRef) - => PropertyIdentifier; - public string PropertyIdentifier { get => _fieldAndProperty.Property; set { - _fieldAndProperty.Property = value; - - TryRestoreNewFieldNameAsOriginalFieldIdentifierName(); - } - } - - private void TryRestoreNewFieldNameAsOriginalFieldIdentifierName() - { - var canNowUseOriginalFieldName = !_fieldAndProperty.TargetFieldName.IsEquivalentVBAIdentifierTo(_fieldAndProperty.Property) - && !ConflictFinder.IsConflictingProposedIdentifier(_fieldAndProperty.TargetFieldName, this, DeclarationType.Variable); - - if (canNowUseOriginalFieldName) - { - _fieldAndProperty.Field = _fieldAndProperty.TargetFieldName; - return; - } - - if (_fieldAndProperty.Field.IsEquivalentVBAIdentifierTo(_fieldAndProperty.TargetFieldName)) - { - _fieldAndProperty.Field = _fieldAndProperty.DefaultNewFieldName; - var isConflictingFieldIdentifier = ConflictFinder.HasConflictingIdentifier(this, DeclarationType.Variable, out _); - for (var count = 1; count < 10 && isConflictingFieldIdentifier; count++) + if (_fieldAndProperty.Property != value) { - BackingIdentifier = BackingIdentifier.IncrementEncapsulationIdentifier(); - isConflictingFieldIdentifier = ConflictFinder.HasConflictingIdentifier(this, DeclarationType.Variable, out _); + _fieldAndProperty.Property = value; + + //Reset the backing field identifier + _fieldAndProperty.Field = _fieldAndProperty.TargetFieldName; + ConflictFinder?.AssignNoConflictBackingFieldIdentifier(this); } } } - public string PropertyAsTypeName { get; set; } + public virtual string BackingIdentifier => _fieldAndProperty.Field; - public QualifiedModuleName QualifiedModuleName => _qmn; + public virtual Action BackingIdentifierMutator { get; } - public string IdentifierName + public override bool Equals(object obj) { - get => Declaration?.IdentifierName ?? _identifierName; - set => _identifierName = value; + return obj != null + && obj is IEncapsulateFieldCandidate efc + && efc.QualifiedModuleName == QualifiedModuleName + && efc.IdentifierName == IdentifierName; } - public virtual string ReferenceQualifier { set; get; } - - public string ParameterName => _rhsParameterIdentifierName; - - private bool _implLet; - public bool ImplementLet { get => !IsReadOnly && _implLet; set => _implLet = value; } - - private bool _implSet; - public bool ImplementSet { get => !IsReadOnly && _implSet; set => _implSet = value; } - - public EncapsulateFieldStrategy EncapsulateFieldStrategy { set; get; } = EncapsulateFieldStrategy.UseBackingFields; - - public virtual IEnumerable PropertyAttributeSets - => new List() { AsPropertyAttributeSet }; + public override int GetHashCode() => _hashCode; - protected virtual PropertyAttributeSet AsPropertyAttributeSet - { - get - { - return new PropertyAttributeSet() - { - PropertyName = PropertyIdentifier, - BackingField = IdentifierInNewProperties, - AsTypeName = PropertyAsTypeName, - ParameterName = ParameterName, - GenerateLetter = ImplementLet, - GenerateSetter = ImplementSet, - UsesSetAssignment = Declaration.IsObject, - IsUDTProperty = false, - Declaration = Declaration - }; - } - } + public override string ToString() + => $"({TargetID}){Declaration.ToString()}"; } } diff --git a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/EncapsulateFieldCandidateFactory.cs b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/EncapsulateFieldCandidateFactory.cs new file mode 100644 index 0000000000..8af4875200 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/EncapsulateFieldCandidateFactory.cs @@ -0,0 +1,66 @@ +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings.Common; +using Rubberduck.Refactorings.EncapsulateField; +using Rubberduck.VBEditor; +using System; +using System.Linq; + +namespace Rubberduck.Refactorings +{ + public interface IEncapsulateFieldCandidateFactory + { + IEncapsulateFieldCandidate CreateFieldCandidate(Declaration target); + IEncapsulateFieldAsUDTMemberCandidate CreateUDTMemberCandidate(IEncapsulateFieldCandidate fieldCandidate, IObjectStateUDT defaultObjectStateField); + IObjectStateUDT CreateDefaultObjectStateField(QualifiedModuleName qualifiedModuleName); + IObjectStateUDT CreateObjectStateField(IUserDefinedTypeCandidate userDefinedTypeField); + } + + public class EncapsulateFieldCandidateFactory : IEncapsulateFieldCandidateFactory + { + private readonly IDeclarationFinderProvider _declarationFinderProvider; + + public EncapsulateFieldCandidateFactory(IDeclarationFinderProvider declarationFinderProvider) + { + _declarationFinderProvider = declarationFinderProvider; + } + + public IEncapsulateFieldCandidate CreateFieldCandidate(Declaration target) + { + if (!target.IsUserDefinedType()) + { + return new EncapsulateFieldCandidate(target); + } + + var udtField = new UserDefinedTypeCandidate(target) as IUserDefinedTypeCandidate; + + var udtMembers = _declarationFinderProvider.DeclarationFinder + .UserDeclarations(DeclarationType.UserDefinedTypeMember) + .Where(utm => udtField.Declaration.AsTypeDeclaration == utm.ParentDeclaration); + + foreach (var udtMemberDeclaration in udtMembers) + { + var candidateUDTMember = new UserDefinedTypeMemberCandidate(CreateFieldCandidate(udtMemberDeclaration), udtField); + udtField.AddMember(candidateUDTMember); + } + + return udtField; + } + + public IEncapsulateFieldAsUDTMemberCandidate CreateUDTMemberCandidate(IEncapsulateFieldCandidate fieldCandidate, IObjectStateUDT defaultObjectStateField) + => new EncapsulateFieldAsUDTMemberCandidate(fieldCandidate, defaultObjectStateField); + + public IObjectStateUDT CreateDefaultObjectStateField(QualifiedModuleName qualifiedModuleName) + => new ObjectStateFieldCandidate(qualifiedModuleName); + + public IObjectStateUDT CreateObjectStateField(IUserDefinedTypeCandidate userDefinedTypeField) + { + if ((userDefinedTypeField.Declaration.AsTypeDeclaration?.Accessibility ?? Accessibility.Implicit) != Accessibility.Private) + { + throw new ArgumentException(); + } + + return new ObjectStateFieldCandidate(userDefinedTypeField); + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/EncapsulationIdentifiers.cs b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/EncapsulationIdentifiers.cs index bb29bdb253..3edb6503bd 100644 --- a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/EncapsulationIdentifiers.cs +++ b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/EncapsulationIdentifiers.cs @@ -1,6 +1,8 @@ using Rubberduck.Common; using System.Collections.Generic; using Rubberduck.Refactorings.EncapsulateField.Extensions; +using Rubberduck.Refactorings.Common; +using Rubberduck.Parsing.Symbols; namespace Rubberduck.Refactorings.EncapsulateField { @@ -9,7 +11,7 @@ public class EncapsulationIdentifiers private KeyValuePair _fieldAndProperty; private string _targetIdentifier; - public EncapsulationIdentifiers(string field, IValidateVBAIdentifiers identifierValidator) + public EncapsulationIdentifiers(string field) { _targetIdentifier = field; @@ -18,7 +20,7 @@ public EncapsulationIdentifiers(string field, IValidateVBAIdentifiers identifier if (field.TryMatchHungarianNotationCriteria(out var nonHungarianName)) { - if (identifierValidator.IsValidVBAIdentifier(nonHungarianName, out _)) + if (!VBAIdentifierValidator.TryMatchInvalidIdentifierCriteria(nonHungarianName, DeclarationType.Variable, out _)) { DefaultPropertyName = nonHungarianName; DefaultNewFieldName = field; @@ -27,7 +29,7 @@ public EncapsulationIdentifiers(string field, IValidateVBAIdentifiers identifier else if (field.StartsWith("m_")) { var propertyName = field.Substring(2).CapitalizeFirstLetter(); - if (identifierValidator.IsValidVBAIdentifier(propertyName, out _)) + if (!VBAIdentifierValidator.TryMatchInvalidIdentifierCriteria(propertyName, DeclarationType.Property, out _)) { DefaultPropertyName = propertyName; DefaultNewFieldName = field; diff --git a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/ObjectStateFieldCandidate.cs b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/ObjectStateFieldCandidate.cs new file mode 100644 index 0000000000..88f5bae33c --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/ObjectStateFieldCandidate.cs @@ -0,0 +1,104 @@ +using Rubberduck.Parsing.Symbols; +using Rubberduck.Common; +using Rubberduck.VBEditor; +using System; +using System.Collections.Generic; +using System.Linq; +using Rubberduck.Parsing.Grammar; + +namespace Rubberduck.Refactorings.EncapsulateField +{ + public interface IObjectStateUDT : IEncapsulateFieldRefactoringElement + { + Declaration Declaration { get; } + string TypeIdentifier { set; get; } + string FieldIdentifier { set; get; } + string FieldDeclarationBlock { get; } + bool IsExistingDeclaration { get; } + Declaration AsTypeDeclaration { get; } + bool IsSelected { set; get; } + IReadOnlyCollection ExistingMembers { get; } + } + + /// + /// ObjectStateUDT is a Private UserDefinedType whose UserDefinedTypeMembers represent + /// a consolidated grouping of object state in lieu of (or in addition to) a set of Private fields. + /// + /// + /// Within the EncapsulateField refactoring, the ObjectStateUDT can be an existing + /// UserDefinedType or a new UserDefinedType generated by the refactoring. + /// + public class ObjectStateFieldCandidate : IObjectStateUDT + { + private static string _defaultNewFieldName = "this"; + private readonly IUserDefinedTypeCandidate _wrappedUDTField; + + public ObjectStateFieldCandidate(IUserDefinedTypeCandidate udtField) + : this(udtField.IdentifierName, udtField.Declaration.AsTypeName) + { + if (!udtField.TypeDeclarationIsPrivate) + { + throw new ArgumentException(); + } + + QualifiedModuleName = udtField.QualifiedModuleName; + _wrappedUDTField = udtField; + } + + public ObjectStateFieldCandidate(QualifiedModuleName qualifiedModuleName) + :this(_defaultNewFieldName, $"T{qualifiedModuleName.ComponentName.CapitalizeFirstLetter()}") + { + QualifiedModuleName = qualifiedModuleName; + } + + private ObjectStateFieldCandidate(string fieldIdentifier, string typeIdentifier) + { + FieldIdentifier = fieldIdentifier; + TypeIdentifier = typeIdentifier; + } + + public string IdentifierName => _wrappedUDTField?.IdentifierName ?? FieldIdentifier; + + public Declaration Declaration => _wrappedUDTField?.Declaration; + + public string AsTypeName => _wrappedUDTField?.AsTypeName ?? TypeIdentifier; + + public string FieldDeclarationBlock + => $"{Accessibility.Private} {IdentifierName} {Tokens.As} {AsTypeName}"; + + private bool _isSelected; + public bool IsSelected + { + set + { + _isSelected = value; + if (_isSelected && IsExistingDeclaration) + { + _wrappedUDTField.EncapsulateFlag = false; + } + } + get => _isSelected; + } + + public IReadOnlyCollection ExistingMembers + => _wrappedUDTField?.Members.ToList() ?? new List(); + + public QualifiedModuleName QualifiedModuleName { get; } + + public string TypeIdentifier { set; get; } + + public bool IsExistingDeclaration => _wrappedUDTField != null; + + public Declaration AsTypeDeclaration => _wrappedUDTField?.Declaration.AsTypeDeclaration; + + public string FieldIdentifier { set; get; } + + public override bool Equals(object obj) + { + return (obj is IObjectStateUDT stateUDT && stateUDT.FieldIdentifier == FieldIdentifier) + || (obj is IEncapsulateFieldRefactoringElement fd && fd.IdentifierName == IdentifierName); + } + + public override int GetHashCode() => $"{QualifiedModuleName.Name}.{FieldIdentifier}".GetHashCode(); + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/UserDefinedTypeCandidate.cs b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/UserDefinedTypeCandidate.cs index b5e523d041..1694544d33 100644 --- a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/UserDefinedTypeCandidate.cs +++ b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/UserDefinedTypeCandidate.cs @@ -1,5 +1,4 @@ -using Rubberduck.Parsing.Grammar; -using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.Symbols; using Rubberduck.Refactorings.Common; using System; using System.Collections.Generic; @@ -10,16 +9,17 @@ public interface IUserDefinedTypeCandidate : IEncapsulateFieldCandidate { IEnumerable Members { get; } void AddMember(IUserDefinedTypeMemberCandidate member); - bool TypeDeclarationIsPrivate { set; get; } - bool CanBeObjectStateUDT { set; get; } - bool IsSelectedObjectStateUDT { set; get; } + bool TypeDeclarationIsPrivate { get; } } public class UserDefinedTypeCandidate : EncapsulateFieldCandidate, IUserDefinedTypeCandidate { - public UserDefinedTypeCandidate(Declaration declaration, IValidateVBAIdentifiers identifierValidator) - : base(declaration, identifierValidator) + public UserDefinedTypeCandidate(Declaration declaration) + : base(declaration) { + BackingIdentifierMutator = Declaration.AsTypeDeclaration.HasPrivateAccessibility() + ? null + : base.BackingIdentifierMutator; } public void AddMember(IUserDefinedTypeMemberCandidate member) @@ -30,54 +30,28 @@ public void AddMember(IUserDefinedTypeMemberCandidate member) private List _udtMembers = new List(); public IEnumerable Members => _udtMembers; - private bool _isPrivate; public bool TypeDeclarationIsPrivate - { - set => _isPrivate = value; - get => Declaration.AsTypeDeclaration?.HasPrivateAccessibility() ?? false; - } - - public bool IsSelectedObjectStateUDT { set; get; } - - private bool _canBeObjectStateUDT; - public bool CanBeObjectStateUDT - { - set => _canBeObjectStateUDT = value; - get => _canBeObjectStateUDT; - } + => Declaration.AsTypeDeclaration?.HasPrivateAccessibility() ?? false; - public override string BackingIdentifier - { - get => TypeDeclarationIsPrivate ? _fieldAndProperty.TargetFieldName : _fieldAndProperty.Field; - set => _fieldAndProperty.Field = value; - } + public override string BackingIdentifier => + BackingIdentifierMutator is null + ? _fieldAndProperty.TargetFieldName + : _fieldAndProperty.Field; - private IValidateVBAIdentifiers _namesValidator; - public override IValidateVBAIdentifiers NameValidator - { - set - { - _namesValidator = value; - foreach (var member in Members) - { - member.NameValidator = value; - } - } - get => _namesValidator; - } + public override Action BackingIdentifierMutator { get; } - private IEncapsulateFieldConflictFinder _conflictsValidator; + private IEncapsulateFieldConflictFinder _conflictsFinder; public override IEncapsulateFieldConflictFinder ConflictFinder { set { - _conflictsValidator = value; + _conflictsFinder = value; foreach (var member in Members) { member.ConflictFinder = value; } } - get => _conflictsValidator; + get => _conflictsFinder; } private bool _isReadOnly; @@ -98,6 +72,7 @@ public override bool EncapsulateFlag { set { + base.EncapsulateFlag = value; if (TypeDeclarationIsPrivate) { foreach (var member in Members) @@ -105,79 +80,13 @@ public override bool EncapsulateFlag member.EncapsulateFlag = value; } } - base.EncapsulateFlag = value; } get => base.EncapsulateFlag; } - protected override string IdentifierForLocalReferences(IdentifierReference idRef) - { - if (idRef.Context.Parent.Parent is VBAParser.WithStmtContext wsc) - { - return BackingIdentifier; - } - - return TypeDeclarationIsPrivate ? BackingIdentifier : PropertyIdentifier; - } - public override bool Equals(object obj) - { - if (obj is IUserDefinedTypeCandidate udt) - { - return udt.TargetID.Equals(TargetID); - } - return false; - } - - public override int GetHashCode() - { - return base.GetHashCode(); - } - - public override IEnumerable PropertyAttributeSets - { - get - { - if (TypeDeclarationIsPrivate) - { - var specs = new List(); - foreach (var member in Members) - { - var sets = member.PropertyAttributeSets; - var modifiedSets = new List(); - PropertyAttributeSet newSet; - foreach (var set in sets) - { - newSet = set; - newSet.BackingField = $"{BackingIdentifier}.{set.BackingField}"; - modifiedSets.Add(newSet); - } - specs.AddRange(modifiedSets); - } - return specs; - } - return new List() { AsPropertyAttributeSet }; - } - } - - protected override PropertyAttributeSet AsPropertyAttributeSet - { - get - { - return new PropertyAttributeSet() - { - PropertyName = PropertyIdentifier, - BackingField = IdentifierInNewProperties, - AsTypeName = PropertyAsTypeName, - ParameterName = ParameterName, - GenerateLetter = ImplementLet, - GenerateSetter = ImplementSet, - UsesSetAssignment = Declaration.IsObject, - IsUDTProperty = true, - Declaration = Declaration - }; - } - } + => (obj is IUserDefinedTypeCandidate udt && udt.TargetID.Equals(TargetID)); + public override int GetHashCode() => base.GetHashCode(); } } diff --git a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/UserDefinedTypeMemberCandidate.cs b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/UserDefinedTypeMemberCandidate.cs index b28b16c52a..58712073a7 100644 --- a/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/UserDefinedTypeMemberCandidate.cs +++ b/Rubberduck.Refactorings/EncapsulateField/FieldCandidates/UserDefinedTypeMemberCandidate.cs @@ -1,154 +1,54 @@ -using Rubberduck.Parsing; -using Rubberduck.Parsing.Grammar; -using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.Symbols; using Rubberduck.VBEditor; using System; -using System.Collections.Generic; -using System.Linq; namespace Rubberduck.Refactorings.EncapsulateField { public interface IUserDefinedTypeMemberCandidate : IEncapsulateFieldCandidate { IUserDefinedTypeCandidate UDTField { get; } - PropertyAttributeSet AsPropertyGeneratorSpec { get; } - IEnumerable FieldContextReferences { get; } IEncapsulateFieldCandidate WrappedCandidate { get; } } public class UserDefinedTypeMemberCandidate : IUserDefinedTypeMemberCandidate { - private int _hashCode; - private readonly string _uniqueID; - private string _rhsParameterIdentifierName; + private readonly int _hashCode; + public UserDefinedTypeMemberCandidate(IEncapsulateFieldCandidate candidate, IUserDefinedTypeCandidate udtField) { - _wrappedCandidate = candidate; - _rhsParameterIdentifierName = Resources.Refactorings.Refactorings.CodeBuilder_DefaultPropertyRHSParam; + WrappedCandidate = candidate; UDTField = udtField; PropertyIdentifier = IdentifierName; BackingIdentifier = IdentifierName; - _uniqueID = BuildUniqueID(candidate, UDTField); - _hashCode = _uniqueID.GetHashCode(); + _hashCode = TargetID.GetHashCode(); } - private IEncapsulateFieldCandidate _wrappedCandidate; - - public IEncapsulateFieldCandidate WrappedCandidate => _wrappedCandidate; + public IEncapsulateFieldCandidate WrappedCandidate { private set; get; } - public string AsTypeName => _wrappedCandidate.AsTypeName; - - public string BackingIdentifier - { - get - { - return _wrappedCandidate.IdentifierName; - } - set { } - } - - public string BackingAsTypeName => Declaration.AsTypeName; + public string AsTypeName => WrappedCandidate.AsTypeName; public IUserDefinedTypeCandidate UDTField { private set; get; } - public IValidateVBAIdentifiers NameValidator - { - set => _wrappedCandidate.NameValidator = value; - get => _wrappedCandidate.NameValidator; - } - public IEncapsulateFieldConflictFinder ConflictFinder { - set => _wrappedCandidate.ConflictFinder = value; - get => _wrappedCandidate.ConflictFinder; + set => WrappedCandidate.ConflictFinder = value; + get => WrappedCandidate.ConflictFinder; } public string TargetID => $"{UDTField.IdentifierName}.{IdentifierName}"; - public IEnumerable FieldContextReferences - => GetUDTMemberReferencesForField(this, UDTField); - public string IdentifierForReference(IdentifierReference idRef) => PropertyIdentifier; - public PropertyAttributeSet AsPropertyGeneratorSpec - { - get - { - return new PropertyAttributeSet() - { - PropertyName = PropertyIdentifier, - BackingField = BackingIdentifier, - AsTypeName = PropertyAsTypeName, - ParameterName = ParameterName, - GenerateLetter = ImplementLet, - GenerateSetter = ImplementSet, - UsesSetAssignment = Declaration.IsObject, - IsUDTProperty = Declaration.DeclarationType == DeclarationType.UserDefinedType, - Declaration = Declaration - }; - } - } - - public override bool Equals(object obj) - { - return obj != null - && obj is IUserDefinedTypeMemberCandidate udtMember - && BuildUniqueID(udtMember, udtMember.UDTField) == _uniqueID; - } - - public override int GetHashCode() => _hashCode; - public string PropertyIdentifier { set; get; } - private static string BuildUniqueID(IEncapsulateFieldCandidate candidate, IEncapsulateFieldCandidate field) => $"{candidate.QualifiedModuleName.Name}.{field.IdentifierName}.{candidate.IdentifierName}"; + public string BackingIdentifier { get; } - private static IEnumerable GetUDTMemberReferencesForField(IEncapsulateFieldCandidate udtMember, IUserDefinedTypeCandidate field) - { - var refs = new List(); - foreach (var idRef in udtMember.Declaration.References) - { - if (idRef.Context.TryGetAncestor(out var mac)) - { - var LHS = mac.children.First(); - switch (LHS) - { - case VBAParser.SimpleNameExprContext snec: - if (snec.GetText().Equals(field.IdentifierName)) - { - refs.Add(idRef); - } - break; - case VBAParser.MemberAccessExprContext submac: - if (submac.children.Last() is VBAParser.UnrestrictedIdentifierContext ur && ur.GetText().Equals(field.IdentifierName)) - { - refs.Add(idRef); - } - break; - case VBAParser.WithMemberAccessExprContext wmac: - if (wmac.children.Last().GetText().Equals(field.IdentifierName)) - { - refs.Add(idRef); - } - break; - } - } - else if (idRef.Context.TryGetAncestor(out var wmac)) - { - var wm = wmac.GetAncestor(); - var Lexpr = wm.GetChild(); - if (Lexpr.GetText().Equals(field.IdentifierName)) - { - refs.Add(idRef); - } - } - } - return refs; - } + public Action BackingIdentifierMutator { get; } = null; - public Declaration Declaration => _wrappedCandidate.Declaration; + public Declaration Declaration => WrappedCandidate.Declaration; - public string IdentifierName => _wrappedCandidate.IdentifierName; + public string IdentifierName => WrappedCandidate.IdentifierName; public bool TryValidateEncapsulationAttributes(out string errorMessage) { @@ -158,8 +58,8 @@ public bool TryValidateEncapsulationAttributes(out string errorMessage) public bool IsReadOnly { - set => _wrappedCandidate.IsReadOnly = value; - get => _wrappedCandidate.IsReadOnly; + set => WrappedCandidate.IsReadOnly = value; + get => WrappedCandidate.IsReadOnly; } private bool _encapsulateFlag; @@ -167,7 +67,7 @@ public bool EncapsulateFlag { set { - if (_wrappedCandidate is IUserDefinedTypeCandidate udt && udt.TypeDeclarationIsPrivate) + if (WrappedCandidate is IUserDefinedTypeCandidate udt && udt.TypeDeclarationIsPrivate) { foreach (var member in udt.Members) { @@ -175,63 +75,43 @@ public bool EncapsulateFlag } return; } - var valueChanged = _encapsulateFlag != value; + var valueChanged = _encapsulateFlag != value; _encapsulateFlag = value; - if (!_encapsulateFlag) + + PropertyIdentifier = WrappedCandidate.PropertyIdentifier; + + if (_encapsulateFlag && valueChanged && ConflictFinder != null) { - _wrappedCandidate.EncapsulateFlag = value; - PropertyIdentifier = _wrappedCandidate.PropertyIdentifier; + ConflictFinder.AssignNoConflictIdentifiers(this); } - else if (valueChanged) + + if (!_encapsulateFlag) { - ConflictFinder.AssignNoConflictIdentifiers(this); + WrappedCandidate.EncapsulateFlag = value; } + } get => _encapsulateFlag; } - public bool CanBeReadWrite - { - set => _wrappedCandidate.CanBeReadWrite = value; - get => _wrappedCandidate.CanBeReadWrite; - } + public bool CanBeReadWrite => !Declaration.IsArray; + public bool HasValidEncapsulationAttributes => true; public QualifiedModuleName QualifiedModuleName - => _wrappedCandidate.QualifiedModuleName; + => WrappedCandidate.QualifiedModuleName; - public string PropertyAsTypeName => _wrappedCandidate.PropertyAsTypeName; + public string PropertyAsTypeName => WrappedCandidate.PropertyAsTypeName; - public string ParameterName => _rhsParameterIdentifierName; - - public bool ImplementLet => _wrappedCandidate.ImplementLet; - - public bool ImplementSet => _wrappedCandidate.ImplementSet; - - public IEnumerable PropertyAttributeSets + public override bool Equals(object obj) { - get - { - if (!(_wrappedCandidate is IUserDefinedTypeCandidate udt)) - { - return new List() { AsPropertyGeneratorSpec }; - } - - var sets = _wrappedCandidate.PropertyAttributeSets; - if (udt.TypeDeclarationIsPrivate) - { - return sets; - } - var modifiedSets = new List(); - for(var idx = 0; idx < sets.Count(); idx++) - { - var attr = sets.ElementAt(idx); - attr.BackingField = attr.PropertyName; - modifiedSets.Add(attr); - } - return modifiedSets; - } + return obj != null + && obj is IUserDefinedTypeMemberCandidate udtMember + && udtMember.QualifiedModuleName == QualifiedModuleName + && udtMember.TargetID == TargetID; } + + public override int GetHashCode() => _hashCode; } } diff --git a/Rubberduck.Refactorings/EncapsulateField/FieldEncapsulationModel.cs b/Rubberduck.Refactorings/EncapsulateField/FieldEncapsulationModel.cs new file mode 100644 index 0000000000..6372dec9dc --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/FieldEncapsulationModel.cs @@ -0,0 +1,28 @@ +using Rubberduck.Parsing.Symbols; + +namespace Rubberduck.Refactorings.EncapsulateField +{ + /// + /// FieldEncapsulationModel consolidates attributes necessary for the EncapsulateFieldUseBackingFieldRefactoringAction + /// and the EncapsulateFieldUseBackingUDTMemberRefactoringAction. + /// + /// + /// There is no identifier validation or conflict checking performed. + /// If the target is a UserDefinedType Field and the UserDefinedType is Private, + /// then the propertyIdentifier parameter is ignored and PropertyIdentifiers for each UserDefinedTypeMember + /// are generated by the refactoring action. + /// + public class FieldEncapsulationModel + { + public FieldEncapsulationModel(VariableDeclaration target, bool isReadOnly = false, string propertyIdentifier = null) + { + Declaration = target; + IsReadOnly = isReadOnly; + PropertyIdentifier = propertyIdentifier; + } + + public VariableDeclaration Declaration { get; } + public string PropertyIdentifier { set; get; } + public bool IsReadOnly { set; get; } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/ObjectStateUDT.cs b/Rubberduck.Refactorings/EncapsulateField/ObjectStateUDT.cs deleted file mode 100644 index f64202ad68..0000000000 --- a/Rubberduck.Refactorings/EncapsulateField/ObjectStateUDT.cs +++ /dev/null @@ -1,170 +0,0 @@ -using Rubberduck.Parsing.Grammar; -using Rubberduck.Parsing.Symbols; -using Rubberduck.Common; -using Rubberduck.SmartIndenter; -using Rubberduck.VBEditor; -using System; -using System.Collections.Generic; -using System.Linq; -using System.Text; -using System.Threading.Tasks; -using Rubberduck.Refactorings.EncapsulateField.Extensions; -using Rubberduck.Resources; - -namespace Rubberduck.Refactorings.EncapsulateField -{ - public interface IObjectStateUDT : IEncapsulateFieldRefactoringElement - { - string TypeIdentifier { set; get; } - string FieldIdentifier { set; get; } - string TypeDeclarationBlock(IIndenter indenter = null); - string FieldDeclarationBlock { get; } - void AddMembers(IEnumerable fields); - bool IsExistingDeclaration { get; } - Declaration AsTypeDeclaration { get; } - bool IsSelected { set; get; } - IEnumerable ExistingMembers { get; } - } - - //ObjectStateUDT can be an existing UDT (Private only) selected by the user, or a - //newly inserted declaration - public class ObjectStateUDT : IObjectStateUDT - { - private static string _defaultNewFieldName = "this"; - private List _convertedMembers; - - private readonly IUserDefinedTypeCandidate _wrappedUDT; - private int _hashCode; - - public ObjectStateUDT(IUserDefinedTypeCandidate udt) - : this(udt.Declaration.AsTypeName) - { - if (!udt.TypeDeclarationIsPrivate) - { - throw new ArgumentException(); - } - - FieldIdentifier = udt.IdentifierName; - _wrappedUDT = udt; - _hashCode = ($"{_qmn.Name}.{_wrappedUDT.IdentifierName}").GetHashCode(); - } - - public ObjectStateUDT(QualifiedModuleName qmn) - :this($"T{qmn.ComponentName.CapitalizeFirstLetter()}") - { - QualifiedModuleName = qmn; - } - - private ObjectStateUDT(string typeIdentifier) - { - FieldIdentifier = _defaultNewFieldName; - TypeIdentifier = typeIdentifier; - _convertedMembers = new List(); - } - - public string IdentifierName => _wrappedUDT?.IdentifierName ?? FieldIdentifier; - - public string AsTypeName => _wrappedUDT?.AsTypeName ?? TypeIdentifier; - - private bool _isSelected; - public bool IsSelected - { - set - { - _isSelected = value; - if (_wrappedUDT != null) - { - _wrappedUDT.IsSelectedObjectStateUDT = value; - } - - if (_isSelected && IsExistingDeclaration) - { - _wrappedUDT.EncapsulateFlag = false; - } - } - get => _isSelected; - } - - public IEnumerable ExistingMembers - { - get - { - if (IsExistingDeclaration) - { - return _wrappedUDT.Members; - } - return Enumerable.Empty(); - } - } - - - private QualifiedModuleName _qmn; - public QualifiedModuleName QualifiedModuleName - { - set => _qmn = value; - get => _wrappedUDT?.QualifiedModuleName ?? _qmn; - } - - public string TypeIdentifier { set; get; } - - public bool IsExistingDeclaration => _wrappedUDT != null; - - public Declaration AsTypeDeclaration => _wrappedUDT?.Declaration.AsTypeDeclaration; - - public string FieldIdentifier { set; get; } - - public void AddMembers(IEnumerable fields) - { - _convertedMembers = new List(); - if (IsExistingDeclaration) - { - foreach (var member in _wrappedUDT.Members) - { - var convertedMember = new ConvertToUDTMember(member, this) { EncapsulateFlag = false }; - _convertedMembers.Add(convertedMember); - } - } - _convertedMembers.AddRange(fields); - } - - public string FieldDeclarationBlock - => $"{Accessibility.Private} {IdentifierName} {Tokens.As} {AsTypeName}"; - - public string TypeDeclarationBlock(IIndenter indenter = null) - { - if (indenter != null) - { - return string.Join(Environment.NewLine, indenter?.Indent(BlockLines(Accessibility.Private) ?? BlockLines(Accessibility.Private), true)); - } - return string.Join(Environment.NewLine, BlockLines(Accessibility.Private)); - } - - public override bool Equals(object obj) - { - if (obj is IObjectStateUDT stateUDT && stateUDT.FieldIdentifier == FieldIdentifier) - { - return true; - } - if (obj is IEncapsulateFieldRefactoringElement fd && fd.IdentifierName == IdentifierName) - { - return true; - } - return false; - } - - public override int GetHashCode() => _hashCode; - - private IEnumerable BlockLines(Accessibility accessibility) - { - var blockLines = new List(); - - blockLines.Add($"{accessibility.TokenString()} {Tokens.Type} {TypeIdentifier}"); - - _convertedMembers.ForEach(m => blockLines.Add($"{m.UDTMemberDeclaration}")); - - blockLines.Add($"{Tokens.End} {Tokens.Type}"); - - return blockLines; - } - } -} diff --git a/Rubberduck.Refactorings/EncapsulateField/PropertyAttributeSetsGenerator.cs b/Rubberduck.Refactorings/EncapsulateField/PropertyAttributeSetsGenerator.cs new file mode 100644 index 0000000000..7d6e6a14e7 --- /dev/null +++ b/Rubberduck.Refactorings/EncapsulateField/PropertyAttributeSetsGenerator.cs @@ -0,0 +1,153 @@ +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Symbols; +using System; +using System.Collections.Generic; +using System.Linq; + +namespace Rubberduck.Refactorings.EncapsulateField +{ + public struct PropertyAttributeSet + { + public string PropertyName { get; set; } + public string BackingField { get; set; } + public string AsTypeName { get; set; } + public string RHSParameterIdentifier { get; set; } + public bool GeneratePropertyLet { get; set; } + public bool GeneratePropertySet { get; set; } + public bool UsesSetAssignment { get; set; } + public bool IsUDTProperty { get; set; } + public Declaration Declaration { get; set; } + } + + public interface IPropertyAttributeSetsGenerator + { + IReadOnlyCollection GeneratePropertyAttributeSets(IEncapsulateFieldCandidate candidate); + } + + /// + /// PropertyAttributeSetsGenerator operates on an IEncapsulateFieldCandidate instance to + /// generate a collection of PropertyAttributeSets used by the EncapsulateField refactoring + /// actions to generate Property Let/Set/Get code blocks. + /// + /// + /// Typically there is only a single PropertyAttributeSet in the collection. + /// In the case of a Private UserDefinedType, there will be a PropertyAttributeSet + /// for each UserDefinedTypeMember. + /// + public class PropertyAttributeSetsGenerator : IPropertyAttributeSetsGenerator + { + private Func _backingFieldQualifierFunc; + + public PropertyAttributeSetsGenerator() + { + _backingFieldQualifierFunc = BackingField_BackingFieldQualifier; + } + + private static string BackingUDTMember_BackingFieldQualifier(IEncapsulateFieldCandidate candidate, string backingField) + => $"{candidate.PropertyIdentifier}.{backingField}"; + + private static string BackingField_BackingFieldQualifier(IEncapsulateFieldCandidate candidate, string backingField) + => $"{candidate.BackingIdentifier}.{backingField}"; + + public IReadOnlyCollection GeneratePropertyAttributeSets(IEncapsulateFieldCandidate candidate) + { + if (!(candidate is IEncapsulateFieldAsUDTMemberCandidate asUDTCandidate)) + { + _backingFieldQualifierFunc = BackingField_BackingFieldQualifier; + return CreatePropertyAttributeSets(candidate).ToList(); + } + + return GeneratePropertyAttributeSets(asUDTCandidate); + } + + private IReadOnlyCollection GeneratePropertyAttributeSets(IEncapsulateFieldAsUDTMemberCandidate asUDTCandidate) + { + _backingFieldQualifierFunc = BackingUDTMember_BackingFieldQualifier; + + Func QualifyPrivateUDTWrappedBackingField = attributeSet => + { + var fields = attributeSet.BackingField.Split(new char[] { '.' }); + + return fields.Count() > 1 + ? $"{asUDTCandidate.ObjectStateUDT.FieldIdentifier}.{attributeSet.BackingField}" + : $"{asUDTCandidate.ObjectStateUDT.FieldIdentifier}.{attributeSet.PropertyName}"; + }; + + var propertyAttributeSet = CreatePropertyAttributeSets(asUDTCandidate.WrappedCandidate); + + return QualifyBackingField(propertyAttributeSet, set => QualifyPrivateUDTWrappedBackingField(set)).ToList(); + } + + private IEnumerable CreatePropertyAttributeSets(IUserDefinedTypeCandidate candidate) + { + + if (candidate.TypeDeclarationIsPrivate) + { + var allPropertyAttributeSets = new List(); + foreach (var member in candidate.Members) + { + var propertyAttributeSets = CreatePropertyAttributeSets(member); + var modifiedSets = QualifyBackingField(propertyAttributeSets, propertyAttributeSet => _backingFieldQualifierFunc(candidate, propertyAttributeSet.BackingField)); + allPropertyAttributeSets.AddRange(modifiedSets); + } + return allPropertyAttributeSets; + } + + return new List() { CreatePropertyAttributeSet(candidate) }; + } + + private IEnumerable CreatePropertyAttributeSets(IUserDefinedTypeMemberCandidate udtMemberCandidate) + { + if (udtMemberCandidate.WrappedCandidate is IUserDefinedTypeCandidate udtCandidate) + { + var propertyAttributeSets = CreatePropertyAttributeSets(udtMemberCandidate.WrappedCandidate); + + return udtCandidate.TypeDeclarationIsPrivate + ? propertyAttributeSets + : QualifyBackingField(propertyAttributeSets, attr => attr.PropertyName); + } + + return new List() { CreatePropertyAttributeSet(udtMemberCandidate) }; + } + + private IEnumerable CreatePropertyAttributeSets(IEncapsulateFieldCandidate candidate) + { + switch (candidate) + { + case IUserDefinedTypeCandidate udtCandidate: + return CreatePropertyAttributeSets(udtCandidate); + case IUserDefinedTypeMemberCandidate udtMemberCandidate: + return CreatePropertyAttributeSets(udtMemberCandidate); + default: + return new List() { CreatePropertyAttributeSet(candidate) }; + } + } + + private IEnumerable QualifyBackingField(IEnumerable propertyAttributeSets, Func backingFieldQualifier) + { + var modifiedSets = new List(); + for (var idx = 0; idx < propertyAttributeSets.Count(); idx++) + { + var propertyAttributeSet = propertyAttributeSets.ElementAt(idx); + propertyAttributeSet.BackingField = backingFieldQualifier(propertyAttributeSet); + modifiedSets.Add(propertyAttributeSet); + } + return modifiedSets; + } + + private PropertyAttributeSet CreatePropertyAttributeSet(IEncapsulateFieldCandidate candidate) + { + return new PropertyAttributeSet() + { + PropertyName = candidate.PropertyIdentifier, + BackingField = candidate.BackingIdentifier, + AsTypeName = candidate.PropertyAsTypeName, + RHSParameterIdentifier = Resources.Refactorings.Refactorings.CodeBuilder_DefaultPropertyRHSParam, + GeneratePropertyLet = !candidate.IsReadOnly && !candidate.Declaration.IsObject && !candidate.Declaration.IsArray, + GeneratePropertySet = !candidate.IsReadOnly && !candidate.Declaration.IsArray && (candidate.Declaration.IsObject || candidate.Declaration.AsTypeName == Tokens.Variant), + UsesSetAssignment = candidate.Declaration.IsObject, + Declaration = candidate.Declaration + }; + } + } +} diff --git a/Rubberduck.Refactorings/EncapsulateField/Validations/ConvertFieldsToUDTMembersStrategyConflictFinder.cs b/Rubberduck.Refactorings/EncapsulateField/Validations/ConvertFieldsToUDTMembersStrategyConflictFinder.cs deleted file mode 100644 index b6c6b0ee5d..0000000000 --- a/Rubberduck.Refactorings/EncapsulateField/Validations/ConvertFieldsToUDTMembersStrategyConflictFinder.cs +++ /dev/null @@ -1,80 +0,0 @@ -using Rubberduck.Parsing.Symbols; -using Rubberduck.Parsing.VBA; -using Rubberduck.Refactorings.EncapsulateField.Extensions; -using System; -using System.Collections.Generic; -using System.Linq; -using System.Text; -using System.Threading.Tasks; - -namespace Rubberduck.Refactorings.EncapsulateField -{ - public class ConvertFieldsToUDTMembersStrategyConflictFinder : EncapsulateFieldConflictFinderBase - { - private IEnumerable _objectStateUDTs; - public ConvertFieldsToUDTMembersStrategyConflictFinder(IDeclarationFinderProvider declarationFinderProvider, IEnumerable candidates, IEnumerable udtCandidates, IEnumerable objectStateUDTs) - : base(declarationFinderProvider, candidates, udtCandidates) - { - _objectStateUDTs = objectStateUDTs; - } - - public override bool TryValidateEncapsulationAttributes(IEncapsulateFieldCandidate field, out string errorMessage) - { - errorMessage = string.Empty; - if (!field.EncapsulateFlag) { return true; } - - if (!base.TryValidateEncapsulationAttributes(field, out errorMessage)) - { - return false; - } - - //Compare to existing members...they cannot change - var objectStateUDT = _objectStateUDTs.SingleOrDefault(os => os.IsSelected); - return !ConflictsWithExistingUDTMembers(objectStateUDT, field.BackingIdentifier); - } - - public override IEncapsulateFieldCandidate AssignNoConflictIdentifiers(IEncapsulateFieldCandidate candidate) - { - candidate = base.AssignNoConflictIdentifier(candidate, DeclarationType.Property); - - var objectStateUDT = _objectStateUDTs.SingleOrDefault(os => os.IsSelected); - var guard = 0; - while (guard++ < 10 && ConflictsWithExistingUDTMembers(objectStateUDT, candidate.PropertyIdentifier)) - { - candidate.PropertyIdentifier = candidate.PropertyIdentifier.IncrementEncapsulationIdentifier(); - } - return candidate; - } - - protected override IEncapsulateFieldCandidate AssignNoConflictIdentifier(IEncapsulateFieldCandidate candidate, DeclarationType declarationType) - { - candidate = base.AssignNoConflictIdentifier(candidate, declarationType); - - var objectStateUDT = _objectStateUDTs.SingleOrDefault(os => os.IsSelected); - var guard = 0; - while (guard++ < 10 && ConflictsWithExistingUDTMembers(objectStateUDT, candidate.BackingIdentifier)) - { - candidate.BackingIdentifier = candidate.BackingIdentifier.IncrementEncapsulationIdentifier(); - } - return candidate; - } - - private bool ConflictsWithExistingUDTMembers(IObjectStateUDT objectStateUDT, string identifier) - { - if (objectStateUDT is null) { return false; } - - return objectStateUDT.ExistingMembers.Any(nm => nm.IdentifierName.IsEquivalentVBAIdentifierTo(identifier)); - } - - protected override IEnumerable FindRelevantMembers(IEncapsulateFieldCandidate candidate) - { - var members = _declarationFinderProvider.DeclarationFinder.Members(candidate.QualifiedModuleName) - .Where(d => d != candidate.Declaration); - - var membersToRemove = _fieldCandidates.Where(fc => fc.EncapsulateFlag && fc.Declaration.DeclarationType.HasFlag(DeclarationType.Variable)) - .Select(fc => fc.Declaration); - - return members.Except(membersToRemove); - } - } -} diff --git a/Rubberduck.Refactorings/EncapsulateField/Validations/EncapsulateFieldConflictFinderBase.cs b/Rubberduck.Refactorings/EncapsulateField/Validations/EncapsulateFieldConflictFinderBase.cs deleted file mode 100644 index 674e77cc0e..0000000000 --- a/Rubberduck.Refactorings/EncapsulateField/Validations/EncapsulateFieldConflictFinderBase.cs +++ /dev/null @@ -1,219 +0,0 @@ -using Rubberduck.Parsing.Symbols; -using Rubberduck.Parsing.VBA; -using Rubberduck.Refactorings.Common; -using Rubberduck.Refactorings.EncapsulateField.Extensions; -using Rubberduck.Resources; -using Rubberduck.VBEditor; -using System; -using System.Collections.Generic; -using System.Diagnostics; -using System.Linq; -using System.Text; -using System.Threading.Tasks; - -namespace Rubberduck.Refactorings.EncapsulateField -{ - public interface IEncapsulateFieldConflictFinder - { - bool HasConflictingIdentifier(IEncapsulateFieldCandidate field, DeclarationType declarationType, out string errorMessage); - IEncapsulateFieldCandidate AssignNoConflictIdentifiers(IEncapsulateFieldCandidate candidate); - bool IsConflictingProposedIdentifier(string fieldName, IEncapsulateFieldCandidate candidate, DeclarationType declarationType); - bool TryValidateEncapsulationAttributes(IEncapsulateFieldCandidate field, out string errorMessage); - } - - public abstract class EncapsulateFieldConflictFinderBase : IEncapsulateFieldConflictFinder - { - protected readonly IDeclarationFinderProvider _declarationFinderProvider; - protected List _fieldCandidates { set; get; } = new List(); - protected List _udtMemberCandidates { set; get; } = new List(); - - public EncapsulateFieldConflictFinderBase(IDeclarationFinderProvider declarationFinderProvider, IEnumerable candidates, IEnumerable udtCandidates) - { - _declarationFinderProvider = declarationFinderProvider; - _fieldCandidates.AddRange(candidates); - _udtMemberCandidates.AddRange(udtCandidates); - } - - public virtual bool TryValidateEncapsulationAttributes(IEncapsulateFieldCandidate field, out string errorMessage) - { - errorMessage = string.Empty; - if (!field.EncapsulateFlag) { return true; } - - if (!field.NameValidator.IsValidVBAIdentifier(field.PropertyIdentifier, out errorMessage)) - { - return false; - } - - if (HasConflictingIdentifier(field, DeclarationType.Property, out errorMessage)) - { - return false; - } - - return true; - } - - public bool HasConflictingIdentifier(IEncapsulateFieldCandidate field, DeclarationType declarationType, out string errorMessage) - => InternalHasConflictingIdentifier(field, declarationType, false, out errorMessage); - - public virtual IEncapsulateFieldCandidate AssignNoConflictIdentifiers(IEncapsulateFieldCandidate candidate) - { - candidate = AssignNoConflictIdentifier(candidate, DeclarationType.Property); - if (!(candidate is UserDefinedTypeMemberCandidate)) - { - candidate = AssignNoConflictIdentifier(candidate, DeclarationType.Variable); - } - return candidate; - } - - protected virtual IEncapsulateFieldCandidate AssignNoConflictIdentifier(IEncapsulateFieldCandidate candidate, DeclarationType declarationType) - { - Debug.Assert(declarationType.HasFlag(DeclarationType.Property) - || declarationType.HasFlag(DeclarationType.Variable)); - - var isConflictingIdentifier = HasConflictingIdentifierIgnoreEncapsulationFlag(candidate, declarationType, out _); - var guard = 0; - while (guard++ < 10 && isConflictingIdentifier) - { - var identifier = IdentifierToCompare(candidate, declarationType); - - if (declarationType.HasFlag(DeclarationType.Property)) - { - candidate.PropertyIdentifier = identifier.IncrementEncapsulationIdentifier(); - } - else - { - candidate.BackingIdentifier = identifier.IncrementEncapsulationIdentifier(); - } - isConflictingIdentifier = HasConflictingIdentifierIgnoreEncapsulationFlag(candidate, declarationType, out _); - } - - return candidate; - } - - public bool IsConflictingProposedIdentifier(string fieldName, IEncapsulateFieldCandidate candidate, DeclarationType declarationType) - => PotentialConflictIdentifiers(candidate, declarationType) - .Any(m => m.IsEquivalentVBAIdentifierTo(fieldName)); - - protected abstract IEnumerable FindRelevantMembers(IEncapsulateFieldCandidate candidate); - - protected virtual bool InternalHasConflictingIdentifier(IEncapsulateFieldCandidate field, DeclarationType declarationType, bool ignoreEncapsulationFlags, out string errorMessage) - { - errorMessage = string.Empty; - - var potentialDeclarationIdentifierConflicts = new List(); - potentialDeclarationIdentifierConflicts.AddRange(PotentialConflictIdentifiers(field, declarationType)); - - if (ignoreEncapsulationFlags) - { - potentialDeclarationIdentifierConflicts.AddRange(_fieldCandidates.Where(fc => fc.TargetID != field.TargetID).Select(fc => fc.PropertyIdentifier)); - } - else - { - potentialDeclarationIdentifierConflicts.AddRange(FlaggedCandidates.Where(fc => fc.TargetID != field.TargetID).Select(fc => fc.PropertyIdentifier)); - } - - potentialDeclarationIdentifierConflicts.AddRange(_udtMemberCandidates.Where(udtm => udtm.TargetID != field.TargetID && udtm.EncapsulateFlag).Select(udtm => udtm.PropertyIdentifier)); - - var identifierToCompare = IdentifierToCompare(field, declarationType); - - if (potentialDeclarationIdentifierConflicts.Any(m => m.IsEquivalentVBAIdentifierTo(identifierToCompare))) - { - errorMessage = RubberduckUI.EncapsulateField_NameConflictDetected; - return true; - } - return false; - } - - protected string IdentifierToCompare(IEncapsulateFieldCandidate field, DeclarationType declarationType) - { - return declarationType.HasFlag(DeclarationType.Property) - ? field.PropertyIdentifier - : field.BackingIdentifier; - } - - protected bool HasConflictingIdentifierIgnoreEncapsulationFlag(IEncapsulateFieldCandidate field, DeclarationType declarationType, out string errorMessage) - => InternalHasConflictingIdentifier(field, declarationType, true, out errorMessage); - - //The refactoring only inserts new code elements with the following Accessibilities: - //Variables => Private - //Properties => Public - //UDTs => Private - private bool IsAlwaysIgnoreNameConflictType(Declaration d, DeclarationType toEnapsulateDeclarationType) - { - //5.3.1.6 Each and must have a procedure - //name that is different from any other module variable name, module constant name, - //enum member name, or procedure name that is defined within the same module. - var NeverCauseNameConflictTypes = new List() - { - DeclarationType.Project, - DeclarationType.ProceduralModule, - DeclarationType.ClassModule, - DeclarationType.Parameter, - DeclarationType.EnumerationMember, - DeclarationType.Enumeration, - DeclarationType.UserDefinedType, - DeclarationType.UserDefinedTypeMember - }; - - if (toEnapsulateDeclarationType.HasFlag(DeclarationType.Variable)) - { - //5.2.3.4: An enum member name may not be the same as any variable name - //or constant name that is defined within the same module - NeverCauseNameConflictTypes.Remove(DeclarationType.EnumerationMember); - } - else if (toEnapsulateDeclarationType.HasFlag(DeclarationType.UserDefinedType)) - { - //5.2.3.3 If an is an element of a its - //UDT name cannot be the same as the enum name of any - //or the UDT name of any other within the same - NeverCauseNameConflictTypes.Remove(DeclarationType.UserDefinedType); - NeverCauseNameConflictTypes.Remove(DeclarationType.Enumeration); - } - else if (toEnapsulateDeclarationType.HasFlag(DeclarationType.Property)) - { - //Each < subroutine - declaration > and < function - declaration > must have a - //procedure name that is different from any other module variable name, - //module constant name, enum member name, or procedure name that is defined - //within the same module. - - NeverCauseNameConflictTypes.Remove(DeclarationType.EnumerationMember); - } - return d.IsLocalVariable() - || d.IsLocalConstant() - || NeverCauseNameConflictTypes.Contains(d.DeclarationType); - } - - private List PotentialConflictIdentifiers(IEncapsulateFieldCandidate candidate, DeclarationType declarationType) - { - var members = FindRelevantMembers(candidate); - - var nameConflictCandidates = members - .Where(d => !IsAlwaysIgnoreNameConflictType(d, declarationType)).ToList(); - - var localReferences = candidate.Declaration.References.Where(rf => rf.QualifiedModuleName == candidate.QualifiedModuleName); - - if (localReferences.Any()) - { - foreach (var idRef in localReferences) - { - var locals = members.Except(nameConflictCandidates) - .Where(localDec => localDec.ParentScopeDeclaration.Equals(idRef.ParentScoping)); - - nameConflictCandidates.AddRange(locals); - } - } - return nameConflictCandidates.Select(c => c.IdentifierName).ToList(); - } - - private List FlaggedCandidates - => _fieldCandidates.Where(f => f.EncapsulateFlag).ToList(); - - private bool IsConflictIdentifier(string fieldName, QualifiedModuleName qmn, DeclarationType declarationType) - { - var nameConflictCandidates = _declarationFinderProvider.DeclarationFinder.Members(qmn) - .Where(d => !IsAlwaysIgnoreNameConflictType(d, declarationType)).ToList(); - - return nameConflictCandidates.Any(m => m.IdentifierName.IsEquivalentVBAIdentifierTo(fieldName)); - } - } -} diff --git a/Rubberduck.Refactorings/EncapsulateField/Validations/EncapsulateFieldValidationsProvider.cs b/Rubberduck.Refactorings/EncapsulateField/Validations/EncapsulateFieldValidationsProvider.cs deleted file mode 100644 index 0b755c87ca..0000000000 --- a/Rubberduck.Refactorings/EncapsulateField/Validations/EncapsulateFieldValidationsProvider.cs +++ /dev/null @@ -1,114 +0,0 @@ -using Rubberduck.Parsing.Symbols; -using Rubberduck.Parsing.VBA; -using Rubberduck.Refactorings.Common; -using Rubberduck.Refactorings.EncapsulateField.Extensions; -using Rubberduck.Resources; -using Rubberduck.VBEditor; -using System; -using System.Collections.Generic; -using System.Linq; -using System.Text; -using System.Threading.Tasks; - -namespace Rubberduck.Refactorings.EncapsulateField -{ - public enum NameValidators - { - Default, - UserDefinedType, - UserDefinedTypeMember, - UserDefinedTypeMemberArray - } - - public interface IEncapsulateFieldValidationsProvider - { - IEncapsulateFieldConflictFinder ConflictDetector(EncapsulateFieldStrategy strategy, IDeclarationFinderProvider declarationFinderProvider); - } - - public class EncapsulateFieldValidationsProvider : IEncapsulateFieldValidationsProvider - { - private static Dictionary _nameOnlyValidators = new Dictionary() - { - [NameValidators.Default] = new IdentifierOnlyValidator(DeclarationType.Variable, false), - [NameValidators.UserDefinedType] = new IdentifierOnlyValidator(DeclarationType.UserDefinedType, false), - [NameValidators.UserDefinedTypeMember] = new IdentifierOnlyValidator(DeclarationType.UserDefinedTypeMember, false), - [NameValidators.UserDefinedTypeMemberArray] = new IdentifierOnlyValidator(DeclarationType.UserDefinedTypeMember, true), - }; - - private static DeclarationType[] _udtTypeIdentifierNonConflictTypes = new DeclarationType[] - { - DeclarationType.Project, - DeclarationType.Module, - DeclarationType.Property, - DeclarationType.Function, - DeclarationType.Procedure, - DeclarationType.Variable, - DeclarationType.Constant, - DeclarationType.UserDefinedTypeMember, - DeclarationType.EnumerationMember, - DeclarationType.Parameter - }; - - - private List _candidates; - private List _udtMemberCandidates; - private List _objectStateUDTs; - - public EncapsulateFieldValidationsProvider(IEnumerable candidates, IEnumerable objectStateUDTCandidates) - { - _udtMemberCandidates = new List(); - _objectStateUDTs = objectStateUDTCandidates.ToList(); - _candidates = candidates.ToList(); - var udtCandidates = candidates.Where(c => c is IUserDefinedTypeCandidate).Cast(); - - foreach (var udtCandidate in candidates.Where(c => c is IUserDefinedTypeCandidate).Cast()) - { - LoadUDTMemberCandidates(udtCandidate); - } - } - - private void LoadUDTMemberCandidates(IUserDefinedTypeCandidate udtCandidate) - { - foreach (var member in udtCandidate.Members) - { - if (member.WrappedCandidate is IUserDefinedTypeCandidate udt) - { - LoadUDTMemberCandidates(udt); - } - _udtMemberCandidates.Add(member); - } - } - - public static IValidateVBAIdentifiers NameOnlyValidator(NameValidators validatorType) - => _nameOnlyValidators[validatorType]; - - public static IObjectStateUDT AssignNoConflictIdentifiers(IObjectStateUDT stateUDT, IDeclarationFinderProvider declarationFinderProvider) - { - var members = declarationFinderProvider.DeclarationFinder.Members(stateUDT.QualifiedModuleName); - var guard = 0; - while (guard++ < 10 && members.Any(m => m.IdentifierName.IsEquivalentVBAIdentifierTo(stateUDT.FieldIdentifier))) - { - stateUDT.FieldIdentifier = stateUDT.FieldIdentifier.IncrementEncapsulationIdentifier(); - } - - members = declarationFinderProvider.DeclarationFinder.Members(stateUDT.QualifiedModuleName) - .Where(m => !_udtTypeIdentifierNonConflictTypes.Any(nct => m.DeclarationType.HasFlag(nct))); - - guard = 0; - while (guard++ < 10 && members.Any(m => m.IdentifierName.IsEquivalentVBAIdentifierTo(stateUDT.TypeIdentifier))) - { - stateUDT.TypeIdentifier = stateUDT.TypeIdentifier.IncrementEncapsulationIdentifier(); - } - return stateUDT; - } - - public IEncapsulateFieldConflictFinder ConflictDetector(EncapsulateFieldStrategy strategy, IDeclarationFinderProvider declarationFinderProvider) - { - if (strategy == EncapsulateFieldStrategy.UseBackingFields) - { - return new UseBackingFieldsStrategyConflictFinder(declarationFinderProvider, _candidates, _udtMemberCandidates); - } - return new ConvertFieldsToUDTMembersStrategyConflictFinder(declarationFinderProvider, _candidates, _udtMemberCandidates, _objectStateUDTs); - } - } -} diff --git a/Rubberduck.Refactorings/EncapsulateField/Validations/IdentifierOnlyValidator.cs b/Rubberduck.Refactorings/EncapsulateField/Validations/IdentifierOnlyValidator.cs deleted file mode 100644 index 781fd33cc2..0000000000 --- a/Rubberduck.Refactorings/EncapsulateField/Validations/IdentifierOnlyValidator.cs +++ /dev/null @@ -1,29 +0,0 @@ -using Rubberduck.Parsing.Symbols; -using Rubberduck.Refactorings.Common; -using System; -using System.Collections.Generic; -using System.Linq; -using System.Text; -using System.Threading.Tasks; - -namespace Rubberduck.Refactorings.EncapsulateField -{ - public interface IValidateVBAIdentifiers - { - bool IsValidVBAIdentifier(string identifier, out string errorMessage); - } - - public class IdentifierOnlyValidator : IValidateVBAIdentifiers - { - private DeclarationType _declarationType; - private bool _isArray; - public IdentifierOnlyValidator(DeclarationType declarationType, bool isArray = false) - { - _declarationType = declarationType; - _isArray = isArray; - } - - public bool IsValidVBAIdentifier(string identifier, out string errorMessage) - => !VBAIdentifierValidator.TryMatchInvalidIdentifierCriteria(identifier, _declarationType, out errorMessage, _isArray); - } -} diff --git a/Rubberduck.Refactorings/EncapsulateField/Validations/UseBackingFieldsStrategyConflictFinder.cs b/Rubberduck.Refactorings/EncapsulateField/Validations/UseBackingFieldsStrategyConflictFinder.cs deleted file mode 100644 index e324c401ca..0000000000 --- a/Rubberduck.Refactorings/EncapsulateField/Validations/UseBackingFieldsStrategyConflictFinder.cs +++ /dev/null @@ -1,20 +0,0 @@ -using Rubberduck.Parsing.Symbols; -using Rubberduck.Parsing.VBA; -using System; -using System.Collections.Generic; -using System.Linq; -using System.Text; -using System.Threading.Tasks; - -namespace Rubberduck.Refactorings.EncapsulateField -{ - public class UseBackingFieldsStrategyConflictFinder : EncapsulateFieldConflictFinderBase - { - public UseBackingFieldsStrategyConflictFinder(IDeclarationFinderProvider declarationFinderProvider, IEnumerable candidates, IEnumerable udtCandidates) - : base(declarationFinderProvider, candidates, udtCandidates) { } - - protected override IEnumerable FindRelevantMembers(IEncapsulateFieldCandidate candidate) - => _declarationFinderProvider.DeclarationFinder.Members(candidate.QualifiedModuleName) - .Where(d => d != candidate.Declaration); - } -} diff --git a/Rubberduck.Refactorings/ImplementInterface/AddInterfaceImplementations/AddInterfaceImplementationsRefactoringAction.cs b/Rubberduck.Refactorings/ImplementInterface/AddInterfaceImplementations/AddInterfaceImplementationsRefactoringAction.cs index 0c3091b84a..ac7de29e44 100644 --- a/Rubberduck.Refactorings/ImplementInterface/AddInterfaceImplementations/AddInterfaceImplementationsRefactoringAction.cs +++ b/Rubberduck.Refactorings/ImplementInterface/AddInterfaceImplementations/AddInterfaceImplementationsRefactoringAction.cs @@ -4,7 +4,7 @@ using Rubberduck.Parsing.Grammar; using Rubberduck.Parsing.Rewriter; using Rubberduck.Parsing.Symbols; - +using Rubberduck.Resources; namespace Rubberduck.Refactorings.AddInterfaceImplementations { @@ -38,12 +38,12 @@ private string GetInterfaceMember(Declaration member, string interfaceName) { if (member is ModuleBodyElementDeclaration mbed) { - return _codeBuilder.BuildMemberBlockFromPrototype(mbed, accessibility: Tokens.Private, newIdentifier: $"{interfaceName}_{member.IdentifierName}", content: _memberBody); + return _codeBuilder.BuildMemberBlockFromPrototype(mbed, accessibility: Accessibility.Private, newIdentifier: $"{interfaceName}_{member.IdentifierName}", content: _memberBody); } if (member is VariableDeclaration variable) { - if (!_codeBuilder.TryBuildPropertyGetCodeBlock(variable, $"{interfaceName}_{variable.IdentifierName}", out var propertyGet, Tokens.Private, _memberBody)) + if (!_codeBuilder.TryBuildPropertyGetCodeBlock(variable, $"{interfaceName}_{variable.IdentifierName}", out var propertyGet, Accessibility.Private, _memberBody)) { throw new InvalidOperationException(); } @@ -52,7 +52,7 @@ private string GetInterfaceMember(Declaration member, string interfaceName) if (variable.AsTypeName.Equals(Tokens.Variant) || !variable.IsObject) { - if (!_codeBuilder.TryBuildPropertyLetCodeBlock(variable, $"{interfaceName}_{variable.IdentifierName}", out var propertyLet, Tokens.Private, _memberBody)) + if (!_codeBuilder.TryBuildPropertyLetCodeBlock(variable, $"{interfaceName}_{variable.IdentifierName}", out var propertyLet, Accessibility.Private, _memberBody)) { throw new InvalidOperationException(); } @@ -61,14 +61,14 @@ private string GetInterfaceMember(Declaration member, string interfaceName) if (variable.AsTypeName.Equals(Tokens.Variant) || variable.IsObject) { - if (!_codeBuilder.TryBuildPropertySetCodeBlock(variable, $"{interfaceName}_{variable.IdentifierName}", out var propertySet, Tokens.Private, _memberBody)) + if (!_codeBuilder.TryBuildPropertySetCodeBlock(variable, $"{interfaceName}_{variable.IdentifierName}", out var propertySet, Accessibility.Private, _memberBody)) { throw new InvalidOperationException(); } members.Add(propertySet); } - return string.Join($"{Environment.NewLine}{Environment.NewLine}", members); + return string.Join($"{NewLines.DOUBLE_SPACE}", members); } return string.Empty; diff --git a/Rubberduck.Refactorings/ModifyUserDefinedType/ModifyUserDefinedTypeModel.cs b/Rubberduck.Refactorings/ModifyUserDefinedType/ModifyUserDefinedTypeModel.cs new file mode 100644 index 0000000000..bd42405a89 --- /dev/null +++ b/Rubberduck.Refactorings/ModifyUserDefinedType/ModifyUserDefinedTypeModel.cs @@ -0,0 +1,60 @@ +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Symbols; +using System; +using System.Collections.Generic; + +namespace Rubberduck.Refactorings.ModifyUserDefinedType +{ + public class ModifyUserDefinedTypeModel : IRefactoringModel + { + private List<(Declaration, string)> _newMembers; + private List _membersToRemove; + + public ModifyUserDefinedTypeModel(Declaration target) + { + if (!target.DeclarationType.HasFlag(DeclarationType.UserDefinedType)) + { + throw new ArgumentException(); + } + + Target = target; + _newMembers = new List<(Declaration, string)>(); + _membersToRemove = new List(); + InsertionIndex = (Target.Context as VBAParser.UdtDeclarationContext).END_TYPE().Symbol.TokenIndex - 1; + } + + public Declaration Target { get; } + + public int InsertionIndex { get; } + + public void AddNewMemberPrototype(Declaration prototype, string memberIdentifier) + { + if (!IsValidPrototypeDeclarationType(prototype.DeclarationType)) + { + throw new ArgumentException("Invalid prototype DeclarationType"); + } + _newMembers.Add((prototype, memberIdentifier)); + } + + public void RemoveMember(Declaration member) + { + if (!member.DeclarationType.HasFlag(DeclarationType.UserDefinedTypeMember)) + { + throw new ArgumentException(); + } + _membersToRemove.Add(member); + } + + public IEnumerable<(Declaration, string)> MembersToAdd => _newMembers; + + public IEnumerable MembersToRemove => _membersToRemove; + + private static bool IsValidPrototypeDeclarationType(DeclarationType declarationType) + { + return declarationType.HasFlag(DeclarationType.Variable) + || declarationType.HasFlag(DeclarationType.UserDefinedTypeMember) + || declarationType.HasFlag(DeclarationType.Constant) + || declarationType.HasFlag(DeclarationType.Function); + } + } +} diff --git a/Rubberduck.Refactorings/ModifyUserDefinedType/ModifyUserDefinedTypeRefactoringAction.cs b/Rubberduck.Refactorings/ModifyUserDefinedType/ModifyUserDefinedTypeRefactoringAction.cs new file mode 100644 index 0000000000..881d227fc2 --- /dev/null +++ b/Rubberduck.Refactorings/ModifyUserDefinedType/ModifyUserDefinedTypeRefactoringAction.cs @@ -0,0 +1,62 @@ +using Rubberduck.Parsing; +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.SmartIndenter; +using System; +using System.Collections.Generic; +using System.Linq; + +namespace Rubberduck.Refactorings.ModifyUserDefinedType +{ + public class ModifyUserDefinedTypeRefactoringAction : CodeOnlyRefactoringActionBase + { + private readonly IDeclarationFinderProvider _declarationFinderProvider; + private readonly IRewritingManager _rewritingManager; + private readonly ICodeBuilder _codeBuilder; + + /// + /// Removes or adds UserDefinedTypeMember declarations to an existing UserDefinedType. + /// Adding a UDTMember is based on a Declaration prototype (typically a variable declaration but can a UserDefinedTypeMember, Constant, or Function). + /// + /// + /// The refactoring actions does not modify the prototype declaration or its references. + /// The refactoring actions does not modify references for removed UDTMembers. + /// The refactoring action does not provide any identifier validation or conflictAnalysis + /// + public ModifyUserDefinedTypeRefactoringAction(IDeclarationFinderProvider declarationFinderProvider, IRewritingManager rewritingManager, ICodeBuilder codeBuilder) + :base(rewritingManager) + { + _declarationFinderProvider = declarationFinderProvider; + _rewritingManager = rewritingManager; + _codeBuilder = codeBuilder; + } + + public override void Refactor(ModifyUserDefinedTypeModel model, IRewriteSession rewriteSession) + { + var newMembers = new List(); + foreach ((Declaration Prototype, string Identifier) in model.MembersToAdd) + { + _codeBuilder.TryBuildUDTMemberDeclaration(Prototype, Identifier, out var udtMemberDeclaration); + newMembers.Add(udtMemberDeclaration); + } + + var scratchPad = _rewritingManager.CheckOutCodePaneSession().CheckOutModuleRewriter(model.Target.QualifiedModuleName); + scratchPad.InsertBefore(model.InsertionIndex, $"{Environment.NewLine}{string.Join(Environment.NewLine, newMembers)}"); + + foreach (var member in model.MembersToRemove) + { + scratchPad.Remove(member); + } + + var udtDeclarationContext = model.Target.Context as VBAParser.UdtDeclarationContext; + var newBlock = scratchPad.GetText(udtDeclarationContext.Start.TokenIndex, udtDeclarationContext.Stop.TokenIndex); + var udtLines = newBlock.Split(new string[] { Environment.NewLine }, StringSplitOptions.None) + .Where(ul => !string.IsNullOrEmpty(ul.Trim())); + + var rewriter = rewriteSession.CheckOutModuleRewriter(model.Target.QualifiedModuleName); + rewriter.Replace(udtDeclarationContext, string.Join(Environment.NewLine, _codeBuilder.Indenter.Indent(udtLines))); + } + } +} diff --git a/Rubberduck.Refactorings/ReplaceDeclarationIdentifier/ReplaceDeclarationIdentifierModel.cs b/Rubberduck.Refactorings/ReplaceDeclarationIdentifier/ReplaceDeclarationIdentifierModel.cs new file mode 100644 index 0000000000..ebc92cd069 --- /dev/null +++ b/Rubberduck.Refactorings/ReplaceDeclarationIdentifier/ReplaceDeclarationIdentifierModel.cs @@ -0,0 +1,24 @@ +using Rubberduck.Parsing.Symbols; +using System.Collections.Generic; +using System.Linq; + +namespace Rubberduck.Refactorings.ReplaceDeclarationIdentifier +{ + public class ReplaceDeclarationIdentifierModel : IRefactoringModel + { + private List<(Declaration, string)> _targetNewNamePairs; + + public ReplaceDeclarationIdentifierModel(Declaration target, string newName) + : this((target, newName)) { } + + public ReplaceDeclarationIdentifierModel(params (Declaration, string)[] targetNewNamePairs) + : this(targetNewNamePairs.ToList()) { } + + public ReplaceDeclarationIdentifierModel(IEnumerable<(Declaration, string)> targetNewNamePairs) + { + _targetNewNamePairs = targetNewNamePairs.ToList(); + } + + public IReadOnlyCollection<(Declaration, string)> TargetNewNamePairs => _targetNewNamePairs; + } +} diff --git a/Rubberduck.Refactorings/ReplaceDeclarationIdentifier/ReplaceDeclarationIdentifierRefactoringAction.cs b/Rubberduck.Refactorings/ReplaceDeclarationIdentifier/ReplaceDeclarationIdentifierRefactoringAction.cs new file mode 100644 index 0000000000..d8b6f0c056 --- /dev/null +++ b/Rubberduck.Refactorings/ReplaceDeclarationIdentifier/ReplaceDeclarationIdentifierRefactoringAction.cs @@ -0,0 +1,29 @@ +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.Symbols; + +namespace Rubberduck.Refactorings.ReplaceDeclarationIdentifier +{ + /// + /// Supports Renaming a Declaration independent of its IdentifierReferences. + /// To replace Declarations and its IdentifierReferences in a single call use RenameRefactoringAction + /// + public class ReplaceDeclarationIdentifierRefactoringAction : CodeOnlyRefactoringActionBase + { + public ReplaceDeclarationIdentifierRefactoringAction(IRewritingManager rewritingManager) + : base(rewritingManager) { } + + public override void Refactor(ReplaceDeclarationIdentifierModel model, IRewriteSession rewriteSession) + { + foreach ((Declaration target, string Name) in model.TargetNewNamePairs) + { + var rewriter = rewriteSession.CheckOutModuleRewriter(target.QualifiedName.QualifiedModuleName); + + if (target.Context is IIdentifierContext context) + { + rewriter.Replace(context.IdentifierTokens, Name); + } + } + } + } +} diff --git a/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/PrivateUDTMemberReferenceReplacementExpressions.cs b/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/PrivateUDTMemberReferenceReplacementExpressions.cs new file mode 100644 index 0000000000..8dc33094fd --- /dev/null +++ b/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/PrivateUDTMemberReferenceReplacementExpressions.cs @@ -0,0 +1,21 @@ + +namespace Rubberduck.Refactorings.ReplacePrivateUDTMemberReferences +{ + public struct PrivateUDTMemberReferenceReplacementExpressions + { + public PrivateUDTMemberReferenceReplacementExpressions(string memberAccessExpression) + { + MemberAccesExpression = memberAccessExpression; + _localReferenceExpression = memberAccessExpression; + } + + public string MemberAccesExpression { set; get; } + + private string _localReferenceExpression; + public string LocalReferenceExpression + { + set => _localReferenceExpression = value; + get => _localReferenceExpression ?? MemberAccesExpression; + } + } +} diff --git a/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/ReplacePrivateUDTMemberReferencesModel.cs b/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/ReplacePrivateUDTMemberReferencesModel.cs new file mode 100644 index 0000000000..a07cfd0d47 --- /dev/null +++ b/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/ReplacePrivateUDTMemberReferencesModel.cs @@ -0,0 +1,42 @@ +using Rubberduck.Parsing.Symbols; +using System.Collections.Generic; +using System.Linq; + +namespace Rubberduck.Refactorings.ReplacePrivateUDTMemberReferences +{ + public class ReplacePrivateUDTMemberReferencesModel : IRefactoringModel + { + private Dictionary<(VariableDeclaration, Declaration), PrivateUDTMemberReferenceReplacementExpressions> _udtTargets + = new Dictionary<(VariableDeclaration, Declaration), PrivateUDTMemberReferenceReplacementExpressions>(); + + private Dictionary _fieldToUserDefinedTypeInstance; + + public ReplacePrivateUDTMemberReferencesModel(Dictionary fieldToUserDefinedTypeInstance, IEnumerable userDefinedTypeMembers) + { + _fieldToUserDefinedTypeInstance = fieldToUserDefinedTypeInstance; + _udtMembers = userDefinedTypeMembers.ToList(); + } + + public IReadOnlyCollection Targets => _fieldToUserDefinedTypeInstance.Keys; + + private List _udtMembers; + public IReadOnlyCollection UDTMembers => _udtMembers; + + public UserDefinedTypeInstance UserDefinedTypeInstance(VariableDeclaration field) + => _fieldToUserDefinedTypeInstance[field]; + + public void AssignUDTMemberReferenceExpressions(VariableDeclaration field, Declaration udtMember, PrivateUDTMemberReferenceReplacementExpressions expressions) + { + _udtTargets.Add((field,udtMember), expressions); + } + + public (bool HasValue, string Expression) LocalReferenceExpression(VariableDeclaration field, Declaration udtMember) + { + if (_udtTargets.TryGetValue((field, udtMember), out var result)) + { + return (true, result.LocalReferenceExpression); + } + return (false, null); + } + } +} diff --git a/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/ReplacePrivateUDTMemberReferencesModelFactory.cs b/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/ReplacePrivateUDTMemberReferencesModelFactory.cs new file mode 100644 index 0000000000..67bbde6014 --- /dev/null +++ b/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/ReplacePrivateUDTMemberReferencesModelFactory.cs @@ -0,0 +1,44 @@ +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings.ReplacePrivateUDTMemberReferences; +using System.Collections.Generic; +using System.Linq; + +namespace Rubberduck.Refactorings +{ + public interface IReplacePrivateUDTMemberReferencesModelFactory + { + ReplacePrivateUDTMemberReferencesModel Create(IEnumerable targets ); + } + + public class ReplacePrivateUDTMemberReferencesModelFactory : IReplacePrivateUDTMemberReferencesModelFactory + { + private readonly IDeclarationFinderProvider _declarationFinderProvider; + public ReplacePrivateUDTMemberReferencesModelFactory(IDeclarationFinderProvider declarationFinderProvider) + { + _declarationFinderProvider = declarationFinderProvider; + } + + public ReplacePrivateUDTMemberReferencesModel Create(IEnumerable targets) + { + var allUDTMembers = new List(); + var fieldsToUDTMembers = new Dictionary>(); + foreach (var target in targets) + { + var udtMembers = _declarationFinderProvider.DeclarationFinder.UserDeclarations(DeclarationType.UserDefinedTypeMember) + .Where(udtm => udtm.ParentDeclaration == target.AsTypeDeclaration); + + allUDTMembers.AddRange(udtMembers); + fieldsToUDTMembers.Add(target as VariableDeclaration, udtMembers); + } + + var fieldToUDTInstance = new Dictionary(); + foreach (var fieldToUDTMembers in fieldsToUDTMembers) + { + fieldToUDTInstance.Add(fieldToUDTMembers.Key, new UserDefinedTypeInstance(fieldToUDTMembers.Key, fieldToUDTMembers.Value)); + } + + return new ReplacePrivateUDTMemberReferencesModel(fieldToUDTInstance, allUDTMembers.Distinct()); + } + } +} diff --git a/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/ReplacePrivateUDTMemberReferencesRefactoringAction.cs b/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/ReplacePrivateUDTMemberReferencesRefactoringAction.cs new file mode 100644 index 0000000000..9a01651945 --- /dev/null +++ b/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/ReplacePrivateUDTMemberReferencesRefactoringAction.cs @@ -0,0 +1,97 @@ +using Antlr4.Runtime; +using Rubberduck.Parsing; +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.Symbols; +using System.Collections.Generic; +using System.Linq; + +namespace Rubberduck.Refactorings.ReplacePrivateUDTMemberReferences +{ + /// + /// Replaces UserDefinedTypeMember IdentifierReferences of a Private UserDefinedType + /// with a Property IdentifierReference. + /// + public class ReplacePrivateUDTMemberReferencesRefactoringAction : CodeOnlyRefactoringActionBase + { + private Dictionary IdentifierReplacements { get; } = new Dictionary(); + + public ReplacePrivateUDTMemberReferencesRefactoringAction(IRewritingManager rewritingManager) + : base(rewritingManager) + { } + + public override void Refactor(ReplacePrivateUDTMemberReferencesModel model, IRewriteSession rewriteSession) + { + if (!(model.UDTMembers?.Any() ?? false)) + { + return; + } + + foreach (var target in model.Targets) + { + SetRewriteContent(target, model); + } + + RewriteReferences(rewriteSession); + } + + private void SetRewriteContent(VariableDeclaration target, ReplacePrivateUDTMemberReferencesModel model) + { + var udtInstance = model.UserDefinedTypeInstance(target); + foreach (var idRef in udtInstance.UDTMemberReferences) + { + var internalExpression = model.LocalReferenceExpression(target, idRef.Declaration); + if (internalExpression.HasValue) + { + SetUDTMemberReferenceRewriteContent(target, idRef, internalExpression.Expression); + } + } + } + + private void SetUDTMemberReferenceRewriteContent(VariableDeclaration instanceField, IdentifierReference idRef, string replacementText, bool moduleQualify = false) + { + if (idRef.Context.TryGetAncestor(out var maec)) + { + if (maec.TryGetChildContext(out var childMaec)) + { + if (childMaec.TryGetChildContext(out var smp)) + { + AddIdentifierReplacement(idRef, maec, $"{smp.GetText()}.{replacementText}"); + } + } + else if (maec.TryGetChildContext(out var wm)) + { + AddIdentifierReplacement(idRef, maec, $".{replacementText}"); + } + else + { + AddIdentifierReplacement(idRef, maec, replacementText); + } + } + else if (idRef.Context.TryGetAncestor(out var wmac)) + { + AddIdentifierReplacement(idRef, wmac, replacementText); + } + } + + private void AddIdentifierReplacement(IdentifierReference idRef, ParserRuleContext context, string replacementText) + { + if (IdentifierReplacements.ContainsKey(idRef)) + { + IdentifierReplacements[idRef] = (context, replacementText); + return; + } + IdentifierReplacements.Add(idRef, (context, replacementText)); + } + + private void RewriteReferences(IRewriteSession rewriteSession) + { + foreach (var replacement in IdentifierReplacements) + { + (ParserRuleContext Context, string Text) = replacement.Value; + var rewriter = rewriteSession.CheckOutModuleRewriter(replacement.Key.QualifiedModuleName); + rewriter.Replace(Context, Text); + } + } + } +} diff --git a/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/UserDefinedTypeInstance.cs b/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/UserDefinedTypeInstance.cs new file mode 100644 index 0000000000..6b38782dca --- /dev/null +++ b/Rubberduck.Refactorings/ReplacePrivateUDTMemberReferences/UserDefinedTypeInstance.cs @@ -0,0 +1,69 @@ +using Antlr4.Runtime; +using Rubberduck.Parsing; +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Symbols; +using System; +using System.Collections.Generic; +using System.Diagnostics; +using System.Linq; + +namespace Rubberduck.Refactorings.ReplacePrivateUDTMemberReferences +{ + public class UserDefinedTypeInstance + { + public UserDefinedTypeInstance(VariableDeclaration field, IEnumerable udtMembers) + { + if (!(field.AsTypeDeclaration?.DeclarationType.HasFlag(DeclarationType.UserDefinedType) ?? false)) + { + throw new ArgumentException(); + } + + InstanceField = field; + _udtMemberReferences = udtMembers.SelectMany(m => m.References) + .Where(rf => IsRelatedReference(rf, InstanceField.References)).ToList(); + } + + public VariableDeclaration InstanceField { get; } + + public string UserDefinedTypeIdentifier => InstanceField.AsTypeDeclaration.IdentifierName; + + private List _udtMemberReferences; + public IReadOnlyCollection UDTMemberReferences => _udtMemberReferences; + + private bool IsRelatedReference(IdentifierReference idRef, IEnumerable fieldReferences) + { + if (idRef.Context.TryGetAncestor(out var wmac)) + { + var goalContext = wmac.GetAncestor(); + return fieldReferences.Any(rf => HasSameAncestor(rf, goalContext)); + } + else if (idRef.Context.TryGetAncestor(out var memberAccessExprContext)) + { + return fieldReferences.Any(rf => HasSameAncestor(rf, memberAccessExprContext)); + } + throw new ArgumentOutOfRangeException(); + } + + private bool HasSameAncestor(IdentifierReference idRef, ParserRuleContext goalContext) where T : ParserRuleContext + { + Debug.Assert(goalContext != null); + Debug.Assert(goalContext is VBAParser.MemberAccessExprContext || goalContext is VBAParser.WithStmtContext); + + const int maxGetAncestorAttempts = 100; + var guard = 0; + var accessExprContext = idRef.Context.GetAncestor(); + while (accessExprContext != null && ++guard < maxGetAncestorAttempts) + { + var prCtxt = accessExprContext as ParserRuleContext; + if (prCtxt == goalContext) + { + return true; + } + accessExprContext = accessExprContext.GetAncestor(); + } + + Debug.Assert(guard < maxGetAncestorAttempts); + return false; + } + } +} diff --git a/Rubberduck.Refactorings/ReplaceReferences/ReplaceReferencesModel.cs b/Rubberduck.Refactorings/ReplaceReferences/ReplaceReferencesModel.cs new file mode 100644 index 0000000000..999cfb2bc1 --- /dev/null +++ b/Rubberduck.Refactorings/ReplaceReferences/ReplaceReferencesModel.cs @@ -0,0 +1,27 @@ +using Rubberduck.Parsing.Symbols; +using System.Collections.Generic; +using System.Linq; + +namespace Rubberduck.Refactorings.ReplaceReferences +{ + public class ReplaceReferencesModel :IRefactoringModel + { + public ReplaceReferencesModel() + {} + private Dictionary _fieldTargets = new Dictionary(); + + public bool ModuleQualifyExternalReferences { set; get; } = false; + + public void AssignReferenceReplacementExpression(IdentifierReference fieldReference, string replacementIdentifier) + { + if (_fieldTargets.ContainsKey(fieldReference)) + { + _fieldTargets[fieldReference] = replacementIdentifier; + return; + } + _fieldTargets.Add(fieldReference, replacementIdentifier); + } + public IReadOnlyCollection<(IdentifierReference IdentifierReference, string NewName)> ReferenceReplacementPairs + => _fieldTargets.Select(t => (t.Key, t.Value)).ToList(); + } +} diff --git a/Rubberduck.Refactorings/ReplaceReferences/ReplaceReferencesRefactoringAction.cs b/Rubberduck.Refactorings/ReplaceReferences/ReplaceReferencesRefactoringAction.cs new file mode 100644 index 0000000000..74b3f4cb18 --- /dev/null +++ b/Rubberduck.Refactorings/ReplaceReferences/ReplaceReferencesRefactoringAction.cs @@ -0,0 +1,63 @@ +using System.Linq; +using Antlr4.Runtime; +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.Symbols; + +namespace Rubberduck.Refactorings.ReplaceReferences +{ + /// + /// Supports Renaming an IdentifierReference independent of its Declaration. + /// To replace Declarations and its IdentifierReferences in a single call use RenameRefactoringAction + /// + public class ReplaceReferencesRefactoringAction : CodeOnlyRefactoringActionBase + { + public ReplaceReferencesRefactoringAction(IRewritingManager rewritingManager) + : base(rewritingManager) + { } + + public override void Refactor(ReplaceReferencesModel model, IRewriteSession rewriteSession) + { + var replacementPairByQualifiedModuleName = model.ReferenceReplacementPairs + .Where(pr => + pr.IdentifierReference.Context.GetText() != Tokens.Me + && !pr.IdentifierReference.IsArrayAccess + && !pr.IdentifierReference.IsDefaultMemberAccess) + .GroupBy(r => r.IdentifierReference.QualifiedModuleName); + + foreach (var replacements in replacementPairByQualifiedModuleName) + { + var rewriter = rewriteSession.CheckOutModuleRewriter(replacements.Key); + foreach ((IdentifierReference identifierReference, string newIdentifier) in replacements) + { + (ParserRuleContext context, string replacementName) = BuildReferenceReplacementString(identifierReference, newIdentifier, model.ModuleQualifyExternalReferences); + rewriter.Replace(context, replacementName); + } + } + } + + private (ParserRuleContext context, string replacementName) BuildReferenceReplacementString(IdentifierReference identifierReference, string NewName, bool moduleQualify) + { + var replacementExpression = moduleQualify && CanBeModuleQualified(identifierReference) + ? $"{identifierReference.Declaration.QualifiedModuleName.ComponentName}.{NewName}" + : NewName; + + return (identifierReference.Context, replacementExpression); + } + + private static bool CanBeModuleQualified(IdentifierReference idRef) + { + if (idRef.QualifiedModuleName == idRef.Declaration.QualifiedModuleName) + { + return false; + } + + var isLHSOfMemberAccess = + (idRef.Context.Parent is VBAParser.MemberAccessExprContext + || idRef.Context.Parent is VBAParser.WithMemberAccessExprContext) + && !(idRef.Context == idRef.Context.Parent.GetChild(0)); + + return !isLHSOfMemberAccess; + } + } +} diff --git a/Rubberduck.Resources/Inspections/InspectionInfo.Designer.cs b/Rubberduck.Resources/Inspections/InspectionInfo.Designer.cs index 5456788d54..45f128e1be 100644 --- a/Rubberduck.Resources/Inspections/InspectionInfo.Designer.cs +++ b/Rubberduck.Resources/Inspections/InspectionInfo.Designer.cs @@ -19,7 +19,7 @@ namespace Rubberduck.Resources.Inspections { // class via a tool like ResGen or Visual Studio. // To add or remove a member, edit your .ResX file then rerun ResGen // with the /str option, or rebuild your VS project. - [global::System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "16.0.0.0")] + [global::System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "15.0.0.0")] [global::System.Diagnostics.DebuggerNonUserCodeAttribute()] [global::System.Runtime.CompilerServices.CompilerGeneratedAttribute()] public class InspectionInfo { @@ -501,6 +501,15 @@ public class InspectionInfo { } } + /// + /// Looks up a localized string similar to The last parameter (the 'Value' parameter) of property mutators are always passed ByVal. This is true regardless of the presence or absence of a ByRef or ByVal modifier. Exception: A UserDefinedType must always be passed ByRef even when it is the last parameter of a property mutator.. + /// + public static string MisleadingByRefParameterInspection { + get { + return ResourceManager.GetString("MisleadingByRefParameterInspection", resourceCulture); + } + } + /// /// Looks up a localized string similar to An annotation parameter is missing or incorrectly specified. The correct syntax is : '@Annotation([parameter])\nExample: '@Folder("Parent.Child"). /// diff --git a/Rubberduck.Resources/Inspections/InspectionInfo.resx b/Rubberduck.Resources/Inspections/InspectionInfo.resx index 48142a3ca8..92f1fccf27 100644 --- a/Rubberduck.Resources/Inspections/InspectionInfo.resx +++ b/Rubberduck.Resources/Inspections/InspectionInfo.resx @@ -442,4 +442,7 @@ If the parameter can be null, ignore this inspection result; passing a null valu An annotation has more arguments than allowed; superfluous arguments are ignored. + + The last parameter (the 'Value' parameter) of property mutators are always passed ByVal. This is true regardless of the presence or absence of a ByRef or ByVal modifier. Exception: A UserDefinedType must always be passed ByRef even when it is the last parameter of a property mutator. + \ No newline at end of file diff --git a/Rubberduck.Resources/Inspections/InspectionNames.Designer.cs b/Rubberduck.Resources/Inspections/InspectionNames.Designer.cs index e5f58a3536..2e53ac723b 100644 --- a/Rubberduck.Resources/Inspections/InspectionNames.Designer.cs +++ b/Rubberduck.Resources/Inspections/InspectionNames.Designer.cs @@ -19,7 +19,7 @@ namespace Rubberduck.Resources.Inspections { // class via a tool like ResGen or Visual Studio. // To add or remove a member, edit your .ResX file then rerun ResGen // with the /str option, or rebuild your VS project. - [global::System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "16.0.0.0")] + [global::System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "15.0.0.0")] [global::System.Diagnostics.DebuggerNonUserCodeAttribute()] [global::System.Runtime.CompilerServices.CompilerGeneratedAttribute()] public class InspectionNames { @@ -501,6 +501,15 @@ public class InspectionNames { } } + /// + /// Looks up a localized string similar to Misleading ByRef parameter modifier. + /// + public static string MisleadingByRefParameterInspection { + get { + return ResourceManager.GetString("MisleadingByRefParameterInspection", resourceCulture); + } + } + /// /// Looks up a localized string similar to Missing annotation parameter. /// diff --git a/Rubberduck.Resources/Inspections/InspectionNames.resx b/Rubberduck.Resources/Inspections/InspectionNames.resx index 2b7f7de244..b30dde4f45 100644 --- a/Rubberduck.Resources/Inspections/InspectionNames.resx +++ b/Rubberduck.Resources/Inspections/InspectionNames.resx @@ -362,19 +362,15 @@ Keyword used as member name - Line continuation between keywords - Identifier containing a non-breaking space - Negative line number - OnErrorGoto -1 @@ -446,4 +442,7 @@ Superfluous annotation arguments + + Misleading ByRef parameter modifier + \ No newline at end of file diff --git a/Rubberduck.Resources/Inspections/InspectionResults.Designer.cs b/Rubberduck.Resources/Inspections/InspectionResults.Designer.cs index 00e2338b40..37adbe331b 100644 --- a/Rubberduck.Resources/Inspections/InspectionResults.Designer.cs +++ b/Rubberduck.Resources/Inspections/InspectionResults.Designer.cs @@ -19,7 +19,7 @@ namespace Rubberduck.Resources.Inspections { // class via a tool like ResGen or Visual Studio. // To add or remove a member, edit your .ResX file then rerun ResGen // with the /str option, or rebuild your VS project. - [global::System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "16.0.0.0")] + [global::System.CodeDom.Compiler.GeneratedCodeAttribute("System.Resources.Tools.StronglyTypedResourceBuilder", "15.0.0.0")] [global::System.Diagnostics.DebuggerNonUserCodeAttribute()] [global::System.Runtime.CompilerServices.CompilerGeneratedAttribute()] public class InspectionResults { @@ -519,6 +519,15 @@ public class InspectionResults { } } + /// + /// Looks up a localized string similar to Misleading ByRef modifier used for parameter '{0}' ({1}).. + /// + public static string MisleadingByRefParameterInspection { + get { + return ResourceManager.GetString("MisleadingByRefParameterInspection", resourceCulture); + } + } + /// /// Looks up a localized string similar to The annotation '{0}' was expected to have more arguments.. /// diff --git a/Rubberduck.Resources/Inspections/InspectionResults.resx b/Rubberduck.Resources/Inspections/InspectionResults.resx index aa86d062a7..d09e3f88ee 100644 --- a/Rubberduck.Resources/Inspections/InspectionResults.resx +++ b/Rubberduck.Resources/Inspections/InspectionResults.resx @@ -513,4 +513,8 @@ In memoriam, 1972-2018 The annotation '{0}' was expected to have less arguments. {0} annotation name + + Misleading ByRef modifier used for parameter '{0}' ({1}). + {0} Parameter, {1} Member + \ No newline at end of file diff --git a/Rubberduck.Resources/NewLines.cs b/Rubberduck.Resources/NewLines.cs new file mode 100644 index 0000000000..66a002d42b --- /dev/null +++ b/Rubberduck.Resources/NewLines.cs @@ -0,0 +1,9 @@ +using System; + +namespace Rubberduck.Resources +{ + public static class NewLines + { + public static readonly string DOUBLE_SPACE = $"{Environment.NewLine}{Environment.NewLine}"; + } +} diff --git a/RubberduckTests/CodeBuilderTests.cs b/RubberduckTests/CodeBuilderTests.cs index 0fcb092817..e91af28627 100644 --- a/RubberduckTests/CodeBuilderTests.cs +++ b/RubberduckTests/CodeBuilderTests.cs @@ -1,8 +1,12 @@ using NUnit.Framework; +using Rubberduck.Common; using Rubberduck.Parsing.Symbols; using Rubberduck.Refactorings; +using Rubberduck.SmartIndenter; using RubberduckTests.Mocks; +using RubberduckTests.Settings; using System; +using System.Collections.Generic; using System.Linq; namespace RubberduckTests @@ -11,6 +15,7 @@ namespace RubberduckTests public class CodeBuilderTests { private static string _rhsIdentifier = Rubberduck.Resources.Refactorings.Refactorings.CodeBuilder_DefaultPropertyRHSParam; + private static string _defaultUDTIdentifier = "TestUDT"; [TestCase("fizz", DeclarationType.Variable, "Integer")] [TestCase("FirstValue", DeclarationType.UserDefinedTypeMember, "Long")] @@ -45,20 +50,20 @@ End Enum Private fuzz As ETestType2 "; var result = ParseAndTest(inputCode, - targetIdentifier, - declarationType, - testParams, - PropertyGetBlockFromPrototypeTest); + targetIdentifier, + declarationType, + testParams, + PropertyGetBlockFromPrototypeTest); StringAssert.Contains($"Property Get {testParams.Identifier}() As {typeName}", result); } - [TestCase("fizz", DeclarationType.Variable, "Integer", "Public")] - [TestCase("FirstValue", DeclarationType.UserDefinedTypeMember, "Long", "Public")] - [TestCase("fazz", DeclarationType.Variable, "Long", "Public")] - [TestCase("fuzz", DeclarationType.Variable, "ETestType2", "Private")] + [TestCase("fizz", DeclarationType.Variable, "Integer", Accessibility.Public)] + [TestCase("FirstValue", DeclarationType.UserDefinedTypeMember, "Long", Accessibility.Public)] + [TestCase("fazz", DeclarationType.Variable, "Long", Accessibility.Public)] + [TestCase("fuzz", DeclarationType.Variable, "ETestType2", Accessibility.Private)] [Category(nameof(CodeBuilder))] - public void PropertyBlockFromPrototype_PropertyGetAccessibility(string targetIdentifier, DeclarationType declarationType, string typeName, string accessibility) + public void PropertyBlockFromPrototype_PropertyGetAccessibility(string targetIdentifier, DeclarationType declarationType, string typeName, Accessibility accessibility) { var testParams = new PropertyBlockFromPrototypeParams("Bazz", DeclarationType.PropertyGet, accessibility); string inputCode = @@ -86,20 +91,21 @@ End Enum Private fuzz As ETestType2 "; var result = ParseAndTest(inputCode, - targetIdentifier, - declarationType, - testParams, - PropertyGetBlockFromPrototypeTest); + targetIdentifier, + declarationType, + testParams, + PropertyGetBlockFromPrototypeTest); StringAssert.Contains($"{accessibility} Property Get {testParams.Identifier}() As {typeName}", result); } - [TestCase("fizz", DeclarationType.Variable, "Integer", "Bazz = fizz")] - [TestCase("FirstValue", DeclarationType.UserDefinedTypeMember, "Long", "Bazz = fozz.FirstValue")] - [TestCase("fazz", DeclarationType.Variable, "Long", "Bazz = fazz")] - [TestCase("fuzz", DeclarationType.Variable, "TTestType2", "Bazz = fuzz")] + [TestCase("fizz", DeclarationType.Variable, "Bazz = fizz")] + [TestCase("FirstValue", DeclarationType.UserDefinedTypeMember, "Bazz = fozz.FirstValue")] + [TestCase("fazz", DeclarationType.Variable, "Bazz = fazz")] + [TestCase("fezz", DeclarationType.Variable, "Bazz = fezz")] + [TestCase("fuzz", DeclarationType.Variable, "Bazz = fuzz")] [Category(nameof(CodeBuilder))] - public void PropertyBlockFromPrototype_PropertyGetContent(string targetIdentifier, DeclarationType declarationType, string typeName, string content) + public void PropertyBlockFromPrototype_PropertyGetContent(string targetIdentifier, DeclarationType declarationType, string content) { var testParams = new PropertyBlockFromPrototypeParams("Bazz", DeclarationType.PropertyGet, content: content); string inputCode = @@ -126,21 +132,22 @@ End Enum Private fazz As ETestType +Private fezz As ETestType2 + Private fuzz As TTestType2 "; var result = ParseAndTest(inputCode, - targetIdentifier, - declarationType, - testParams, - PropertyGetBlockFromPrototypeTest); + targetIdentifier, + declarationType, + testParams, + PropertyGetBlockFromPrototypeTest); StringAssert.Contains(content, result); } - - [TestCase("fizz", DeclarationType.Variable, "Integer", "Bazz = fizz")] + [Test] [Category(nameof(CodeBuilder))] - public void PropertyBlockFromPrototype_PropertyGetChangeParamName(string targetIdentifier, DeclarationType declarationType, string typeName, string content) + public void PropertyBlockFromPrototype_PropertyGetChangeParamName() { var testParams = new PropertyBlockFromPrototypeParams("Bazz", DeclarationType.PropertyGet, paramIdentifier: "testParam"); string inputCode = @@ -148,14 +155,56 @@ public void PropertyBlockFromPrototype_PropertyGetChangeParamName(string targetI Private fizz As Integer "; var result = ParseAndTest(inputCode, - targetIdentifier, - declarationType, - testParams, - PropertyGetBlockFromPrototypeTest); + "fizz", + DeclarationType.Variable, + testParams, + PropertyGetBlockFromPrototypeTest); StringAssert.Contains("Property Get Bazz() As Integer", result); } + [TestCase("Private Const fizz As Integer = 5", DeclarationType.Constant, "Integer")] + [TestCase("Private Type TTestType\r\nfizz As String\r\nEnd Type", DeclarationType.UserDefinedTypeMember, "String")] + [Category(nameof(CodeBuilder))] + public void PropertyBlockFromVariousPrototypeTypes_PropertyGet(string inputCode, DeclarationType declarationType, string expectedTypeName) + { + var testParams = new PropertyBlockFromPrototypeParams("Bazz", DeclarationType.PropertyGet); + + var result = ParseAndTest(inputCode, + "fizz", + declarationType, + testParams, + PropertyGetBlockFromPrototypeTest); + + StringAssert.Contains($"Property Get Bazz() As {expectedTypeName}", result); + } + + [TestCase("Property Get", "Property", DeclarationType.PropertyGet, "Variant")] + [TestCase("Function", "Function", DeclarationType.Function, "Variant")] + [Category(nameof(CodeBuilder))] + public void PropertyBlockFromFromFunctionPrototypes(string memberType, string memberEndStatement, DeclarationType declarationType, string typeName) + { + var targetIdentifier = "TestValue"; + var testParams = new PropertyBlockFromPrototypeParams("Bazz", DeclarationType.PropertyLet); + var inputCode = +$@" + +Private mTestValue As {typeName} + +Public {memberType} TestValue() As {typeName} + TestValue = mTestValue +End {memberEndStatement} +"; + + var result = ParseAndTest(inputCode, + targetIdentifier, + declarationType, + testParams, + PropertyLetBlockFromPrototypeTest); + + StringAssert.Contains($"Property Let {testParams.Identifier}(ByVal RHS As {typeName})", result); + } + [TestCase("fizz", DeclarationType.Variable, "Integer")] [TestCase("FirstValue", DeclarationType.UserDefinedTypeMember, "Long")] [TestCase("fazz", DeclarationType.Variable, "Long")] @@ -189,11 +238,11 @@ End Enum Private fuzz As ETestType2 "; var result = ParseAndTest(inputCode, - targetIdentifier, - declarationType, - testParams, - PropertyLetBlockFromPrototypeTest); - StringAssert.Contains($"Property Let {testParams.Identifier}(ByVal {_rhsIdentifier} As {typeName})", result); + targetIdentifier, + declarationType, + testParams, + PropertyLetBlockFromPrototypeTest); + StringAssert.Contains($"Property Let {testParams.Identifier}(ByVal RHS As {typeName})", result); } [TestCase("fizz", DeclarationType.Variable, "Variant")] @@ -214,10 +263,10 @@ End Type "; var result = ParseAndTest(inputCode, - targetIdentifier, - declarationType, - testParams, - PropertySetBlockFromPrototypeTest); + targetIdentifier, + declarationType, + testParams, + PropertySetBlockFromPrototypeTest); StringAssert.Contains($"Property Set {testParams.Identifier}(ByVal {_rhsIdentifier} As {typeName})", result); } @@ -237,10 +286,10 @@ public void MemberBlockFromPrototype_AppliesByVal(DeclarationType declarationTyp End {procType.endStmt} "; var result = ParseAndTest(inputCode, - procedureIdentifier, - declarationType, - new MemberBlockFromPrototypeTestParams(), - MemberBlockFromPrototypeTest); + procedureIdentifier, + declarationType, + new MemberBlockFromPrototypeTestParams(), + MemberBlockFromPrototypeTest); var expected = declarationType.HasFlag(DeclarationType.Property) ? "(arg1 As Long, ByVal arg2 As String)" @@ -264,9 +313,9 @@ public void ImprovedArgumentList_AppliesByVal(DeclarationType declarationType) End {procType.endStmt} "; var result = ParseAndTest(inputCode, - procedureIdentifier, - declarationType, - ImprovedArgumentListTest); + procedureIdentifier, + declarationType, + ImprovedArgumentListTest); var expected = declarationType.HasFlag(DeclarationType.Property) ? "arg1 As Long, ByVal arg2 As String" @@ -275,7 +324,6 @@ public void ImprovedArgumentList_AppliesByVal(DeclarationType declarationType) StringAssert.AreEqualIgnoringCase(expected, result); } - [TestCase(DeclarationType.PropertyGet)] [TestCase(DeclarationType.Function)] [Category(nameof(CodeBuilder))] @@ -290,13 +338,252 @@ public void ImprovedArgumentList_FunctionTypes(DeclarationType declarationType) End {procType.endStmt} "; var result = ParseAndTest(inputCode, - procedureIdentifier, - declarationType, - ImprovedArgumentListTest); + procedureIdentifier, + declarationType, + ImprovedArgumentListTest); StringAssert.AreEqualIgnoringCase($"arg1 As Long, arg2 As String", result); } + [Test] + [Category(nameof(CodeBuilder))] + public void UDT_CreateFromFields() + { + var inputCode = +@" + Public field1 As Long + Public field2 As String"; + + var expected = +$@"Private Type {_defaultUDTIdentifier} + Field1 As Long + Field2 As String +End Type"; + var actual = CodeBuilderUDTResult(inputCode, DeclarationType.Variable, "field1", "field2"); + StringAssert.AreEqualIgnoringCase(expected, actual); + } + + [Test] + [Category(nameof(CodeBuilder))] + public void UDT_ImplicitTypeMadeExplicit() + { + var inputCode = "Public field1"; + var actual = CodeBuilderUDTResult(inputCode, DeclarationType.Variable, "field1"); + StringAssert.Contains("Field1 As Variant", actual); + } + + [TestCase("()", "Long")] + [TestCase("(50)", "Long")] + [TestCase("(1 To 10)", "Long")] + [TestCase("()", "")] + [TestCase("(50)", "")] + [TestCase("(1 To 10)", "")] + [Category(nameof(CodeBuilder))] + public void UDT_FromArrayField(string dimensions, string type) + { + var field = "field1"; + + var inputCode = string.IsNullOrEmpty(type) + ? $"Public {field}{dimensions}" + : $"Public {field}{dimensions} As {type}"; + + var expectedType = string.IsNullOrEmpty(type) + ? "Variant" + : type; + + var actual = CodeBuilderUDTResult(inputCode, DeclarationType.Variable, field); + StringAssert.Contains($"Field1{dimensions} As {expectedType}", actual); + } + + [Test] + [Category(nameof(CodeBuilder))] + public void UDT_CreateFromConstants() + { + var inputCode = +@" + Public Const field1 As Long = 5 + Public Const field2 As String = ""Yo"" +"; + + var expected = +$@"Private Type {_defaultUDTIdentifier} + Field1 As Long + Field2 As String +End Type"; + var actual = CodeBuilderUDTResult(inputCode, DeclarationType.Constant, "field1", "field2"); + StringAssert.AreEqualIgnoringCase(expected, actual); + } + + [TestCase("Property Get", "Property", DeclarationType.PropertyGet)] + [TestCase("Function", "Function", DeclarationType.Function)] + [Category(nameof(CodeBuilder))] + public void UDT_CreateFromFunctionPrototypes(string memberType, string memberEndStatement, DeclarationType declarationType) + { + var inputCode = +$@" + +Private mTestValue As Long +Private mTestValue2 As Variant + +Public {memberType} TestValue() As Long + TestValue = mTestValue +End {memberEndStatement} + + +Public {memberType} TestValue2() As Variant + TestValue2 = mTestValue2 +End {memberEndStatement} +"; + + var expected = +$@"Private Type {_defaultUDTIdentifier} + TestValue As Long + TestValue2 As Variant +End Type"; + + var actual = CodeBuilderUDTResult(inputCode, declarationType, "TestValue", "TestValue2"); + StringAssert.AreEqualIgnoringCase(expected, actual); + } + + [Test] + [Category(nameof(CodeBuilder))] + public void UDT_CreateFromUDTMemberPrototypes() + { + var inputCode = +$@" +Private Type ExistingType + FirstValue As Long + SecondValue As Byte + ThirdValue As String +End Type +"; + + var expected = +$@"Private Type {_defaultUDTIdentifier} + FirstValue As Long + ThirdValue As String +End Type"; + + var actual = CodeBuilderUDTResult(inputCode, DeclarationType.UserDefinedTypeMember, "FirstValue", "ThirdValue"); + StringAssert.AreEqualIgnoringCase(expected, actual); + } + + [TestCase("Property Let", "Property", DeclarationType.PropertyLet)] + [TestCase("Property Set", "Property", DeclarationType.PropertySet)] + [TestCase("Sub", "Sub", DeclarationType.Procedure)] + [Category(nameof(CodeBuilder))] + public void UDT_InvalidPrototypes_NoResult(string memberType, string memberEndStatement, DeclarationType declarationType) + { + var inputCode = +$@" +Public {memberType} TestValue(arg As Long) +End {memberEndStatement} +"; + var actual = CodeBuilderUDTResult(inputCode, declarationType, "TestValue", "TestValue2"); + Assert.IsTrue(string.IsNullOrEmpty(actual)); + } + + [Test] + [Category(nameof(CodeBuilder))] + public void UDT_NullUDTIdentifierBuildUDT_NoResult() + { + var vbe = MockVbeBuilder.BuildFromSingleStandardModule("Private test As Long", out _).Object; + var state = MockParser.CreateAndParse(vbe); + using (state) + { + var targets = state.DeclarationFinder.DeclarationsWithType(DeclarationType.Variable) + .Where(d => d.IdentifierName == "test") + .Select(d => (d, d.IdentifierName)); + + var result = CreateCodeBuilder().TryBuildUserDefinedTypeDeclaration(null, targets, out var declaration); + + Assert.IsFalse(result); + Assert.IsTrue(string.IsNullOrEmpty(declaration)); + } + } + + [Test] + [Category(nameof(CodeBuilder))] + public void UDT_EmptyPrototypeList_NoResult() + { + var result = CreateCodeBuilder().TryBuildUserDefinedTypeDeclaration(_defaultUDTIdentifier, Enumerable.Empty<(Declaration, string)>(), out var declaration); + Assert.IsFalse(result); + Assert.IsTrue(string.IsNullOrEmpty(declaration)); + } + + [Test] + [Category(nameof(CodeBuilder))] + public void UDT_NullDeclarationInPrototypeList_NoResult() + { + var nullInList = new List<(Declaration, string)>() { (null, "Fizz") }; + var result = CreateCodeBuilder().TryBuildUserDefinedTypeDeclaration(_defaultUDTIdentifier, nullInList, out var declaration); + Assert.IsFalse(result); + Assert.IsTrue(string.IsNullOrEmpty(declaration)); + } + + [Test] + [Category(nameof(CodeBuilder))] + public void UDT_NullIdentifierInPrototypeList_NoResult() + { + var vbe = MockVbeBuilder.BuildFromSingleStandardModule("Private test As Long", out _).Object; + var state = MockParser.CreateAndParse(vbe); + using (state) + { + string nullIdentifier = null; + var targets = state.DeclarationFinder.DeclarationsWithType(DeclarationType.Variable) + .Where(d => d.IdentifierName == "test") + .Select(d => (d, nullIdentifier)); + + var result = CreateCodeBuilder().TryBuildUserDefinedTypeDeclaration("TestType", targets, out var declaration); + + Assert.IsFalse(result); + Assert.IsTrue(string.IsNullOrEmpty(declaration)); + } + } + + [Test] + [Category(nameof(CodeBuilder))] + public void UDT_NullPrototype_NoResult() + { + var result = CreateCodeBuilder().TryBuildUDTMemberDeclaration(null, _defaultUDTIdentifier, out var declaration); + Assert.IsFalse(result); + Assert.IsTrue(string.IsNullOrEmpty(declaration)); + } + + [Test] + [Category(nameof(CodeBuilder))] + public void UDT_NullUDTIdentifierBuildUDTMember_NoResult() + { + var vbe = MockVbeBuilder.BuildFromSingleStandardModule("Private test As Long", out _).Object; + var state = MockParser.CreateAndParse(vbe); + using (state) + { + var target = state.DeclarationFinder.DeclarationsWithType(DeclarationType.Variable) + .Single(d => d.IdentifierName == "test"); + + var result = CreateCodeBuilder().TryBuildUDTMemberDeclaration(target, null, out var declaration); + + Assert.IsFalse(result); + Assert.IsTrue(string.IsNullOrEmpty(declaration)); + } + } + + private string CodeBuilderUDTResult(string inputCode, DeclarationType declarationType, params string[] prototypes) + { + var vbe = MockVbeBuilder.BuildFromSingleStandardModule(inputCode, out _).Object; + var state = MockParser.CreateAndParse(vbe); + using (state) + { + var targets = state.DeclarationFinder.DeclarationsWithType(declarationType) + .Where(d => prototypes.Contains(d.IdentifierName)) + .Select(prototype => (prototype, prototype.IdentifierName.CapitalizeFirstLetter())); + + return CreateCodeBuilder().TryBuildUserDefinedTypeDeclaration(_defaultUDTIdentifier, targets, out string declaration) + ? declaration + : string.Empty; + } + } + private string ParseAndTest(string inputCode, string targetIdentifier, DeclarationType declarationType, Func theTest) { var vbe = MockVbeBuilder.BuildFromSingleStandardModule(inputCode, out _).Object; @@ -304,8 +591,8 @@ private string ParseAndTest(string inputCode, string targetIdentifier, Declar using (state) { var target = state.DeclarationFinder.DeclarationsWithType(declarationType) - .Where(d => d.IdentifierName == targetIdentifier).OfType() - .Single(); + .Where(d => d.IdentifierName == targetIdentifier).OfType() + .Single(); return theTest(target); } } @@ -317,8 +604,8 @@ private string ParseAndTest(string inputCode, string targetIdentifier, Declar using (state) { var target = state.DeclarationFinder.DeclarationsWithType(declarationType) - .Where(d => d.IdentifierName == targetIdentifier).OfType() - .Single(); + .Where(d => d.IdentifierName == targetIdentifier).OfType() + .Single(); return theTest(target, testParams); } } @@ -330,35 +617,46 @@ private string ParseAndTest(string inputCode, string targetIdentifier, Declar using (state) { var target = state.DeclarationFinder.DeclarationsWithType(declarationType) - .Where(d => d.IdentifierName == targetIdentifier).OfType() - .Single(); + .Where(d => d.IdentifierName == targetIdentifier).OfType() + .Single(); return theTest(target, testParams); } } private static string PropertyGetBlockFromPrototypeTest(T target, PropertyBlockFromPrototypeParams testParams) where T : Declaration { - new CodeBuilder().TryBuildPropertyGetCodeBlock(target, testParams.Identifier, out string result, testParams.Accessibility, testParams.Content); + CreateCodeBuilder().TryBuildPropertyGetCodeBlock(target, testParams.Identifier, out string result, testParams.Accessibility, testParams.Content); return result; } private static string PropertyLetBlockFromPrototypeTest(T target, PropertyBlockFromPrototypeParams testParams) where T : Declaration { - new CodeBuilder().TryBuildPropertyLetCodeBlock(target, testParams.Identifier, out string result, testParams.Accessibility, testParams.Content, testParams.WriteParam); + CreateCodeBuilder().TryBuildPropertyLetCodeBlock(target, testParams.Identifier, out string result, testParams.Accessibility, testParams.Content, testParams.WriteParam); return result; } private static string PropertySetBlockFromPrototypeTest(T target, PropertyBlockFromPrototypeParams testParams) where T : Declaration { - new CodeBuilder().TryBuildPropertySetCodeBlock(target, testParams.Identifier, out string result, testParams.Accessibility, testParams.Content, testParams.WriteParam); + CreateCodeBuilder().TryBuildPropertySetCodeBlock(target, testParams.Identifier, out string result, testParams.Accessibility, testParams.Content, testParams.WriteParam); return result; } private static string ImprovedArgumentListTest(ModuleBodyElementDeclaration mbed) - => new CodeBuilder().ImprovedArgumentList(mbed); + => CreateCodeBuilder().ImprovedArgumentList(mbed); private static string MemberBlockFromPrototypeTest(ModuleBodyElementDeclaration mbed, MemberBlockFromPrototypeTestParams testParams) - => new CodeBuilder().BuildMemberBlockFromPrototype(mbed, testParams.Accessibility, testParams.Content, testParams.NewIdentifier); + => CreateCodeBuilder().BuildMemberBlockFromPrototype(mbed, testParams.Content, testParams.Accessibility, testParams.NewIdentifier); + + private static ICodeBuilder CreateCodeBuilder() + => new CodeBuilder(new Indenter(null, CreateIndenterSettings)); + + private static IndenterSettings CreateIndenterSettings() + { + var s = IndenterSettingsTests.GetMockIndenterSettings(); + s.VerticallySpaceProcedures = true; + s.LinesBetweenProcedures = 1; + return s; + } private (string procType, string endStmt) ProcedureTypeIdentifier(DeclarationType declarationType) { @@ -381,7 +679,7 @@ private static string MemberBlockFromPrototypeTest(ModuleBodyElementDeclaration private struct PropertyBlockFromPrototypeParams { - public PropertyBlockFromPrototypeParams(string identifier, DeclarationType propertyType, string accessibility = null, string content = null, string paramIdentifier = null) + public PropertyBlockFromPrototypeParams(string identifier, DeclarationType propertyType, Accessibility accessibility = Accessibility.Public, string content = null, string paramIdentifier = null) { Identifier = identifier; DeclarationType = propertyType; @@ -391,21 +689,21 @@ public PropertyBlockFromPrototypeParams(string identifier, DeclarationType prope } public DeclarationType DeclarationType { get; } public string Identifier { get; } - public string Accessibility {get; } + public Accessibility Accessibility {get; } public string Content { get; } public string WriteParam { get; } } private struct MemberBlockFromPrototypeTestParams { - public MemberBlockFromPrototypeTestParams(ModuleBodyElementDeclaration mbed, string accessibility = null, string content = null, string newIdentifier = null) + public MemberBlockFromPrototypeTestParams(ModuleBodyElementDeclaration mbed, Accessibility accessibility = Accessibility.Public, string content = null, string newIdentifier = null) { Accessibility = accessibility; Content = content; NewIdentifier = newIdentifier; } - public string Accessibility { get; } + public Accessibility Accessibility { get; } public string Content { get; } public string NewIdentifier { get; } } diff --git a/RubberduckTests/CodeExplorer/MockedCodeExplorer.cs b/RubberduckTests/CodeExplorer/MockedCodeExplorer.cs index f37cfef86f..5e1df21a40 100644 --- a/RubberduckTests/CodeExplorer/MockedCodeExplorer.cs +++ b/RubberduckTests/CodeExplorer/MockedCodeExplorer.cs @@ -507,16 +507,27 @@ public MockedCodeExplorer ImplementIndenterCommand() public MockedCodeExplorer ImplementExtractInterfaceCommand() { - var addImplementationsBaseRefactoring = new AddInterfaceImplementationsRefactoringAction(null, new CodeBuilder()); + var addImplementationsBaseRefactoring = new AddInterfaceImplementationsRefactoringAction(null, CreateCodeBuilder()); var addComponentService = TestAddComponentService(State.ProjectsProvider); var extractInterfaceBaseRefactoring = new ExtractInterfaceRefactoringAction(addImplementationsBaseRefactoring, State, State, null, State.ProjectsProvider, addComponentService); var userInteraction = new RefactoringUserInteraction(null, _uiDispatcher.Object); ViewModel.CodeExplorerExtractInterfaceCommand = new CodeExplorerExtractInterfaceCommand( - new ExtractInterfaceRefactoring(extractInterfaceBaseRefactoring, State, userInteraction, null, new CodeBuilder()), + new ExtractInterfaceRefactoring(extractInterfaceBaseRefactoring, State, userInteraction, null, CreateCodeBuilder()), State, null, VbeEvents.Object); return this; } + private ICodeBuilder CreateCodeBuilder() + => new CodeBuilder(new Indenter(Vbe.Object, CreateIndenterSettings)); + + private static IndenterSettings CreateIndenterSettings() + { + var s = IndenterSettingsTests.GetMockIndenterSettings(); + s.VerticallySpaceProcedures = true; + s.LinesBetweenProcedures = 1; + return s; + } + private static IAddComponentService TestAddComponentService(IProjectsProvider projectsProvider) { var sourceCodeHandler = new CodeModuleComponentSourceCodeHandler(); diff --git a/RubberduckTests/Commands/RefactorCommands/EncapsulateFieldCommandTests.cs b/RubberduckTests/Commands/RefactorCommands/EncapsulateFieldCommandTests.cs index 2d9a377960..31df2f60e5 100644 --- a/RubberduckTests/Commands/RefactorCommands/EncapsulateFieldCommandTests.cs +++ b/RubberduckTests/Commands/RefactorCommands/EncapsulateFieldCommandTests.cs @@ -1,25 +1,21 @@ -using System; -using Moq; +using Castle.Windsor; using NUnit.Framework; -using Rubberduck.Interaction; using Rubberduck.Parsing.Rewriter; -using Rubberduck.Parsing.UIContext; using Rubberduck.Parsing.VBA; -using Rubberduck.Refactorings; -using Rubberduck.Refactorings.EncapsulateField; using Rubberduck.UI.Command; using Rubberduck.UI.Command.Refactorings; -using Rubberduck.UI.Command.Refactorings.Notifiers; using Rubberduck.VBEditor; using Rubberduck.VBEditor.SafeComWrappers.Abstract; using Rubberduck.VBEditor.Utility; +using RubberduckTests.Refactoring.EncapsulateField; namespace RubberduckTests.Commands.RefactorCommands { public class EncapsulateFieldCommandTests : RefactorCodePaneCommandTestBase { - [Category("Commands")] [Test] + [Category("Commands")] + [Category("Encapsulate Field")] public void EncapsulateField_CanExecute_LocalVariable() { const string input = @@ -30,8 +26,9 @@ public void EncapsulateField_CanExecute_LocalVariable() Assert.IsFalse(CanExecute(input, selection)); } - [Category("Commands")] [Test] + [Category("Commands")] + [Category("Encapsulate Field")] public void EncapsulateField_CanExecute_Proc() { const string input = @@ -42,8 +39,9 @@ Sub Foo() Assert.IsFalse(CanExecute(input, selection)); } - [Category("Commands")] [Test] + [Category("Commands")] + [Category("Encapsulate Field")] public void EncapsulateField_CanExecute_Field() { const string input = @@ -56,18 +54,9 @@ Sub Foo() protected override CommandBase TestCommand(IVBE vbe, RubberduckParserState state, IRewritingManager rewritingManager, ISelectionService selectionService) { - var msgBox = new Mock().Object; - var factory = new Mock().Object; - var selectedDeclarationProvider = new SelectedDeclarationProvider(selectionService, state); - var uiDispatcherMock = new Mock(); - uiDispatcherMock - .Setup(m => m.Invoke(It.IsAny())) - .Callback((Action action) => action.Invoke()); - var userInteraction = new RefactoringUserInteraction(factory, uiDispatcherMock.Object); - var refactoring = new EncapsulateFieldRefactoring(state, null, userInteraction, rewritingManager, selectionService, selectedDeclarationProvider, new CodeBuilder()); - var notifier = new EncapsulateFieldFailedNotifier(msgBox); - var selectedDeclarationService = new SelectedDeclarationProvider(selectionService, state); - return new RefactorEncapsulateFieldCommand(refactoring, notifier, state, selectionService, selectedDeclarationService); + var resolver = new EncapsulateFieldTestsResolver(state, rewritingManager, selectionService); + resolver.Install(new WindsorContainer(), null); + return resolver.Resolve(); } protected override IVBE SetupAllowingExecution() diff --git a/RubberduckTests/Commands/RefactorCommands/ExtractInterfaceCommandTests.cs b/RubberduckTests/Commands/RefactorCommands/ExtractInterfaceCommandTests.cs index d0678ec0bf..722d782c8d 100644 --- a/RubberduckTests/Commands/RefactorCommands/ExtractInterfaceCommandTests.cs +++ b/RubberduckTests/Commands/RefactorCommands/ExtractInterfaceCommandTests.cs @@ -8,6 +8,7 @@ using Rubberduck.Refactorings; using Rubberduck.Refactorings.AddInterfaceImplementations; using Rubberduck.Refactorings.ExtractInterface; +using Rubberduck.SmartIndenter; using Rubberduck.UI.Command; using Rubberduck.UI.Command.Refactorings; using Rubberduck.UI.Command.Refactorings.Notifiers; @@ -18,6 +19,7 @@ using Rubberduck.VBEditor.SourceCodeHandling; using Rubberduck.VBEditor.Utility; using RubberduckTests.Mocks; +using RubberduckTests.Settings; namespace RubberduckTests.Commands.RefactorCommands { @@ -173,15 +175,26 @@ protected override CommandBase TestCommand(IVBE vbe, RubberduckParserState state uiDispatcherMock .Setup(m => m.Invoke(It.IsAny())) .Callback((Action action) => action.Invoke()); - var addImplementationsBaseRefactoring = new AddInterfaceImplementationsRefactoringAction(rewritingManager, new CodeBuilder()); + var addImplementationsBaseRefactoring = new AddInterfaceImplementationsRefactoringAction(rewritingManager, CreateCodeBuilder()); var addComponentService = TestAddComponentService(state.ProjectsProvider); var baseRefactoring = new ExtractInterfaceRefactoringAction(addImplementationsBaseRefactoring, state, state, rewritingManager, state.ProjectsProvider, addComponentService); var userInteraction = new RefactoringUserInteraction(factory, uiDispatcherMock.Object); - var refactoring = new ExtractInterfaceRefactoring(baseRefactoring, state, userInteraction, selectionService, new CodeBuilder()); + var refactoring = new ExtractInterfaceRefactoring(baseRefactoring, state, userInteraction, selectionService, CreateCodeBuilder()); var notifier = new ExtractInterfaceFailedNotifier(msgBox); return new RefactorExtractInterfaceCommand(refactoring, notifier, state, selectionService); } + private static ICodeBuilder CreateCodeBuilder() + => new CodeBuilder(new Indenter(null, CreateIndenterSettings)); + + private static IndenterSettings CreateIndenterSettings() + { + var s = IndenterSettingsTests.GetMockIndenterSettings(); + s.VerticallySpaceProcedures = true; + s.LinesBetweenProcedures = 1; + return s; + } + private static IAddComponentService TestAddComponentService(IProjectsProvider projectsProvider) { var sourceCodeHandler = new CodeModuleComponentSourceCodeHandler(); diff --git a/RubberduckTests/Commands/RefactorCommands/ImplementInterfaceCommandTests.cs b/RubberduckTests/Commands/RefactorCommands/ImplementInterfaceCommandTests.cs index aa5d7590f7..95d6cb07e9 100644 --- a/RubberduckTests/Commands/RefactorCommands/ImplementInterfaceCommandTests.cs +++ b/RubberduckTests/Commands/RefactorCommands/ImplementInterfaceCommandTests.cs @@ -6,6 +6,7 @@ using Rubberduck.Refactorings; using Rubberduck.Refactorings.AddInterfaceImplementations; using Rubberduck.Refactorings.ImplementInterface; +using Rubberduck.SmartIndenter; using Rubberduck.UI.Command; using Rubberduck.UI.Command.Refactorings; using Rubberduck.UI.Command.Refactorings.Notifiers; @@ -14,6 +15,7 @@ using Rubberduck.VBEditor.SafeComWrappers.Abstract; using Rubberduck.VBEditor.Utility; using RubberduckTests.Mocks; +using RubberduckTests.Settings; namespace RubberduckTests.Commands.RefactorCommands { @@ -58,7 +60,7 @@ public void ImplementInterface_CanExecute_ImplementsInterfaceSelected() protected override CommandBase TestCommand(IVBE vbe, RubberduckParserState state, IRewritingManager rewritingManager, ISelectionService selectionService) { var msgBox = new Mock().Object; - var addImplementationsBaseRefactoring = new AddInterfaceImplementationsRefactoringAction(rewritingManager, new CodeBuilder()); + var addImplementationsBaseRefactoring = new AddInterfaceImplementationsRefactoringAction(rewritingManager, CreateCodeBuilder()); var baseRefactoring = new ImplementInterfaceRefactoringAction(addImplementationsBaseRefactoring, rewritingManager); var refactoring = new ImplementInterfaceRefactoring(baseRefactoring, state, selectionService); var notifier = new ImplementInterfaceFailedNotifier(msgBox); @@ -78,5 +80,16 @@ protected override IVBE SetupAllowingExecution() return builder.AddProject(project).Build().Object; } + + private static ICodeBuilder CreateCodeBuilder() + => new CodeBuilder(new Indenter(null, CreateIndenterSettings)); + + private static IndenterSettings CreateIndenterSettings() + { + var s = IndenterSettingsTests.GetMockIndenterSettings(); + s.VerticallySpaceProcedures = true; + s.LinesBetweenProcedures = 1; + return s; + } } } \ No newline at end of file diff --git a/RubberduckTests/Refactoring/EncapsulateField/IModuleRewriterExtensionTests.cs b/RubberduckTests/IModuleRewriterExtensionTests.cs similarity index 98% rename from RubberduckTests/Refactoring/EncapsulateField/IModuleRewriterExtensionTests.cs rename to RubberduckTests/IModuleRewriterExtensionTests.cs index 736cb9266d..ee4103be5b 100644 --- a/RubberduckTests/Refactoring/EncapsulateField/IModuleRewriterExtensionTests.cs +++ b/RubberduckTests/IModuleRewriterExtensionTests.cs @@ -8,7 +8,7 @@ using System.Collections.Generic; using System.Linq; -namespace RubberduckTests.Refactoring.EncapsulateField +namespace RubberduckTests { [TestFixture] public class IModuleRewriterExtensionTests diff --git a/RubberduckTests/Inspections/DefaultMemberRequiredInspectionTests.cs b/RubberduckTests/Inspections/DefaultMemberRequiredInspectionTests.cs index 69205e9b13..062706917a 100644 --- a/RubberduckTests/Inspections/DefaultMemberRequiredInspectionTests.cs +++ b/RubberduckTests/Inspections/DefaultMemberRequiredInspectionTests.cs @@ -330,6 +330,31 @@ End Function Assert.AreEqual(expectedSelection, actualSelection); } + [Category("Inspections")] + [Test] + public void OptionalParenthesesAfterVariantReturningProperty_NoResult() + { + var classCode = @" +Public Property Get Foo() As Variant +End Property +"; + + var moduleCode = @" +Private Function Bar() As String + Dim cls As new Class1 + Bar = cls.Foo() +End Function +"; + + var vbe = MockVbeBuilder.BuildFromModules( + ("Class1", classCode, ComponentType.ClassModule), + ("Module1", moduleCode, ComponentType.StandardModule)); + + var inspectionResults = InspectionResults(vbe.Object); + + Assert.AreEqual(0, inspectionResults.Count()); + } + [Category("Inspections")] [Test] public void FailedIndexExpressionOnFunctionWithParameters_NoResult() diff --git a/RubberduckTests/Inspections/ImplicitByRefModifierInspectionTests.cs b/RubberduckTests/Inspections/ImplicitByRefModifierInspectionTests.cs index caa05cfe5d..7cd4f2c85a 100644 --- a/RubberduckTests/Inspections/ImplicitByRefModifierInspectionTests.cs +++ b/RubberduckTests/Inspections/ImplicitByRefModifierInspectionTests.cs @@ -17,13 +17,26 @@ public class ImplicitByRefModifierInspectionTests : InspectionTestsBase [TestCase("Sub Foo(arg1 As Integer, ByRef arg2 As Date)\r\nEnd Sub", 1)] [TestCase("Sub Foo(ParamArray arg1 As Integer)\r\nEnd Sub", 0)] [Category("QuickFixes")] + [Category(nameof(ImplicitByRefModifierInspection))] public void ImplicitByRefModifier_SimpleScenarios(string inputCode, int expectedCount) { Assert.AreEqual(expectedCount, InspectionResultsForStandardModule(inputCode).Count()); } + [TestCase("Property Let Fizz(RHS As Integer)\r\nEnd Property", 0)] + [TestCase("Property Set Fizz(RHS As Object)\r\nEnd Property", 0)] + [TestCase("Property Let Fizz(index As Integer, RHS As Integer)\r\nEnd Property", 1)] + [TestCase("Property Set Fizz(index As Integer, RHS As Object)\r\nEnd Property", 1)] + [Category("QuickFixes")] + [Category(nameof(ImplicitByRefModifierInspection))] + public void ImplicitByRefModifier_PropertyMutatorRHSParameter(string inputCode, int expectedCount) + { + Assert.AreEqual(expectedCount, InspectionResultsForStandardModule(inputCode).Count()); + } + [Test] [Category("QuickFixes")] + [Category(nameof(ImplicitByRefModifierInspection))] public void ImplicitByRefModifier_ReturnsResult_InterfaceImplementation() { const string inputCode1 = @@ -47,6 +60,7 @@ Sub IClass1_Foo(arg1 As Integer) [Test] [Category("QuickFixes")] + [Category(nameof(ImplicitByRefModifierInspection))] public void ImplicitByRefModifier_ReturnsResult_MultipleInterfaceImplementations() { const string inputCode1 = @@ -77,6 +91,7 @@ Sub IClass1_Foo(arg1 As Integer) [Test] [Category("QuickFixes")] + [Category(nameof(ImplicitByRefModifierInspection))] public void ImplicitByRefModifier_Ignored_DoesNotReturnResult() { const string inputCode = @@ -86,8 +101,30 @@ Sub Foo(arg1 As Integer) Assert.AreEqual(0, InspectionResultsForStandardModule(inputCode).Count()); } + [TestCase(@"Public Declare PtrSafe Sub LibProcedure Lib ""MyLib""(arg As Long)", "LibProcedure 2000")] + [TestCase(@"Public Declare PtrSafe Function LibProcedure Lib ""MyLib""(arg As Long) As Long", "test = LibProcedure(2000)")] + [Category("QuickFixes")] + [Category(nameof(ImplicitByRefModifierInspection))] + public void ImplicitByRefModifier_IgnoresDeclareStatement(string declareStatement, string libraryCall) + { + var inputCode = +$@" +Option Explicit + +Private test As Long + +{declareStatement} + +Public Sub CallTheLib() + {libraryCall} +End Sub"; + + Assert.AreEqual(0, InspectionResultsForStandardModule(inputCode).Count()); + } + [Test] [Category("QuickFixes")] + [Category(nameof(ImplicitByRefModifierInspection))] public void InspectionName() { var inspection = new ImplicitByRefModifierInspection(null); diff --git a/RubberduckTests/Inspections/MisleadingByRefParameterInspectionTests.cs b/RubberduckTests/Inspections/MisleadingByRefParameterInspectionTests.cs new file mode 100644 index 0000000000..f43812bc68 --- /dev/null +++ b/RubberduckTests/Inspections/MisleadingByRefParameterInspectionTests.cs @@ -0,0 +1,72 @@ +using NUnit.Framework; +using Rubberduck.CodeAnalysis.Inspections; +using Rubberduck.CodeAnalysis.Inspections.Concrete; +using Rubberduck.Parsing.VBA; +using System; +using System.Collections.Generic; +using System.Linq; +using System.Text; +using System.Threading.Tasks; + +namespace RubberduckTests.Inspections +{ + [TestFixture] + public class MisleadingByRefParameterInspectionTests : InspectionTestsBase + { + [TestCase("Property Let Fizz(ByRef arg1 As Integer)\r\nEnd Property", 1)] + [TestCase("Property Let Fizz(arg1 As Integer)\r\nEnd Property", 0)] + [TestCase("Property Let Fizz(ByVal arg1 As Integer)\r\nEnd Property", 0)] + [TestCase("Property Set Fizz(ByRef arg1 As Object)\r\nEnd Property", 1)] + [TestCase("Property Set Fizz(arg1 As Object)\r\nEnd Property", 0)] + [TestCase("Property Set Fizz(ByVal arg1 As Object)\r\nEnd Property", 0)] + [Category("QuickFixes")] + [Category(nameof(MisleadingByRefParameterInspection))] + public void AllParamMechanisms(string inputCode, int expectedCount) + { + Assert.AreEqual(expectedCount, InspectionResultsForStandardModule(inputCode).Count()); + } + + [TestCase("arg")] + [TestCase("ByRef arg")] + [Category("QuickFixes")] + [Category(nameof(MisleadingByRefParameterInspection))] + public void UserDefinedTypeEdgeCase(string parameterMechanismAndParam) + { + var inputCode = +$@" +Option Explicit + +Public Type TestType + FirstValue As Long +End Type + +Private this As TestType + +Public Property Get UserDefinedType() As TestType + UserDefinedType = this +End Property + +Public Property Let UserDefinedType({parameterMechanismAndParam} As TestType) + this = arg +End Property +"; + + Assert.AreEqual(0, InspectionResultsForStandardModule(inputCode).Count()); + } + + [Test] + [Category("QuickFixes")] + [Category(nameof(MisleadingByRefParameterInspection))] + public void InspectionName() + { + var inspection = new MisleadingByRefParameterInspection(null); + + Assert.AreEqual(nameof(MisleadingByRefParameterInspection), inspection.Name); + } + + protected override IInspection InspectionUnderTest(RubberduckParserState state) + { + return new MisleadingByRefParameterInspection(state); + } + } +} diff --git a/RubberduckTests/Inspections/ThunderCode/ThunderCodeInspectionTests.cs b/RubberduckTests/Inspections/ThunderCode/ThunderCodeInspectionTests.cs index 2c0c910f40..3fdc28b62f 100644 --- a/RubberduckTests/Inspections/ThunderCode/ThunderCodeInspectionTests.cs +++ b/RubberduckTests/Inspections/ThunderCode/ThunderCodeInspectionTests.cs @@ -224,6 +224,39 @@ GoTo 1 GoTo -5 1 -5: +End Sub")] + [TestCase(1, @"Public Sub Gogo() +On Error GoTo 1 +1 +-1: +End Sub")] + [TestCase(2, @"Public Sub Gogo() +On Error GoTo -1 +1 +-1: +End Sub")] + [TestCase(2, @"Public Sub Gogo() +On Error GoTo -1 +1: +-1 +End Sub")] + [TestCase(0, @"Public Sub Gogo() +On Error GoTo -1 +1 +End Sub")] + [TestCase(1, @"Public Sub Gogo() +On Error GoTo -2 +1 +End Sub")] + [TestCase(2, @"Public Sub Gogo() +On Error GoTo -5 +1 +-5: +End Sub")] + [TestCase(2, @"Public Sub Gogo() +On Error GoTo -5 +1: +-5 End Sub")] public void NegativeLineNumberLabel_ReturnResults(int expectedCount, string inputCode) { diff --git a/RubberduckTests/QuickFixes/PassParameterByValueQuickFixTests.cs b/RubberduckTests/QuickFixes/PassParameterByValueQuickFixTests.cs index 6957b4a256..fc158bf106 100644 --- a/RubberduckTests/QuickFixes/PassParameterByValueQuickFixTests.cs +++ b/RubberduckTests/QuickFixes/PassParameterByValueQuickFixTests.cs @@ -296,6 +296,28 @@ Debug.Print foo Assert.AreEqual(expectedCode, actualCode); } + [Test] + [Category("QuickFixes")] + [Category(nameof(MisleadingByRefParameterInspection))] + public void CorrectsMisleadingByRefPropertyMutatorParameter() + { + const string inputCode = +@" +Option Explicit + +Private fizzField As Long + +Public Property Get Fizz() As Long + Fizz = fizzField +End Property + +Public Property Let Fizz(ByRef arg As Long) + fizzField = arg +End Property +"; + var actualCode = ApplyQuickFixToFirstInspectionResult(inputCode, state => new MisleadingByRefParameterInspection(state)); + StringAssert.Contains("Public Property Let Fizz(ByVal arg As Long)", actualCode); + } protected override IQuickFix QuickFix(RubberduckParserState state) { diff --git a/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldInteractiveRefactoringTest.cs b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldInteractiveRefactoringTest.cs new file mode 100644 index 0000000000..b9022afd59 --- /dev/null +++ b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldInteractiveRefactoringTest.cs @@ -0,0 +1,39 @@ +using System; +using NUnit.Framework; +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings; +using Rubberduck.Refactorings.EncapsulateField; +using Rubberduck.Refactorings.Exceptions; +using Rubberduck.VBEditor.Utility; +using RubberduckTests.Mocks; + +namespace RubberduckTests.Refactoring.EncapsulateField +{ + [TestFixture] + public abstract class EncapsulateFieldInteractiveRefactoringTest : InteractiveRefactoringTestBase + { + //RefactoringTestBase.NoActiveSelection_Throws passes a null + //IDeclarationFinderProvider parameter to 'TestRefactoring(...). + //The EncapsulateFieldRefactoring tests Resolver throws a different + //exception type without a valid interface reference and causes the + //base class version of the test to fail. + [Test] + [Category("Refactorings")] + public override void NoActiveSelection_Throws() + { + var testVbe = TestVbe(string.Empty, out _); + var (state, rewritingManager) = MockParser.CreateAndParseWithRewritingManager(testVbe); + using (state) + { + var refactoring = TestRefactoring(rewritingManager, state, initialSelection: null); + Assert.Throws(() => refactoring.Refactor()); + } + } + + protected override IRefactoring TestRefactoring(IRewritingManager rewritingManager, RubberduckParserState state, RefactoringUserInteraction userInteraction, ISelectionService selectionService) + { + throw new NotImplementedException(); + } + } +} diff --git a/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFIeldTestSupport.cs b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldTestSupport.cs similarity index 73% rename from RubberduckTests/Refactoring/EncapsulateField/EncapsulateFIeldTestSupport.cs rename to RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldTestSupport.cs index 05d2cb2802..c48948d393 100644 --- a/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFIeldTestSupport.cs +++ b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldTestSupport.cs @@ -1,10 +1,11 @@ -using Rubberduck.Parsing.Rewriter; +using Castle.Windsor; +using Rubberduck.Parsing.Rewriter; using Rubberduck.Parsing.Symbols; using Rubberduck.Parsing.VBA; using Rubberduck.Refactorings; using Rubberduck.Refactorings.EncapsulateField; -using Rubberduck.SmartIndenter; using Rubberduck.VBEditor; +using Rubberduck.VBEditor.SafeComWrappers; using Rubberduck.VBEditor.SafeComWrappers.Abstract; using Rubberduck.VBEditor.Utility; using RubberduckTests.Mocks; @@ -14,11 +15,41 @@ namespace RubberduckTests.Refactoring.EncapsulateField { - public class EncapsulateFieldTestSupport : InteractiveRefactoringTestBase + public class EncapsulateFieldTestSupport : EncapsulateFieldInteractiveRefactoringTest { + private EncapsulateFieldTestsResolver _testResolver; + + public void ResetResolver() + { + _testResolver = null; + } + + public T Resolve(IDeclarationFinderProvider declarationFinderProvider, IRewritingManager rewritingManager = null, ISelectionService selectionService = null) where T : class + { + SetupResolver(declarationFinderProvider, rewritingManager, selectionService); + return Resolve() as T; + } + + public T Resolve() where T : class + => _testResolver?.Resolve() as T ?? throw new InvalidOperationException("Test Resolver not initialized. Call 'SetupResolver(...)' or use one of the 'Resolve()' overloads"); + + public void SetupResolver(IDeclarationFinderProvider declarationFinderProvider, IRewritingManager rewritingManager = null, ISelectionService selectionService = null) + { + if (declarationFinderProvider is null) + { + throw new ArgumentNullException("declarationFinderProvider is null"); + } + + if (_testResolver is null) + { + _testResolver = new EncapsulateFieldTestsResolver(declarationFinderProvider, rewritingManager, selectionService); + _testResolver.Install(new WindsorContainer(), null); + } + } + public string RHSIdentifier => Rubberduck.Resources.Refactorings.Refactorings.CodeBuilder_DefaultPropertyRHSParam; - public string StateUDTDefaultType => $"T{MockVbeBuilder.TestModuleName}"; + public string StateUDTDefaultTypeName => $"T{MockVbeBuilder.TestModuleName}"; private TestEncapsulationAttributes UserModifiedEncapsulationAttributes(string field, string property = null, bool isReadonly = false, bool encapsulateFlag = true) { @@ -112,14 +143,46 @@ public string RefactoredCode(CodeString codeString, Func RefactoredCode(codeString.Code, codeString.CaretPosition.ToOneBased(), presenterAdjustment, expectedException, executeViaActiveSelection); public IRefactoring SupportTestRefactoring( - IRewritingManager rewritingManager, + IRewritingManager rewritingManager, RubberduckParserState state, - RefactoringUserInteraction userInteraction, + RefactoringUserInteraction userInteraction, ISelectionService selectionService) { - var indenter = CreateIndenter(); - var selectedDeclarationProvider = new SelectedDeclarationProvider(selectionService, state); - return new EncapsulateFieldRefactoring(state, indenter, userInteraction, rewritingManager, selectionService, selectedDeclarationProvider, new CodeBuilder()); + SetupResolver(state, rewritingManager, selectionService); + return new EncapsulateFieldRefactoring(Resolve(state, rewritingManager, selectionService), + Resolve(), + Resolve(), + userInteraction, + selectionService, + Resolve()); + } + + public IDictionary RefactoredCode( + Func presenterAction, + TestCodeString codeString, + params (string, string, ComponentType)[] otherModules) + { + return RefactoredCode(presenterAction, + (MockVbeBuilder.TestModuleName, codeString, ComponentType.StandardModule), + otherModules); + } + + public IDictionary RefactoredCode( + Func presenterAction, + (string selectedModuleName, TestCodeString codeString, ComponentType componentType) moduleUnderTest, + params (string, string, ComponentType)[] otherModules) + { + var modules = otherModules.ToList(); + + modules.Add((moduleUnderTest.selectedModuleName, moduleUnderTest.codeString.Code, moduleUnderTest.componentType)); + + return RefactoredCode( + moduleUnderTest.selectedModuleName, + moduleUnderTest.codeString.CaretPosition.ToOneBased(), + presenterAction, + null, + false, + modules.ToArray()); } public IEncapsulateFieldCandidate RetrieveEncapsulateFieldCandidate(string inputCode, string fieldName) @@ -140,12 +203,12 @@ public IEncapsulateFieldCandidate RetrieveEncapsulateFieldCandidate(IVBE vbe, st using (state) { var match = state.DeclarationFinder.MatchName(fieldName).Where(m => m.DeclarationType.Equals(declarationType)).Single(); - var builder = new EncapsulateFieldElementsBuilder(state, match.QualifiedModuleName); - foreach (var candidate in builder.Candidates) - { - candidate.NameValidator = EncapsulateFieldValidationsProvider.NameOnlyValidator(NameValidators.Default); - } - return builder.Candidates.First(); + + var model = Resolve(state).Create(match); + + model.ConflictFinder.AssignNoConflictIdentifiers(model[match.IdentifierName]); + + return model[match.IdentifierName]; } } @@ -161,11 +224,6 @@ public EncapsulateFieldModel RetrieveUserModifiedModelPriorToRefactoring(IVBE vb return presenterAdjustment(initialModel); } - public static IIndenter CreateIndenter(IVBE vbe = null) - { - return new Indenter(vbe, () => Settings.IndenterSettingsTests.GetMockIndenterSettings()); - } - protected override IRefactoring TestRefactoring( IRewritingManager rewritingManager, RubberduckParserState state, @@ -180,8 +238,7 @@ public class TestEncapsulationAttributes { public TestEncapsulationAttributes(string fieldName, bool encapsulationFlag = true, bool isReadOnly = false) { - var validator = EncapsulateFieldValidationsProvider.NameOnlyValidator(NameValidators.Default); - _identifiers = new EncapsulationIdentifiers(fieldName, validator); + _identifiers = new EncapsulationIdentifiers(fieldName); EncapsulateFlag = encapsulationFlag; IsReadOnly = isReadOnly; } @@ -240,9 +297,9 @@ public void EncapsulateUsingUDTField(string targetID = null) public string StateUDT_FieldName { set; get; } - public TestEncapsulationAttributes this[string fieldName] + public TestEncapsulationAttributes this[string fieldName] => EncapsulateFieldAttributes.Where(efa => efa.TargetFieldName == fieldName).Single(); public IEnumerable EncapsulateFieldAttributes => _userInput; } -} +} \ No newline at end of file diff --git a/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldTestsResolver.cs b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldTestsResolver.cs new file mode 100644 index 0000000000..ded4d4972e --- /dev/null +++ b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldTestsResolver.cs @@ -0,0 +1,176 @@ +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings; +using Rubberduck.Refactorings.EncapsulateField; +using Rubberduck.Refactorings.ReplaceReferences; +using Rubberduck.Refactorings.ReplacePrivateUDTMemberReferences; +using Rubberduck.Refactorings.ReplaceDeclarationIdentifier; +using Rubberduck.Refactorings.EncapsulateFieldUseBackingUDTMember; +using Rubberduck.Refactorings.EncapsulateFieldUseBackingField; +using Rubberduck.Refactorings.EncapsulateFieldInsertNewCode; +using Rubberduck.SmartIndenter; +using RubberduckTests.Settings; +using Rubberduck.Refactorings.ModifyUserDefinedType; +using Castle.Windsor; +using Castle.Facilities.TypedFactory; +using Castle.MicroKernel.Registration; +using Moq; +using System; +using Rubberduck.Parsing.UIContext; +using Rubberduck.VBEditor.Utility; +using Rubberduck.UI.Command.Refactorings; +using Rubberduck.Interaction; +using Rubberduck.UI.Command.Refactorings.Notifiers; +using Castle.MicroKernel.SubSystems.Configuration; + +namespace RubberduckTests.Refactoring.EncapsulateField +{ + public class EncapsulateFieldTestsResolver : IWindsorInstaller + { + private readonly IDeclarationFinderProvider _declarationFinderProvider; + private readonly IRewritingManager _rewritingManager; + private readonly ICodeBuilder _codeBuilder; + private readonly IIndenter _testIndenter; + private readonly IUiDispatcher _uiDispatcher; + private readonly IRefactoringPresenterFactory _presenterFactory; + private readonly ISelectionService _selectionService; + private readonly IMessageBox _messageBox; + + private IWindsorContainer _container; + + public EncapsulateFieldTestsResolver(IDeclarationFinderProvider declarationFinderProvider, IRewritingManager rewritingManager = null, ISelectionService selectionService = null) + { + _declarationFinderProvider = declarationFinderProvider; + + _rewritingManager = rewritingManager; + + _selectionService = selectionService; + + _testIndenter = new Indenter(null, () => + { + var s = IndenterSettingsTests.GetMockIndenterSettings(); + s.VerticallySpaceProcedures = true; + s.LinesBetweenProcedures = 1; + return s; + }); + + _codeBuilder = new CodeBuilder(_testIndenter); + + _presenterFactory = new Mock().Object; + + var uiDispatcherMock = new Mock(); + uiDispatcherMock + .Setup(m => m.Invoke(It.IsAny())) + .Callback((Action action) => action.Invoke()); + + _uiDispatcher = uiDispatcherMock.Object; + + _messageBox = new Mock().Object; + } + + public void Install(IWindsorContainer container, IConfigurationStore store) + => Install(container); + + public T Resolve() where T : class => _container.Resolve() as T; + + private void Install(IWindsorContainer container) + { + _container = container; + RegisterInstances(_container); + RegisterSingletonObjects(container); + RegisterInterfaceToImplementationPairsSingleton(container); + RegisterInterfaceToImplementationPairsTransient(container); + RegisterAutoFactories(container); + } + + private void RegisterInstances(IWindsorContainer container) + { + container.Kernel.Register(Component.For().Instance(_declarationFinderProvider)); + container.Kernel.Register(Component.For().Instance(_testIndenter)); + container.Kernel.Register(Component.For().Instance(_codeBuilder)); + if (_rewritingManager != null) + { + container.Kernel.Register(Component.For().Instance(_rewritingManager)); + } + if (_selectionService != null) + { + container.Kernel.Register(Component.For().Instance(_selectionService)); + } + container.Kernel.Register(Component.For().Instance(_uiDispatcher)); + container.Kernel.Register(Component.For().Instance(_presenterFactory)); + container.Kernel.Register(Component.For().Instance(_messageBox)); + } + + private static void RegisterSingletonObjects(IWindsorContainer container) + { + container.Kernel.Register(Component.For()); + container.Kernel.Register(Component.For()); + container.Kernel.Register(Component.For()); + container.Kernel.Register(Component.For()); + container.Kernel.Register(Component.For()); + container.Kernel.Register(Component.For()); + container.Kernel.Register(Component.For()); + container.Kernel.Register(Component.For()); + container.Kernel.Register(Component.For()); + container.Kernel.Register(Component.For()); + container.Kernel.Register(Component.For()); + container.Kernel.Register(Component.For()); + container.Kernel.Register(Component.For()); + container.Kernel.Register(Component.For()); + container.Kernel.Register(Component.For>()); + } + + private static void RegisterInterfaceToImplementationPairsSingleton(IWindsorContainer container) + { + container.Kernel.Register(Component.For() + .ImplementedBy()); + + container.Kernel.Register(Component.For() + .ImplementedBy()); + + container.Kernel.Register(Component.For() + .ImplementedBy()); + + container.Kernel.Register(Component.For() + .ImplementedBy()); + + container.Kernel.Register(Component.For() + .ImplementedBy()); + + container.Kernel.Register(Component.For() + .ImplementedBy()); + + container.Kernel.Register(Component.For() + .ImplementedBy()); + + container.Kernel.Register(Component.For() + .ImplementedBy()); + + container.Kernel.Register(Component.For() + .ImplementedBy()); + } + + private static void RegisterInterfaceToImplementationPairsTransient(IWindsorContainer container) + { + container.Kernel.Register(Component.For() + .ImplementedBy() + .LifestyleTransient()); + + container.Kernel.Register(Component.For() + .ImplementedBy() + .LifestyleTransient()); + + container.Kernel.Register(Component.For() + .ImplementedBy() + .LifestyleTransient()); + } + + private static void RegisterAutoFactories(IWindsorContainer container) + { + container.Kernel.AddFacility(); + container.Kernel.Register(Component.For().AsFactory().LifestyleSingleton()); + container.Kernel.Register(Component.For().AsFactory().LifestyleSingleton()); + container.Kernel.Register(Component.For().AsFactory().LifestyleSingleton()); + } + } +} diff --git a/RubberduckTests/Refactoring/EncapsulateField/EncapsulateArrayFieldTests.cs b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateArrayFieldTests.cs similarity index 94% rename from RubberduckTests/Refactoring/EncapsulateField/EncapsulateArrayFieldTests.cs rename to RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateArrayFieldTests.cs index 70ef69a41b..2b839da70a 100644 --- a/RubberduckTests/Refactoring/EncapsulateField/EncapsulateArrayFieldTests.cs +++ b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateArrayFieldTests.cs @@ -13,10 +13,16 @@ namespace RubberduckTests.Refactoring.EncapsulateField { [TestFixture] - public class EncapsulateArrayFieldTests : InteractiveRefactoringTestBase + public class EncapsulateArrayFieldTests : EncapsulateFieldInteractiveRefactoringTest { private EncapsulateFieldTestSupport Support { get; } = new EncapsulateFieldTestSupport(); + [SetUp] + public void ExecutesBeforeAllTests() + { + Support.ResetResolver(); + } + [TestCase("Private", "mArray(5) As String", "mArray(5) As String")] [TestCase("Public", "mArray(5) As String", "mArray(5) As String")] [TestCase("Private", "mArray(5,2,3) As String", "mArray(5,2,3) As String")] @@ -31,7 +37,7 @@ public class EncapsulateArrayFieldTests : InteractiveRefactoringTestBase + public class EncapsulateFieldTests : EncapsulateFieldInteractiveRefactoringTest { private EncapsulateFieldTestSupport Support { get; } = new EncapsulateFieldTestSupport(); + [SetUp] + public void ExecutesBeforeAllTests() + { + Support.ResetResolver(); + } + [TestCase("fizz", true, "baz", true, "buzz", true)] [TestCase("fizz", false, "baz", true, "buzz", true)] [TestCase("fizz", false, "baz", false, "buzz", true)] @@ -31,7 +37,7 @@ public class EncapsulateFieldTests : InteractiveRefactoringTestBase !flags[k]) - .Select(k => k); + var notEncapsulated = flags.Keys.Where(k => !flags[k]).Select(k => k); - var encapsulated = flags.Keys.Where(k => flags[k]) - .Select(k => k); + var encapsulated = flags.Keys.Where(k => flags[k]).Select(k => k); foreach ( var variable in notEncapsulated) { @@ -91,7 +95,7 @@ public class EncapsulateFieldTests : InteractiveRefactoringTestBase !flags[k]) - .Select(k => $"{k} As Integer"); + var remainInList = flags.Keys.Where(k => !flags[k]).Select(k => $"{k} As Integer"); if (remainInList.Any()) { @@ -145,7 +148,7 @@ public class EncapsulateFieldTests : InteractiveRefactoringTestBase presenterAction = model => null; @@ -528,9 +527,9 @@ public void EncapsulateField_ModelIsNull() [Category("Encapsulate Field")] public void StandardModuleSource_ExternalReferences(bool moduleResolve) { - var sourceModuleName = "SourceModule"; - var referenceExpression = moduleResolve ? $"{sourceModuleName}." : string.Empty; - var sourceModuleCode = + var testModuleName = MockVbeBuilder.TestModuleName; + var referenceExpression = moduleResolve ? $"{testModuleName}." : string.Empty; + var testModuleCode = $@" Public th|is As Long"; @@ -545,13 +544,13 @@ public void StandardModuleSource_ExternalReferences(bool moduleResolve) End Sub Public Sub Foo() - With {sourceModuleName} + With {testModuleName} .this = bar End With End Sub "; - string classModuleReferencingCode = + var classModuleReferencingCode = $@"Option Explicit Private Const bar As Long = 7 @@ -561,7 +560,7 @@ End Sub End Sub Public Sub Foo() - With {sourceModuleName} + With {testModuleName} .this = bar End With End Sub @@ -572,25 +571,18 @@ End Sub var presenterAction = Support.SetParameters(userInput); - var sourceCodeString = sourceModuleCode.ToCodeString(); - var actualModuleCode = RefactoredCode( - sourceModuleName, - sourceCodeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, + var actualModuleCode = Support.RefactoredCode(presenterAction, testModuleCode.ToCodeString(), ("StdModule", procedureModuleReferencingCode, ComponentType.StandardModule), - ("ClassModule", classModuleReferencingCode, ComponentType.ClassModule), - (sourceModuleName, sourceCodeString.Code, ComponentType.StandardModule)); + ("ClassModule", classModuleReferencingCode, ComponentType.ClassModule)); var referencingModuleCode = actualModuleCode["StdModule"]; - StringAssert.Contains($"{sourceModuleName}.MyProperty = ", referencingModuleCode); - StringAssert.DoesNotContain($"{sourceModuleName}.{sourceModuleName}.MyProperty = ", referencingModuleCode); + StringAssert.Contains($"{testModuleName}.MyProperty = ", referencingModuleCode); + StringAssert.DoesNotContain($"{testModuleName}.{testModuleName}.MyProperty = ", referencingModuleCode); StringAssert.Contains($" .MyProperty = bar", referencingModuleCode); var referencingClassCode = actualModuleCode["ClassModule"]; - StringAssert.Contains($"{sourceModuleName}.MyProperty = ", referencingClassCode); - StringAssert.DoesNotContain($"{sourceModuleName}.{sourceModuleName}.MyProperty = ", referencingClassCode); + StringAssert.Contains($"{testModuleName}.MyProperty = ", referencingClassCode); + StringAssert.DoesNotContain($"{testModuleName}.{testModuleName}.MyProperty = ", referencingClassCode); StringAssert.Contains($" .MyProperty = bar", referencingClassCode); } diff --git a/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldRefactoringActionTests.cs b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldRefactoringActionTests.cs new file mode 100644 index 0000000000..3344bbb2fd --- /dev/null +++ b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateFieldUseBackingFieldRefactoringActionTests.cs @@ -0,0 +1,93 @@ +using NUnit.Framework; +using Rubberduck.Common; +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings; +using Rubberduck.Refactorings.EncapsulateField; +using Rubberduck.Refactorings.EncapsulateFieldUseBackingField; +using System.Collections.Generic; +using System.Linq; + +namespace RubberduckTests.Refactoring.EncapsulateField.EncapsulateFieldUseBackingField +{ + [TestFixture] + public class EncapsulateFieldUseBackingFieldRefactoringActionTests : RefactoringActionTestBase + { + private EncapsulateFieldTestSupport Support { get; } = new EncapsulateFieldTestSupport(); + + [SetUp] + public void ExecutesBeforeAllTests() + { + Support.ResetResolver(); + } + + [TestCase(false, "Name")] + [TestCase(true, "Name")] + [TestCase(false, null)] + [TestCase(true, null)] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(EncapsulateFieldUseBackingFieldRefactoringAction))] + public void EncapsulatePublicField(bool isReadOnly, string propertyIdentifier) + { + var target = "fizz"; + var inputCode = $"Public {target} As Integer"; + + EncapsulateFieldUseBackingFieldModel modelBuilder(RubberduckParserState state) + { + var modelFactory = Support.Resolve(state); + + var field = state.DeclarationFinder.MatchName(target).Single(); + var fieldModel = new FieldEncapsulationModel(field as VariableDeclaration, isReadOnly, propertyIdentifier); + return modelFactory.Create( new List() { fieldModel }); + } + + var refactoredCode = RefactoredCode(inputCode, modelBuilder); + + var resultPropertyIdentifier = propertyIdentifier ?? target.CapitalizeFirstLetter(); + + var backingField = propertyIdentifier != null + ? target + : $"{target}_1"; + + StringAssert.Contains($"Public Property Get {resultPropertyIdentifier}()", refactoredCode); + StringAssert.Contains($"{resultPropertyIdentifier} = {backingField}", refactoredCode); + + if (isReadOnly) + { + StringAssert.DoesNotContain($"Public Property Let {resultPropertyIdentifier}(", refactoredCode); + StringAssert.DoesNotContain($"{backingField} = ", refactoredCode); + } + else + { + StringAssert.Contains($"Public Property Let {resultPropertyIdentifier}(", refactoredCode); + StringAssert.Contains($"{backingField} = ", refactoredCode); + } + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(EncapsulateFieldUseBackingFieldRefactoringAction))] + public void EmptyTargetSet() + { + var target = "fizz"; + var inputCode = $"Public {target} As Integer"; + + EncapsulateFieldUseBackingFieldModel modelBuilder(RubberduckParserState state) + { + var modelFactory = Support.Resolve(state); + return modelFactory.Create(Enumerable.Empty()); + } + + var refactoredCode = RefactoredCode(inputCode, modelBuilder); + Assert.AreEqual(refactoredCode, inputCode); + } + + protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) + { + return Support.Resolve(state, rewritingManager); + } + } +} diff --git a/RubberduckTests/Refactoring/EncapsulateField/EncapsulatedUDTFieldTests.cs b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateUDTFieldTests.cs similarity index 77% rename from RubberduckTests/Refactoring/EncapsulateField/EncapsulatedUDTFieldTests.cs rename to RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateUDTFieldTests.cs index 193f0a2d8a..38adbd4a6e 100644 --- a/RubberduckTests/Refactoring/EncapsulateField/EncapsulatedUDTFieldTests.cs +++ b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingField/EncapsulateUDTFieldTests.cs @@ -5,22 +5,28 @@ using Rubberduck.Refactorings.EncapsulateField; using Rubberduck.VBEditor.SafeComWrappers; using Rubberduck.VBEditor.Utility; -using System.Collections.Generic; +using RubberduckTests.Mocks; namespace RubberduckTests.Refactoring.EncapsulateField { [TestFixture] - public class EncapsulatedUDTFieldTests : InteractiveRefactoringTestBase + public class EncapsulateUDTFieldTests : EncapsulateFieldInteractiveRefactoringTest { private EncapsulateFieldTestSupport Support { get; } = new EncapsulateFieldTestSupport(); + [SetUp] + public void ExecutesBeforeAllTests() + { + Support.ResetResolver(); + } + [TestCase("Public")] [TestCase("Private")] [Category("Refactorings")] [Category("Encapsulate Field")] public void UserDefinedType_UserAcceptsDefaults(string accessibility) { - string inputCode = + var inputCode = $@" Private Type TBar First As String @@ -29,7 +35,6 @@ End Type {accessibility} th|is As TBar"; - var presenterAction = Support.UserAcceptsDefaults(); var actualCode = Support.RefactoredCode(inputCode.ToCodeString(), presenterAction); @@ -52,7 +57,7 @@ End Type [Category("Encapsulate Field")] public void UserDefinedType_TwoFields(bool encapsulateThis, bool encapsulateThat) { - string inputCode = + var inputCode = $@" Private Type TBar First As String @@ -62,13 +67,12 @@ End Type Public th|is As TBar Public that As TBar"; - var validator = EncapsulateFieldValidationsProvider.NameOnlyValidator(NameValidators.Default); - var expectedThis = new EncapsulationIdentifiers("this", validator); - var expectedThat = new EncapsulationIdentifiers("that", validator); + var expectedThis = new EncapsulationIdentifiers("this"); + var expectedThat = new EncapsulationIdentifiers("that"); var userInput = new UserInputDataObject() - .AddUserInputSet(expectedThis.TargetFieldName, encapsulationFlag: encapsulateThis) - .AddUserInputSet(expectedThat.TargetFieldName, encapsulationFlag: encapsulateThat); + .AddUserInputSet(expectedThis.TargetFieldName, encapsulationFlag: encapsulateThis) + .AddUserInputSet(expectedThat.TargetFieldName, encapsulationFlag: encapsulateThat); var presenterAction = Support.SetParameters(userInput); @@ -130,7 +134,7 @@ End Type [Category("Encapsulate Field")] public void ModifiesCorrectUDTMemberReference_MemberAccess() { - string inputCode = + var inputCode = $@" Private Type TBar First As String @@ -149,7 +153,6 @@ End Type End Sub "; - var presenterAction = Support.UserAcceptsDefaults(); var actualCode = Support.RefactoredCode(inputCode.ToCodeString(), presenterAction); @@ -168,7 +171,7 @@ End Sub [Category("Encapsulate Field")] public void ModifiesCorrectUDTMemberReference_WithMemberAccess() { - string inputCode = + var inputCode = $@" Private Type TBar First As String @@ -193,11 +196,25 @@ End Sub "; var presenterAction = Support.UserAcceptsDefaults(); + var expectedWithThis = +@" + With this + First = arg1 + Second = arg2 + End With +"; + + var expectedWithThat = +@" + With that + .First = arg1 + .Second = arg2 + End With +"; + var actualCode = Support.RefactoredCode(inputCode.ToCodeString(), presenterAction); - StringAssert.DoesNotContain($" First = arg1", actualCode); - StringAssert.DoesNotContain($" Second = arg2", actualCode); - StringAssert.Contains($" .First = arg1", actualCode); - StringAssert.Contains($" .Second = arg2", actualCode); + StringAssert.Contains(expectedWithThis, actualCode); + StringAssert.Contains(expectedWithThat, actualCode); StringAssert.Contains("With this", actualCode); } @@ -206,8 +223,7 @@ End Sub [Category("Encapsulate Field")] public void ModifiesCorrectUDTMemberReference_WithMemberAccessExternal() { - string sourceModuleName = "SourceModule"; - string inputCode = + var inputCode = $@" Public Type TBar First As String @@ -218,10 +234,10 @@ End Type Private that As TBar "; - string module2 = + var module2 = $@" Public Sub Foo(arg1 As String, arg2 As Long) - With {sourceModuleName}.this + With {MockVbeBuilder.TestModuleName}.this .First = arg1 .Second = arg2 End With @@ -235,25 +251,18 @@ End Sub var presenterAction = Support.UserAcceptsDefaults(); - var codeString = inputCode.ToCodeString(); - - var actualModuleCode = RefactoredCode( - sourceModuleName, - codeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, - ("Module2", module2, ComponentType.StandardModule), - (sourceModuleName, codeString.Code, ComponentType.StandardModule)); + var actualModuleCode = Support.RefactoredCode(presenterAction, + (MockVbeBuilder.TestModuleName, inputCode.ToCodeString(), ComponentType.StandardModule), + ("Module2", module2, ComponentType.StandardModule)); var actualCode = actualModuleCode["Module2"]; - var sourceCode = actualModuleCode[sourceModuleName]; + var sourceCode = actualModuleCode[MockVbeBuilder.TestModuleName]; StringAssert.DoesNotContain($" First = arg1", actualCode); StringAssert.DoesNotContain($" Second = arg2", actualCode); StringAssert.Contains($" .First = arg1", actualCode); StringAssert.Contains($" .Second = arg2", actualCode); - StringAssert.Contains($"With {sourceModuleName}.This", actualCode); + StringAssert.Contains($"With {MockVbeBuilder.TestModuleName}.This", actualCode); } [TestCase("Public")] @@ -262,7 +271,7 @@ End Sub [Category("Encapsulate Field")] public void UserDefinedTypeMembersAndFields(string accessibility) { - string inputCode = + var inputCode = $@" Private Type TBar First As String @@ -275,7 +284,6 @@ Private mFizz {accessibility} t|his As TBar"; - var userInput = new UserInputDataObject() .UserSelectsField("this", "MyType") .UserSelectsField("mFoo", "Foo") @@ -311,7 +319,7 @@ Private mFizz [Category("Encapsulate Field")] public void UserDefinedTypeMember_ContainsObjects(string accessibility) { - string inputCode = + var inputCode = $@" Private Type TBar First As Class1 @@ -320,7 +328,7 @@ End Type {accessibility} th|is As TBar"; - string class1Code = + var class1Code = @"Option Explicit Public Sub Foo() @@ -332,17 +340,10 @@ End Sub var presenterAction = Support.SetParameters(userInput); - var codeString = inputCode.ToCodeString(); - var actualModuleCode = RefactoredCode( - "Module1", - codeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, - ("Class1", class1Code, ComponentType.ClassModule), - ("Module1", codeString.Code, ComponentType.StandardModule)); + var actualModuleCode = Support.RefactoredCode(presenterAction, inputCode.ToCodeString(), + ("Class1", class1Code, ComponentType.ClassModule)); - var actualCode = actualModuleCode["Module1"]; + var actualCode = actualModuleCode[MockVbeBuilder.TestModuleName]; StringAssert.Contains("Private this As TBar", actualCode); StringAssert.DoesNotContain($"this = {Support.RHSIdentifier}", actualCode); @@ -363,7 +364,7 @@ End Sub [Category("Encapsulate Field")] public void UserDefinedTypeMember_ContainsVariant(string accessibility) { - string inputCode = + var inputCode = $@" Private Type TBar First As String @@ -395,7 +396,7 @@ End Type [Category("Encapsulate Field")] public void UserDefinedTypeMember_ContainsArrays(string accessibility) { - string inputCode = + var inputCode = $@" Private Type TBar First(5) As String @@ -429,13 +430,13 @@ End Type [Category("Encapsulate Field")] public void UserDefinedTypeMembers_ExternallyDefinedType(string accessibility) { - string inputCode = + var inputCode = $@" Option Explicit {accessibility} th|is As TBar"; - string typeDefinition = + var typeDefinition = $@" Public Type TBar First As String @@ -448,19 +449,12 @@ End Type var presenterAction = Support.SetParameters(userInput); - var codeString = inputCode.ToCodeString(); - var actualModuleCode = RefactoredCode( - "Class1", - codeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, - ("Class1", codeString.Code, ComponentType.ClassModule), + var actualModuleCode = Support.RefactoredCode(presenterAction, + ("Class1", inputCode.ToCodeString(), ComponentType.ClassModule), ("Module1", typeDefinition, ComponentType.StandardModule)); Assert.AreEqual(typeDefinition, actualModuleCode["Module1"]); - var actualCode = actualModuleCode["Class1"]; StringAssert.Contains("Private this As TBar", actualCode); @@ -483,13 +477,13 @@ End Type [Category("Encapsulate Field")] public void UserDefinedTypeMembers_ObjectField(string accessibility) { - string inputCode = + var inputCode = $@" Option Explicit {accessibility} mThe|Class As Class1"; - string classContent = + var classContent = $@" Option Explicit @@ -499,17 +493,10 @@ End Sub var presenterAction = Support.UserAcceptsDefaults(); - var codeString = inputCode.ToCodeString(); - var actualModuleCode = RefactoredCode( - "Module1", - codeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, - ("Class1", classContent, ComponentType.ClassModule), - ("Module1", codeString.Code, ComponentType.StandardModule)); + var actualModuleCode = Support.RefactoredCode(presenterAction, inputCode.ToCodeString(), + ("Class1", classContent, ComponentType.ClassModule)); - var actualCode = actualModuleCode["Module1"]; + var actualCode = actualModuleCode[MockVbeBuilder.TestModuleName]; StringAssert.Contains($"Private mTheClass As Class1", actualCode); StringAssert.Contains($"Set mTheClass = {Support.RHSIdentifier}", actualCode); @@ -560,16 +547,9 @@ End Sub var presenterAction = Support.SetParameters(userInput); - var sourceCodeString = sourceModuleCode.ToCodeString(); - - var actualModuleCode = RefactoredCode( - sourceModuleName, - sourceCodeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, - ("StdModule", moduleReferencingCode, ComponentType.StandardModule), - (sourceModuleName, sourceCodeString.Code, ComponentType.StandardModule)); + var actualModuleCode = Support.RefactoredCode(presenterAction, + (sourceModuleName, sourceModuleCode.ToCodeString(), ComponentType.StandardModule), + ("StdModule", moduleReferencingCode, ComponentType.StandardModule)); var referencingModuleCode = actualModuleCode["StdModule"]; StringAssert.Contains($"{sourceModuleName}.MyType.First = ", referencingModuleCode); @@ -577,96 +557,6 @@ End Sub StringAssert.Contains($" .MyType.Second = ", referencingModuleCode); } - private IDictionary Scenario_StdModuleSource_StandardAndClassReferencingModules(string referenceQualifier, string typeDeclarationAccessibility, string sourceModuleName, UserInputDataObject userInput) - { - var sourceModuleCode = -$@" -{typeDeclarationAccessibility} Type TBar - First As String - Second As Long -End Type - -Public th|is As TBar"; - - var procedureModuleReferencingCode = -$@"Option Explicit - -'StdModule referencing the UDT - -Private Const foo As String = ""Foo"" - -Private Const bar As Long = 7 - -Public Sub Foo() - {referenceQualifier}.First = foo -End Sub - -Public Sub Bar() - {referenceQualifier}.Second = bar -End Sub - -Public Sub FooBar() - With {sourceModuleName} - .this.First = foo - .this.Second = bar - End With -End Sub -"; - - string classModuleReferencingCode = -$@"Option Explicit - -'ClassModule referencing the UDT - -Private Const foo As String = ""Foo"" - -Private Const bar As Long = 7 - -Public Sub Foo() - {referenceQualifier}.First = foo -End Sub - -Public Sub Bar() - {referenceQualifier}.Second = bar -End Sub - -Public Sub FooBar() - With {sourceModuleName} - .this.First = foo - .this.Second = bar - End With -End Sub -"; - - var presenterAction = Support.SetParameters(userInput); - - var sourceCodeString = sourceModuleCode.ToCodeString(); - - //Only Public Types are accessible to ClassModules - if (typeDeclarationAccessibility.Equals("Public")) - { - return RefactoredCode( - sourceModuleName, - sourceCodeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, - ("StdModule", procedureModuleReferencingCode, ComponentType.StandardModule), - ("ClassModule", classModuleReferencingCode, ComponentType.ClassModule), - (sourceModuleName, sourceCodeString.Code, ComponentType.StandardModule)); - } - var actualModuleCode = RefactoredCode( - sourceModuleName, - sourceCodeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, - ("StdModule", procedureModuleReferencingCode, ComponentType.StandardModule), - (sourceModuleName, sourceCodeString.Code, ComponentType.StandardModule)); - - return actualModuleCode; - } - [Test] [Category("Refactorings")] [Category("Encapsulate Field")] @@ -679,8 +569,7 @@ public void ClassModuleUDTFieldSelection_ExternalReferences_ClassModule() Public th|is As TBar"; - - string classModuleReferencingCode = + var classModuleReferencingCode = $@"Option Explicit Private {sourceClassName} As {sourceModuleName} @@ -712,16 +601,9 @@ End Sub var presenterAction = Support.SetParameters(userInput); - var sourceCodeString = sourceModuleCode.ToCodeString(); - - var actualModuleCode = RefactoredCode( - sourceModuleName, - sourceCodeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, - ("ClassModule", classModuleReferencingCode, ComponentType.ClassModule), - (sourceModuleName, sourceCodeString.Code, ComponentType.ClassModule)); + var actualModuleCode = Support.RefactoredCode(presenterAction, + (sourceModuleName, sourceModuleCode.ToCodeString(), ComponentType.ClassModule), + ("ClassModule", classModuleReferencingCode, ComponentType.ClassModule)); var referencingClassCode = actualModuleCode["ClassModule"]; StringAssert.Contains($"{sourceClassName}.MyType.First = ", referencingClassCode); @@ -729,14 +611,13 @@ End Sub StringAssert.Contains($" .MyType.Second = ", referencingClassCode); } - [Test] [Category("Refactorings")] [Category("Encapsulate Field")] public void ClassModuleUDTFieldSelection_ExternalReferences_StdModule() { - var sourceModuleName = "SourceModule"; - var sourceClassName = "theClass"; + var classModuleName = "SourceModule"; + var classInstanceName = "theClass"; var sourceModuleCode = $@" @@ -750,24 +631,24 @@ public void ClassModuleUDTFieldSelection_ExternalReferences_StdModule() Second As Long End Type -Private {sourceClassName} As {sourceModuleName} +Private {classInstanceName} As {classModuleName} Private Const foo As String = ""Foo"" Private Const bar As Long = 7 Public Sub Initialize() - Set {sourceClassName} = New {sourceModuleName} + Set {classInstanceName} = New {classModuleName} End Sub Public Sub Foo() - {sourceClassName}.this.First = foo + {classInstanceName}.this.First = foo End Sub Public Sub Bar() - {sourceClassName}.this.Second = bar + {classInstanceName}.this.Second = bar End Sub Public Sub FooBar() - With {sourceClassName} + With {classInstanceName} .this.First = foo .this.Second = bar End With @@ -779,20 +660,13 @@ End Sub var presenterAction = Support.SetParameters(userInput); - var sourceCodeString = sourceModuleCode.ToCodeString(); - - var actualModuleCode = RefactoredCode( - sourceModuleName, - sourceCodeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, - ("StdModule", procedureModuleReferencingCode, ComponentType.StandardModule), - (sourceModuleName, sourceCodeString.Code, ComponentType.ClassModule)); + var actualModuleCode = Support.RefactoredCode(presenterAction, + (classModuleName, sourceModuleCode.ToCodeString(), ComponentType.ClassModule), + ("StdModule", procedureModuleReferencingCode, ComponentType.StandardModule)); var referencingModuleCode = actualModuleCode["StdModule"]; - StringAssert.Contains($"{sourceClassName}.MyType.First = ", referencingModuleCode); - StringAssert.Contains($"{sourceClassName}.MyType.Second = ", referencingModuleCode); + StringAssert.Contains($"{classInstanceName}.MyType.First = ", referencingModuleCode); + StringAssert.Contains($"{classInstanceName}.MyType.Second = ", referencingModuleCode); StringAssert.Contains($" .MyType.Second = ", referencingModuleCode); } @@ -801,7 +675,7 @@ End Sub [Category("Encapsulate Field")] public void UserDefinedTypeUserUpdatesToBeReadOnly() { - string inputCode = + var inputCode = $@" Private Type TBar First As String @@ -826,7 +700,7 @@ End Type [Category("Encapsulate Field")] public void MultipleUserDefinedTypesOfSameName() { - string inputCode = + var inputCode = $@" Option Explicit @@ -838,7 +712,7 @@ End Type Public mF|oo As TBar "; - string module2Content = + var module2Content = $@" Public Type TBar FirstVal As Long @@ -848,19 +722,9 @@ End Type var presenterAction = Support.UserAcceptsDefaults(); - var codeString = inputCode.ToCodeString(); - var actualModuleCode = RefactoredCode( - "Module1", - codeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, - ("Module2", module2Content, ComponentType.StandardModule), - ("Module1", codeString.Code, ComponentType.StandardModule)); - - var actualCode = actualModuleCode["Module1"]; - - StringAssert.Contains($"Public Property Let FirstValue(", actualCode); + var actualModuleCode = Support.RefactoredCode(presenterAction, inputCode.ToCodeString(), + ("Module2", module2Content, ComponentType.StandardModule)); + StringAssert.Contains($"Public Property Let FirstValue(", actualModuleCode[MockVbeBuilder.TestModuleName]); } [Test] @@ -868,7 +732,7 @@ End Type [Category("Encapsulate Field")] public void UDTMemberPropertyConflictsWithExistingFunction() { - string inputCode = + var inputCode = $@" Private Type TBar First As String @@ -894,7 +758,7 @@ End Type [Category("Encapsulate Field")] public void UDTMemberIsPrivateUDT() { - string inputCode = + var inputCode = $@" Private Type TFoo @@ -923,7 +787,7 @@ End Type [Category("Encapsulate Field")] public void UDTMemberIsPrivateUDT_RepeatedType() { - string inputCode = + var inputCode = $@" Private Type TFoo @@ -956,7 +820,7 @@ End Type [Category("Encapsulate Field")] public void UDTMemberIsPublicUDT() { - string inputCode = + var inputCode = $@" Public Type TFoo diff --git a/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberTests.cs b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberTests.cs new file mode 100644 index 0000000000..a61579b203 --- /dev/null +++ b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateFieldUseBackingUDTMemberTests.cs @@ -0,0 +1,329 @@ +using NUnit.Framework; +using Rubberduck.Common; +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings; +using Rubberduck.Refactorings.EncapsulateField; +using Rubberduck.Refactorings.EncapsulateFieldUseBackingUDTMember; +using RubberduckTests.Mocks; +using System.Collections.Generic; +using System.Linq; + +namespace RubberduckTests.Refactoring.EncapsulateField.EncapsulateFieldUseBackingUDTMember +{ + [TestFixture] + public class EncapsulateFieldUseBackingUDTMemberTests : RefactoringActionTestBase + { + private EncapsulateFieldTestSupport Support { get; } = new EncapsulateFieldTestSupport(); + + [SetUp] + public void ExecutesBeforeAllTests() + { + Support.ResetResolver(); + } + + [TestCase(false, "Name")] + [TestCase(true, "Name")] + [TestCase(false, null)] + [TestCase(true, null)] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(EncapsulateFieldUseBackingUDTMemberRefactoringAction))] + public void EncapsulatePublicField(bool isReadOnly, string propertyIdentifier) + { + var target = "fizz"; + var inputCode = $"Public {target} As Integer"; + + EncapsulateFieldUseBackingUDTMemberModel modelBuilder(RubberduckParserState state) + { + var modelFactory = Support.Resolve(state); + + var field = state.DeclarationFinder.MatchName(target).Single(); + var fieldModel = new FieldEncapsulationModel(field as VariableDeclaration, isReadOnly); + return modelFactory.Create(new List() { fieldModel }); + } + + var refactoredCode = RefactoredCode(inputCode, modelBuilder); + + var resultPropertyIdentifier = target.CapitalizeFirstLetter(); + + var backingFieldexpression = propertyIdentifier != null + ? $"this.{resultPropertyIdentifier}" + : $"this.{resultPropertyIdentifier}"; + + StringAssert.Contains($"T{MockVbeBuilder.TestModuleName}", refactoredCode); + StringAssert.Contains($"Public Property Get {resultPropertyIdentifier}()", refactoredCode); + StringAssert.Contains($"{resultPropertyIdentifier} = {backingFieldexpression}", refactoredCode); + + if (isReadOnly) + { + StringAssert.DoesNotContain($"Public Property Let {resultPropertyIdentifier}(", refactoredCode); + StringAssert.DoesNotContain($"{backingFieldexpression} = ", refactoredCode); + } + else + { + StringAssert.Contains($"Public Property Let {resultPropertyIdentifier}(", refactoredCode); + StringAssert.Contains($"{backingFieldexpression} = ", refactoredCode); + } + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(EncapsulateFieldUseBackingUDTMemberRefactoringAction))] + public void EncapsulatePublicFields_ExistingObjectStateUDT() + { + var inputCode = +$@" +Option Explicit + +Private Type T{MockVbeBuilder.TestModuleName} + FirstValue As Long + SecondValue As String +End Type + +Private this As T{MockVbeBuilder.TestModuleName} + +Public thirdValue As Integer + +Public bazz As String"; + + EncapsulateFieldUseBackingUDTMemberModel modelBuilder(RubberduckParserState state) + { + var modelFactory = Support.Resolve(state); + + var firstValueField = state.DeclarationFinder.MatchName("thirdValue").Single(d => d.DeclarationType.HasFlag(DeclarationType.Variable)); + var bazzField = state.DeclarationFinder.MatchName("bazz").Single(); + var fieldModelfirstValueField = new FieldEncapsulationModel(firstValueField as VariableDeclaration); + var fieldModelfirstbazzField = new FieldEncapsulationModel(bazzField as VariableDeclaration); + var inputList = new List() { fieldModelfirstValueField, fieldModelfirstbazzField }; + return modelFactory.Create(inputList); + } + + var refactoredCode = RefactoredCode(inputCode, modelBuilder); + + StringAssert.Contains($" ThirdValue As Integer", refactoredCode); + StringAssert.Contains($"Property Get ThirdValue", refactoredCode); + StringAssert.Contains($" ThirdValue = this.ThirdValue", refactoredCode); + + StringAssert.Contains($"Property Let ThirdValue", refactoredCode); + StringAssert.Contains($" this.ThirdValue =", refactoredCode); + + StringAssert.Contains($" Bazz As String", refactoredCode); + StringAssert.Contains($"Property Get Bazz", refactoredCode); + StringAssert.Contains($" Bazz = this.Bazz", refactoredCode); + + StringAssert.Contains($"Property Let Bazz", refactoredCode); + StringAssert.Contains($" this.Bazz =", refactoredCode); + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(EncapsulateFieldUseBackingUDTMemberRefactoringAction))] + public void EncapsulatePublicFields_ExistingUDT() + { + var inputCode = +$@" +Option Explicit + +Private Type TestType + FirstValue As Long + SecondValue As String +End Type + +Private this As TestType + +Public thirdValue As Integer + +Public bazz As String"; + + EncapsulateFieldUseBackingUDTMemberModel modelBuilder(RubberduckParserState state) + { + var modelFactory = Support.Resolve(state); + + var thirdValueField = state.DeclarationFinder.MatchName("thirdValue").Single(d => d.DeclarationType.HasFlag(DeclarationType.Variable)); + var bazzField = state.DeclarationFinder.MatchName("bazz").Single(); + var fieldModelThirdValueField = new FieldEncapsulationModel(thirdValueField as VariableDeclaration); + var fieldModelBazzField = new FieldEncapsulationModel(bazzField as VariableDeclaration); + + var inputList = new List() { fieldModelThirdValueField, fieldModelBazzField }; + + var targetUDT = state.DeclarationFinder.MatchName("this").Single(d => d.DeclarationType.HasFlag(DeclarationType.Variable)); + + return modelFactory.Create(inputList, targetUDT); + } + + var refactoredCode = RefactoredCode(inputCode, modelBuilder); + + StringAssert.DoesNotContain($"T{ MockVbeBuilder.TestModuleName}", refactoredCode); + + StringAssert.Contains($" ThirdValue As Integer", refactoredCode); + StringAssert.Contains($"Property Get ThirdValue", refactoredCode); + StringAssert.Contains($" ThirdValue = this.ThirdValue", refactoredCode); + + StringAssert.Contains($"Property Let ThirdValue", refactoredCode); + StringAssert.Contains($" this.ThirdValue =", refactoredCode); + + StringAssert.Contains($" Bazz As String", refactoredCode); + StringAssert.Contains($"Property Get Bazz", refactoredCode); + StringAssert.Contains($" Bazz = this.Bazz", refactoredCode); + + StringAssert.Contains($"Property Let Bazz", refactoredCode); + StringAssert.Contains($" this.Bazz =", refactoredCode); + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(EncapsulateFieldUseBackingUDTMemberRefactoringAction))] + public void EncapsulatePublicFields_NestedPathForPrivateUDTField() + { + var inputCode = +$@" +Option Explicit + +Private Type TVehicle + Wheels As Integer +End Type + +Private mVehicle As TVehicle +"; + + EncapsulateFieldUseBackingUDTMemberModel modelBuilder(RubberduckParserState state) + { + var modelFactory = Support.Resolve(state); + + var mVehicleField = state.DeclarationFinder.UserDeclarations(DeclarationType.Variable).Single(d => d.IdentifierName.Equals("mVehicle")); + var fieldModelMVehicleField = new FieldEncapsulationModel(mVehicleField as VariableDeclaration, false, "Vehicle"); + + var inputList = new List() { fieldModelMVehicleField }; + + return modelFactory.Create(inputList); + } + + var refactoredCode = RefactoredCode(inputCode, modelBuilder); + + StringAssert.Contains($"T{ MockVbeBuilder.TestModuleName}", refactoredCode); + + StringAssert.Contains($" Vehicle As TVehicle", refactoredCode); + StringAssert.Contains($"Property Get Wheels", refactoredCode); + StringAssert.Contains($" Wheels = this.Vehicle.Wheels", refactoredCode); + + StringAssert.Contains($"Property Let Wheels", refactoredCode); + StringAssert.Contains($" this.Vehicle.Wheels =", refactoredCode); + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(EncapsulateFieldUseBackingUDTMemberRefactoringAction))] + public void EncapsulatePublicFields_DifferentLevelForNestedProperties() + { + var inputCode = +$@" +Option Explicit + +Private Type FirstType + FirstValue As Integer +End Type + +Private Type SecondType + SecondValue As Integer + FirstTypeValue As FirstType +End Type + +Private Type ThirdType + ThirdValue As SecondType +End Type + +Private mTest As ThirdType +"; + + EncapsulateFieldUseBackingUDTMemberModel modelBuilder(RubberduckParserState state) + { + var modelFactory = Support.Resolve(state); + + var mTestField = state.DeclarationFinder.UserDeclarations(DeclarationType.Variable).Single(d => d.IdentifierName.Equals("mTest")); + var fieldModelMTest = new FieldEncapsulationModel(mTestField as VariableDeclaration, false); + + var inputList = new List() { fieldModelMTest }; + + return modelFactory.Create(inputList); + } + + var refactoredCode = RefactoredCode(inputCode, modelBuilder); + + StringAssert.Contains($"T{ MockVbeBuilder.TestModuleName}", refactoredCode); + + StringAssert.Contains($" Test As ThirdType", refactoredCode); + StringAssert.Contains($"Property Get FirstValue", refactoredCode); + StringAssert.Contains($"Property Get SecondValue", refactoredCode); + + StringAssert.Contains($" this.Test.ThirdValue.FirstTypeValue.FirstValue =", refactoredCode); + StringAssert.Contains($" this.Test.ThirdValue.SecondValue =", refactoredCode); + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(EncapsulateFieldUseBackingUDTMemberRefactoringAction))] + public void EmptyTargetSet_Throws() + { + var inputCode = $"Public fizz As Integer"; + + EncapsulateFieldUseBackingUDTMemberModel modelBuilder(RubberduckParserState state) + { + var modelFactory = Support.Resolve(state); + return modelFactory.Create(Enumerable.Empty()); + } + + Assert.Throws(() => RefactoredCode(inputCode, modelBuilder)); + } + + [TestCase("notAUserDefinedTypeField")] + [TestCase("notAnOption")] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(EncapsulateFieldUseBackingUDTMemberRefactoringAction))] + public void InvalidObjectStateTarget_Throws(string objectStateTargetIdentifier) + { + var inputCode = +$@" +Option Explicit + +Public Type CannotUseThis + FirstValue As Long + SecondValue As String +End Type + +Private Type TestType + FirstValue As Long + SecondValue As String +End Type + +Private this As TestType + +Public notAnOption As CannotUseThis + +Public notAUserDefinedTypeField As String"; + + EncapsulateFieldUseBackingUDTMemberModel modelBuilder(RubberduckParserState state) + { + var invalidTarget = state.DeclarationFinder.MatchName(objectStateTargetIdentifier).Single(d => d.DeclarationType.HasFlag(DeclarationType.Variable)); + var modelFactory = Support.Resolve(state); + var fieldModel = new FieldEncapsulationModel(invalidTarget as VariableDeclaration); + + return modelFactory.Create(new List() { fieldModel }, invalidTarget); + } + + Assert.Throws(() => RefactoredCode(inputCode, modelBuilder)); + } + + protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) + { + return Support.Resolve(state, rewritingManager); + } + } +} diff --git a/RubberduckTests/Refactoring/EncapsulateField/EncapsulateUsingStateUDTTests.cs b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateUsingStateUDTTests.cs similarity index 85% rename from RubberduckTests/Refactoring/EncapsulateField/EncapsulateUsingStateUDTTests.cs rename to RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateUsingStateUDTTests.cs index a83896ae6f..76cf0aa640 100644 --- a/RubberduckTests/Refactoring/EncapsulateField/EncapsulateUsingStateUDTTests.cs +++ b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldUseBackingUDTMember/EncapsulateUsingStateUDTTests.cs @@ -13,16 +13,22 @@ namespace RubberduckTests.Refactoring.EncapsulateField { [TestFixture] - public class EncapsulateUsingStateUDTTests : InteractiveRefactoringTestBase + public class EncapsulateUsingStateUDTTests : EncapsulateFieldInteractiveRefactoringTest { private EncapsulateFieldTestSupport Support { get; } = new EncapsulateFieldTestSupport(); + [SetUp] + public void ExecutesBeforeAllTests() + { + Support.ResetResolver(); + } + [Test] [Category("Refactorings")] [Category("Encapsulate Field")] public void EncapsulatePrivateFieldAsUDT() { - const string inputCode = + var inputCode = @"|Private fizz As Integer"; var presenterAction = Support.SetParametersForSingleTarget("fizz", "Name", asUDT: true); @@ -38,7 +44,7 @@ public void EncapsulatePrivateFieldAsUDT() [Category("Encapsulate Field")] public void UserDefinedType_UserAcceptsDefaults_ConflictWithStateUDT(string accessibility) { - string inputCode = + var inputCode = $@" Private Type TBar First As String @@ -49,11 +55,10 @@ End Type Private this As Long"; - var presenterAction = Support.UserAcceptsDefaults(convertFieldToUDTMember: true); var actualCode = Support.RefactoredCode(inputCode.ToCodeString(), presenterAction); StringAssert.Contains("Private this As Long", actualCode); - StringAssert.Contains($"Private this_1 As {Support.StateUDTDefaultType}", actualCode); + StringAssert.Contains($"Private this_1 As {Support.StateUDTDefaultTypeName}", actualCode); } [Test] @@ -61,7 +66,7 @@ End Type [Category("Encapsulate Field")] public void UserDefinedTypeMembers_OnlyEncapsulateUDTMembers() { - string inputCode = + var inputCode = $@" Private Type TBar First As String @@ -70,7 +75,6 @@ End Type Private my|Bar As TBar"; - var userInput = new UserInputDataObject() .UserSelectsField("myBar"); @@ -92,7 +96,7 @@ End Type [Category("Encapsulate Field")] public void UserDefinedTypeMembers_UDTFieldReferences() { - string inputCode = + var inputCode = $@" Private Type TBar First As String @@ -105,7 +109,6 @@ End Type myBar.First = newValue End Sub"; - var userInput = new UserInputDataObject() .UserSelectsField("myBar"); @@ -122,7 +125,7 @@ End Type [Category("Encapsulate Field")] public void LoadsExistingUDT() { - string inputCode = + var inputCode = $@" Private Type TBar First As String @@ -145,7 +148,7 @@ End Type var presenterAction = Support.SetParameters(userInput); var actualCode = Support.RefactoredCode(inputCode.ToCodeString(), presenterAction); - StringAssert.DoesNotContain($"Private this As {Support.StateUDTDefaultType}", actualCode); + StringAssert.DoesNotContain($"Private this As {Support.StateUDTDefaultTypeName}", actualCode); StringAssert.Contains("Foo As Long", actualCode); StringAssert.DoesNotContain("Public foo As Long", actualCode); StringAssert.Contains("Bar As String", actualCode); @@ -163,7 +166,7 @@ End Type [Category("Encapsulate Field")] public void DoesNotChangeExistingUDTMembers() { - string inputCode = + var inputCode = $@" Private Type T{MockVbeBuilder.TestModuleName} Name As String @@ -200,7 +203,7 @@ End Property [Category("Encapsulate Field")] public void MultipleFields() { - string inputCode = + var inputCode = $@" Public fo|o As Long Public bar As String @@ -216,8 +219,8 @@ public void MultipleFields() var presenterAction = Support.SetParameters(userInput); var actualCode = Support.RefactoredCode(inputCode.ToCodeString(), presenterAction); - StringAssert.Contains($"Private this As {Support.StateUDTDefaultType}", actualCode); - StringAssert.Contains($"Private Type {Support.StateUDTDefaultType}", actualCode); + StringAssert.Contains($"Private this As {Support.StateUDTDefaultTypeName}", actualCode); + StringAssert.Contains($"Private Type {Support.StateUDTDefaultTypeName}", actualCode); StringAssert.Contains("Foo As Long", actualCode); StringAssert.Contains("Bar As String", actualCode); StringAssert.Contains("Foobar As Byte", actualCode); @@ -228,7 +231,7 @@ public void MultipleFields() [Category("Encapsulate Field")] public void UserDefinedType_MultipleFieldsWithUDT() { - string inputCode = + var inputCode = $@" Private Type TBar @@ -262,7 +265,7 @@ End Type [Category("Encapsulate Field")] public void UserDefinedType_MultipleFieldsOfSameUDT() { - string inputCode = + var inputCode = $@" Private Type TBar @@ -290,7 +293,7 @@ End Type [Category("Encapsulate Field")] public void UserDefinedType_PrivateEnumField() { - const string inputCode = + var inputCode = @" Private Enum NumberTypes Whole = -1 @@ -301,7 +304,6 @@ End Enum Public numberT|ype As NumberTypes "; - var userInput = new UserInputDataObject() .UserSelectsField("numberType"); @@ -322,7 +324,7 @@ End Enum public void UserDefinedType_BoundedArrayField(string arrayIdentifier, string dimensions) { var selectedInput = arrayIdentifier.Replace("n", "n|"); - string inputCode = + var inputCode = $@" Public {selectedInput}({dimensions}) As String "; @@ -347,7 +349,7 @@ public void UserDefinedType_BoundedArrayField(string arrayIdentifier, string dim public void UserDefinedType_LocallyReferencedArray(string arrayIdentifier, string dimensions) { var selectedInput = arrayIdentifier.Replace("n", "n|"); - string inputCode = + var inputCode = $@" Public {selectedInput}({dimensions}) As String @@ -376,7 +378,7 @@ End Property public void UserDefinedTypeDefaultNameHasConflict() { var expectedIdentifier = "TTestModule1_1"; - string inputCode = + var inputCode = $@" Private Type TBar @@ -396,7 +398,6 @@ End Type .UserSelectsField("foo") .UserSelectsField("myBar"); - userInput.EncapsulateUsingUDTField(); var presenterAction = Support.SetParameters(userInput); @@ -410,7 +411,7 @@ End Type [Category("Encapsulate Field")] public void ObjectStateUDTs(string udtFieldAccessibility, int expectedCount) { - string inputCode = + var inputCode = $@" Private Type TBar First As String @@ -441,7 +442,7 @@ Private mFizz [Category("Encapsulate Field")] public void UDTMemberIsPrivateUDT() { - string inputCode = + var inputCode = $@" Private Type TFoo @@ -474,7 +475,7 @@ End Type [Category("Encapsulate Field")] public void UDTMemberIsPublicUDT() { - string inputCode = + var inputCode = $@" Public Type TFoo @@ -500,55 +501,18 @@ End Type StringAssert.Contains($"this.MyBar.FooBar = {Support.RHSIdentifier}", actualCode); } - [Test] - [Category("Refactorings")] - [Category("Encapsulate Field")] - public void UDTMemberIsPrivateUDT_RepeatedType() - { - string inputCode = -$@" - -Private Type TFoo - Foo As Integer - Bar As Byte -End Type - -Private Type TBar - FooBar As TFoo - ReBar As TFoo -End Type - -Private my|Bar As TBar -"; - - var userInput = new UserInputDataObject(); - - userInput.EncapsulateUsingUDTField(); - - var presenterAction = Support.SetParameters(userInput); - - var actualCode = Support.RefactoredCode(inputCode.ToCodeString(), presenterAction); - - StringAssert.Contains("Public Property Let Foo(", actualCode); - StringAssert.Contains("Public Property Let Bar(", actualCode); - StringAssert.Contains("Public Property Let Foo_1(", actualCode); - StringAssert.Contains("Public Property Let Bar_1(", actualCode); - StringAssert.Contains($"this.MyBar.FooBar.Foo = {Support.RHSIdentifier}", actualCode); - StringAssert.Contains($"this.MyBar.ReBar.Foo = {Support.RHSIdentifier}", actualCode); - } - [Test] [Category("Refactorings")] [Category("Encapsulate Field")] public void GivenReferencedPublicField_UpdatesReferenceToNewProperty() { - const string codeClass1 = + var codeClass1 = @"|Public fizz As Integer Sub Foo() fizz = 1 End Sub"; - const string codeClass2 = + var codeClass2 = @"Sub Foo() Dim theClass As Class1 theClass.fizz = 0 @@ -565,20 +529,14 @@ Sub Bar(ByVal v As Integer) var presenterAction = Support.SetParameters(userInput); - var class1CodeString = codeClass1.ToCodeString(); - var actualCode = RefactoredCode( - "Class1", - class1CodeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, - ("Class1", class1CodeString.Code, ComponentType.ClassModule), + var refactoredCode = Support.RefactoredCode(presenterAction, + ("Class1", codeClass1.ToCodeString(), ComponentType.ClassModule), ("Class2", codeClass2, ComponentType.ClassModule)); - StringAssert.Contains("Name = 1", actualCode["Class1"]); - StringAssert.Contains("theClass.Name = 0", actualCode["Class2"]); - StringAssert.Contains("Bar theClass.Name", actualCode["Class2"]); - StringAssert.DoesNotContain("fizz", actualCode["Class2"]); + StringAssert.Contains("Name = 1", refactoredCode["Class1"]); + StringAssert.Contains("theClass.Name = 0", refactoredCode["Class2"]); + StringAssert.Contains("Bar theClass.Name", refactoredCode["Class2"]); + StringAssert.DoesNotContain("fizz", refactoredCode["Class2"]); } [TestCase(false)] @@ -610,7 +568,7 @@ End With End Sub "; - string classModuleReferencingCode = + var classModuleReferencingCode = $@"Option Explicit Private Const bar As Long = 7 @@ -633,23 +591,17 @@ End Sub var presenterAction = Support.SetParameters(userInput); - var sourceCodeString = sourceModuleCode.ToCodeString(); - var actualModuleCode = RefactoredCode( - sourceModuleName, - sourceCodeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, + var refactoredCode = Support.RefactoredCode(presenterAction, + (sourceModuleName, sourceModuleCode.ToCodeString(), ComponentType.StandardModule), ("StdModule", procedureModuleReferencingCode, ComponentType.StandardModule), - ("ClassModule", classModuleReferencingCode, ComponentType.ClassModule), - (sourceModuleName, sourceCodeString.Code, ComponentType.StandardModule)); + ("ClassModule", classModuleReferencingCode, ComponentType.ClassModule)); - var referencingModuleCode = actualModuleCode["StdModule"]; + var referencingModuleCode = refactoredCode["StdModule"]; StringAssert.Contains($"{sourceModuleName}.MyProperty = ", referencingModuleCode); StringAssert.DoesNotContain($"{sourceModuleName}.{sourceModuleName}.MyProperty = ", referencingModuleCode); StringAssert.Contains($" .MyProperty = bar", referencingModuleCode); - var referencingClassCode = actualModuleCode["ClassModule"]; + var referencingClassCode = refactoredCode["ClassModule"]; StringAssert.Contains($"{sourceModuleName}.MyProperty = ", referencingClassCode); StringAssert.DoesNotContain($"{sourceModuleName}.{sourceModuleName}.MyProperty = ", referencingClassCode); StringAssert.Contains($" .MyProperty = bar", referencingClassCode); @@ -660,7 +612,7 @@ End Sub [Category("Encapsulate Field")] public void PrivateUDT_SelectedOtherThanObjectStateUDT() { - string inputCode = + var inputCode = $@" Private Type TTest diff --git a/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldValidatorTests.cs b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldValidatorTests.cs index f2646bdb62..6a1d02a925 100644 --- a/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldValidatorTests.cs +++ b/RubberduckTests/Refactoring/EncapsulateField/EncapsulateFieldValidatorTests.cs @@ -7,21 +7,29 @@ using Rubberduck.VBEditor.Utility; using Rubberduck.Parsing.Symbols; using Rubberduck.VBEditor.SafeComWrappers; +using System.Linq; +using Rubberduck.Resources; namespace RubberduckTests.Refactoring.EncapsulateField { [TestFixture] - public class EncapsulateFieldValidatorTests : InteractiveRefactoringTestBase + public class EncapsulateFieldValidatorTests : EncapsulateFieldInteractiveRefactoringTest { private EncapsulateFieldTestSupport Support { get; } = new EncapsulateFieldTestSupport(); + [SetUp] + public void ExecutesBeforeAllTests() + { + Support.ResetResolver(); + } + [TestCase("fizz", "_Fizz", false)] [TestCase("fizz", "FizzProp", true)] [Category("Refactorings")] [Category("Encapsulate Field")] public void VBAIdentifier_Property(string originalFieldName, string newPropertyName, bool expectedResult) { - string inputCode = + var inputCode = $@"Public {originalFieldName} As String"; var encapsulatedField = Support.RetrieveEncapsulateFieldCandidate(inputCode, originalFieldName); @@ -36,7 +44,7 @@ public void VBAIdentifier_Property(string originalFieldName, string newPropertyN [Category("Encapsulate Field")] public void EncapsulatePrivateField_ReadOnlyRequiresSet() { - const string inputCode = + var inputCode = @"|Private fizz As Collection"; const string expectedCode = @@ -56,7 +64,7 @@ End Property [Category("Encapsulate Field")] public void PropertyNameNotDuplicated() { - const string inputCode = + var inputCode = @"Public var|iable As Integer, variable1 As Long, variable2 As Integer"; var userInput = new UserInputDataObject() @@ -80,7 +88,7 @@ public void PropertyNameNotDuplicated() [Category("Encapsulate Field")] public void UDTMemberPropertyConflictsWithExistingFunction() { - string inputCode = + var inputCode = $@" Private Type TBar First As String @@ -94,7 +102,7 @@ End Type End Function"; var candidate = Support.RetrieveEncapsulateFieldCandidate(inputCode, "myBar", DeclarationType.Variable); - var result = candidate.ConflictFinder.IsConflictingProposedIdentifier("First", candidate, DeclarationType.Property); + var result = candidate.ConflictFinder.IsConflictingIdentifier(candidate, "First", out _); Assert.AreEqual(true, result); } @@ -103,7 +111,7 @@ End Type [Category("Encapsulate Field")] public void FieldNameDefaultsToNonConflictName() { - string inputCode = + var inputCode = $@"Public fizz As String Private fizzle As String @@ -127,7 +135,7 @@ End Property [Category("Encapsulate Field")] public void UserEntersConflictingName(string userModifiedPropertyName) { - string inputCode = + var inputCode = $@"Public fizz As String Private mName As String @@ -152,7 +160,6 @@ End Property Assert.IsFalse(model["fizz"].TryValidateEncapsulationAttributes(out _)); } - [TestCase("Number", "Bazzle", true, true)] [TestCase("Number", "Number", false, false)] [TestCase("Test", "Number", false, true)] @@ -160,7 +167,7 @@ End Property [Category("Encapsulate Field")] public void UserModificationIsExistingPropertyNameConflicts(string fizz_modifiedPropertyName, string bazz_modifiedPropertyName, bool fizz_expectedResult, bool bazz_expectedResult) { - string inputCode = + var inputCode = $@"Public fizz As Integer Public bazz As Integer Public buzz As Integer @@ -176,7 +183,6 @@ public void UserModificationIsExistingPropertyNameConflicts(string fizz_modified .UserSelectsField(fieldUT, fizz_modifiedPropertyName, true) .UserSelectsField("bazz", bazz_modifiedPropertyName, true); - var presenterAction = Support.SetParameters(userInput); var model = Support.RetrieveUserModifiedModelPriorToRefactoring(inputCode, fieldUT, DeclarationType.Variable, presenterAction); @@ -193,7 +199,7 @@ public void UserModificationIsExistingPropertyNameConflicts(string fizz_modified [Category("Encapsulate Field")] public void EncapsulateMultipleUDTFields_DefaultsAreNotInConflict(string udtAccessibility, string fieldAccessibility) { - string inputCode = + var inputCode = $@" {udtAccessibility} Type TBar First As Long @@ -221,7 +227,7 @@ End Type [Category("Encapsulate Field")] public void PropertyNameConflictsWithModuleVariable() { - string inputCode = + var inputCode = $@" Public longValue As Long @@ -244,7 +250,7 @@ public void PropertyNameConflictsWithModuleVariable() public void EncapsulatePrivateField_EnumMemberConflict() { //5.2.3.4: An enum member name may not be the same as any variable name, or constant name that is defined within the same module - const string inputCode = + var inputCode = @" Public Enum NumberTypes @@ -267,7 +273,7 @@ End Enum [Category("Encapsulate Field")] public void EncapsulatePrivateField_UDTMemberConflict() { - const string inputCode = + var inputCode = @" Private Type TVehicle @@ -290,7 +296,7 @@ End Type public void DefaultPropertyNameConflictsResolved() { //Both fields default to "Test" as the property name - const string inputCode = + var inputCode = @"Private mTest As Integer Private strTest As String"; @@ -310,7 +316,7 @@ public void DefaultPropertyNameConflictsResolved() [Category("Encapsulate Field")] public void TargetNameUsedForLimitedScopeDeclarations(string localDeclaration, string parameter) { - string inputCode = + var inputCode = $@" Private te|st As Long @@ -334,7 +340,7 @@ End Function [Category("Encapsulate Field")] public void TargetReferenceScopeUsesPropertyName(string localDeclaration, string parameter) { - string inputCode = + var inputCode = $@" Private aName As String @@ -360,7 +366,7 @@ End Function [Category("Encapsulate Field")] public void TargetDefaultFieldIDConflict() { - string inputCode = + var inputCode = $@" Private tes|t As String Private test_1 As String @@ -403,10 +409,10 @@ public void ModuleAndProjectNamesAreValid(string userEnteredName) [Test] [Category("Refactorings")] [Category("Encapsulate Field")] - public void MultipleUserDefinedTypesOfSameNameOtherModule() + public void ExistingPublicUDTConflictWithDefaultObjectStateType() { - var moduleOneName = "ModuleOne"; - string inputCode = + string moduleOneName = "ModuleOne"; + var inputCode = $@" Option Explicit @@ -429,29 +435,21 @@ End Type var presenterAction = Support.SetParameters(userInput); - var codeString = inputCode.ToCodeString(); - var actualModuleCode = RefactoredCode( - moduleOneName, - codeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, - ("Module2", module2Content, ComponentType.StandardModule), - (moduleOneName, codeString.Code, ComponentType.StandardModule)); + var actualModuleCode = Support.RefactoredCode(presenterAction, + (moduleOneName, inputCode.ToCodeString(), ComponentType.StandardModule), + ("Module2", module2Content, ComponentType.StandardModule)); - var actualCode = actualModuleCode[moduleOneName]; - - StringAssert.Contains($"Private Type TModuleOne", actualCode); + StringAssert.Contains($"Private Type TModuleOne", actualModuleCode[moduleOneName]); } [TestCase("Public")] [TestCase("Private")] [Category("Refactorings")] [Category("Encapsulate Field")] - public void MultipleUserDefinedTypesOfSameNameSameModule(string accessibility) + public void ExistingUDTConflictWithDefaultObjectStateType(string accessibility) { var moduleOneName = "ModuleOne"; - string inputCode = + var inputCode = $@" Option Explicit @@ -463,7 +461,6 @@ End Type Public mF|oo As Long "; - var fieldUT = "mFoo"; var userInput = new UserInputDataObject() .UserSelectsField(fieldUT); @@ -472,18 +469,10 @@ End Type var presenterAction = Support.SetParameters(userInput); - var codeString = inputCode.ToCodeString(); - var actualModuleCode = RefactoredCode( - moduleOneName, - codeString.CaretPosition.ToOneBased(), - presenterAction, - null, - false, - (moduleOneName, codeString.Code, ComponentType.StandardModule)); + var actualModuleCode = Support.RefactoredCode(presenterAction, + (moduleOneName, inputCode.ToCodeString(), ComponentType.StandardModule)); - var actualCode = actualModuleCode[moduleOneName]; - - StringAssert.Contains($"Private Type TModuleOne_1", actualCode); + StringAssert.Contains($"Private Type TModuleOne_1", actualModuleCode[moduleOneName]); } [Test] @@ -504,7 +493,10 @@ public void UDTReservedMemberArrayIdentifier() var model = Support.RetrieveUserModifiedModelPriorToRefactoring(vbe, fieldName, DeclarationType.Variable, presenterAction); - Assert.AreEqual(false, model[fieldName].TryValidateEncapsulationAttributes(out var message), message); + Assert.AreEqual(false, model[fieldName].TryValidateEncapsulationAttributes(out var errorMessage), errorMessage); + + var expectedMessage = string.Format(RubberduckUI.InvalidNameCriteria_IsReservedKeywordFormat, fieldName); + Assert.AreEqual(expectedMessage, errorMessage); } [Test] @@ -512,7 +504,7 @@ public void UDTReservedMemberArrayIdentifier() [Category("Encapsulate Field")] public void UserEntersUDTMemberPropertyNameInConflictWithExistingField() { - const string inputCode = + var inputCode = @" Private Type TVehicle @@ -543,7 +535,7 @@ End Type [Category("Encapsulate Field")] public void UserClearsConflictingNameByEncapsulatingConflictingVariable() { - const string inputCode = + var inputCode = @" Private Type TVehicle @@ -578,7 +570,7 @@ End Type public void AddedUDTMemberConflictsWithExistingName() { var fieldUT = "mFirstValue"; - string inputCode = + var inputCode = $@" Private Type MyType @@ -601,6 +593,99 @@ End Type Assert.AreEqual(false, model[fieldUT].TryValidateEncapsulationAttributes(out var errorMessage), errorMessage); } + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + public void AddedFieldConflictsWithExistingUDTMemberName() + { + var fieldUT = "mFirstValue"; + var inputCode = + $@" + +Private Type MyType + FirstValue As Integer + SecondValue As Integer +End Type + +Private {fieldUT} As Double + +Private myType As MyType +"; + + var vbe = MockVbeBuilder.BuildFromSingleStandardModule(inputCode, out _).Object; + using (var state = MockParser.CreateAndParse(vbe)) + { + var mTypeTarget = state.DeclarationFinder.DeclarationsWithType(DeclarationType.Variable) + .First(d => d.IdentifierName == "myType"); + + var mFirstTarget = state.DeclarationFinder.DeclarationsWithType(DeclarationType.Variable) + .First(d => d.IdentifierName == fieldUT); + + Support.SetupResolver(state); + + var candidateSetsProviderFactory = Support.Resolve(); + var candidateSets = candidateSetsProviderFactory.Create(state, Support.Resolve(), mFirstTarget.QualifiedModuleName); + + var encapsulateFieldCandidates = candidateSets.EncapsulateFieldUseBackingFieldCandidates; + + var finderFactory = Support.Resolve(); + + var conflictFinder = finderFactory.Create(state, candidateSets.EncapsulateFieldUseBackingFieldCandidates, candidateSets.ObjectStateFieldCandidates); + + foreach (var candidate in encapsulateFieldCandidates) + { + candidate.ConflictFinder = conflictFinder; + } + + var mTypeCandidate = encapsulateFieldCandidates.Single(c => c.Declaration == mTypeTarget); + mTypeCandidate.EncapsulateFlag = true; + + var mFirstCandidate = encapsulateFieldCandidates.Single(c => c.Declaration == mFirstTarget); + + foreach (var candidate in encapsulateFieldCandidates) + { + candidate.EncapsulateFlag = true; + } + + var result = mFirstCandidate.TryValidateEncapsulationAttributes(out var errorMessage); + Assert.IsTrue(result, errorMessage); + } + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + public void ObjectStateUDTFieldConflictsWithAssignedProperty() + { + var fieldUT = "mFirstValue"; + var inputCode = + $@" + +Private {fieldUT} As Double +"; + + var vbe = MockVbeBuilder.BuildFromSingleStandardModule(inputCode, out _).Object; + using (var state = MockParser.CreateAndParse(vbe)) + { + var mFirstTarget = state.DeclarationFinder.DeclarationsWithType(DeclarationType.Variable) + .First(d => d.IdentifierName == fieldUT) as VariableDeclaration; + + var modelFactory = Support.Resolve(state); + var model = modelFactory.Create(mFirstTarget); + var mFirstCandidate = model[mFirstTarget.IdentifierName]; + + mFirstCandidate.EncapsulateFlag = true; + mFirstCandidate.PropertyIdentifier = "This"; + + model.EncapsulateFieldStrategy = EncapsulateFieldStrategy.ConvertFieldsToUDTMembers; + var objectStateUDT = model.ObjectStateUDTField; + + model.ConflictFinder.AssignNoConflictIdentifiers(objectStateUDT); + + StringAssert.AreEqualIgnoringCase("this_1", objectStateUDT.IdentifierName); + } + } + protected override IRefactoring TestRefactoring( IRewritingManager rewritingManager, RubberduckParserState state, diff --git a/RubberduckTests/Refactoring/EncapsulateField/EncapsulationIdentifiersTests.cs b/RubberduckTests/Refactoring/EncapsulateField/EncapsulationIdentifiersTests.cs index 810368a3c7..8c5757ca7d 100644 --- a/RubberduckTests/Refactoring/EncapsulateField/EncapsulationIdentifiersTests.cs +++ b/RubberduckTests/Refactoring/EncapsulateField/EncapsulationIdentifiersTests.cs @@ -8,12 +8,18 @@ public class EncapsulationIdentifiersTests { private EncapsulateFieldTestSupport Support { get; } = new EncapsulateFieldTestSupport(); + [SetUp] + public void ExecutesBeforeAllTests() + { + Support.ResetResolver(); + } + [Test] [Category("Refactorings")] [Category("Encapsulate Field")] public void FieldNameAttributeValidation_DefaultsToAvailableFieldName() { - string inputCode = + var inputCode = $@"Public fizz As String 'fizz1 is the intial default name for encapsulating 'fizz' @@ -36,7 +42,7 @@ End Property [Category("Encapsulate Field")] public void FieldNameValuesPerSequenceOfPropertyNameChanges() { - string inputCode = "Public fizz As String"; + var inputCode = "Public fizz As String"; var encapsulatedField = Support.RetrieveEncapsulateFieldCandidate(inputCode, "fizz"); StringAssert.AreEqualIgnoringCase("fizz_1", encapsulatedField.BackingIdentifier); @@ -61,8 +67,7 @@ public void FieldNameValuesPerSequenceOfPropertyNameChanges() [Category("Encapsulate Field")] public void AccountsForHungarianNamesAndMemberPrefix(string inputName, string expectedPropertyName, string expectedFieldName) { - var validator = EncapsulateFieldValidationsProvider.NameOnlyValidator(NameValidators.Default); - var sut = new EncapsulationIdentifiers(inputName, validator); + var sut = new EncapsulationIdentifiers(inputName); Assert.AreEqual(expectedPropertyName, sut.DefaultPropertyName); Assert.AreEqual(expectedFieldName, sut.DefaultNewFieldName); diff --git a/RubberduckTests/Refactoring/EncapsulateField/PreviewerTests.cs b/RubberduckTests/Refactoring/EncapsulateField/PreviewerTests.cs new file mode 100644 index 0000000000..b7bf02f9c0 --- /dev/null +++ b/RubberduckTests/Refactoring/EncapsulateField/PreviewerTests.cs @@ -0,0 +1,161 @@ +using NUnit.Framework; +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings; +using Rubberduck.Refactorings.EncapsulateField; +using Rubberduck.Resources; +using Rubberduck.VBEditor.SafeComWrappers; +using Rubberduck.VBEditor.Utility; +using RubberduckTests.Mocks; +using System.Linq; + +namespace RubberduckTests.Refactoring.EncapsulateField +{ + [TestFixture] + public class EncapsulateFieldPreviewerTests : EncapsulateFieldInteractiveRefactoringTest + { + private EncapsulateFieldTestSupport Support { get; } = new EncapsulateFieldTestSupport(); + + [SetUp] + public void ExecutesBeforeAllTests() + { + Support.ResetResolver(); + } + + [TestCase(EncapsulateFieldStrategy.UseBackingFields)] + [TestCase(EncapsulateFieldStrategy.ConvertFieldsToUDTMembers)] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(EncapsulateFieldPreviewProvider))] + public void Preview_EditPropertyIdentifier(EncapsulateFieldStrategy strategy) + { + var inputCode = +$@"Option Explicit + +Public mTest As Long +"; + + var vbe = MockVbeBuilder.BuildFromSingleModule(inputCode, ComponentType.StandardModule, out _); + (RubberduckParserState state, IRewritingManager rewritingManager) = MockParser.CreateAndParseWithRewritingManager(vbe.Object); + using (state) + { + Support.SetupResolver(state, rewritingManager, null); + + var target = state.DeclarationFinder.MatchName("mTest").First(); + var modelfactory = Support.Resolve(); + var model = modelfactory.Create(target); + + model.EncapsulateFieldStrategy = strategy; + var field = model["mTest"]; + field.PropertyIdentifier = "ATest"; + + var previewProvider = Support.Resolve(); + + var firstPreview = previewProvider.Preview(model); + StringAssert.Contains("Property Get ATest", firstPreview); + + field.PropertyIdentifier = "BTest"; + var secondPreview = previewProvider.Preview(model); + StringAssert.Contains("Property Get BTest", secondPreview); + StringAssert.DoesNotContain("Property Get ATest", secondPreview); + } + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(EncapsulateFieldPreviewProvider))] + public void PreviewWrapMember_EditPropertyIdentifier() + { + var inputCode = +$@"Option Explicit + +Private Type T{MockVbeBuilder.TestModuleName} + FirstValue As Long +End Type + +Private Type B{MockVbeBuilder.TestModuleName} + FirstValue As Long +End Type + +Public mTest As Long + +Private tType As T{MockVbeBuilder.TestModuleName} + +Private bType As B{MockVbeBuilder.TestModuleName} +"; + + var vbe = MockVbeBuilder.BuildFromSingleModule(inputCode, ComponentType.StandardModule, out _); + (RubberduckParserState state, IRewritingManager rewritingManager) = MockParser.CreateAndParseWithRewritingManager(vbe.Object); + using (state) + { + Support.SetupResolver(state, rewritingManager, null); + + var target = state.DeclarationFinder.MatchName("mTest").First(); + + var modelfactory = Support.Resolve(); + var model = modelfactory.Create(target); + + var field = model["mTest"]; + field.PropertyIdentifier = "ATest"; + model.EncapsulateFieldStrategy = EncapsulateFieldStrategy.ConvertFieldsToUDTMembers; + + var test = model.ObjectStateUDTCandidates; + Assert.AreEqual(3, test.Count()); + + var previewProvider = Support.Resolve(); + + var firstPreview = previewProvider.Preview(model); + StringAssert.Contains("Property Get ATest", firstPreview); + + field.PropertyIdentifier = "BTest"; + var secondPreview = previewProvider.Preview(model); + StringAssert.Contains("Property Get BTest", secondPreview); + StringAssert.DoesNotContain("Property Get ATest", secondPreview); + } + } + + [TestCase(EncapsulateFieldStrategy.UseBackingFields)] + [TestCase(EncapsulateFieldStrategy.ConvertFieldsToUDTMembers)] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(EncapsulateFieldPreviewProvider))] + public void Preview_IncludeEndOfChangesMarker(EncapsulateFieldStrategy strategy) + { + var inputCode = +$@"Option Explicit + +Public mTest As Long +"; + + var vbe = MockVbeBuilder.BuildFromSingleModule(inputCode, ComponentType.StandardModule, out _); + (RubberduckParserState state, IRewritingManager rewritingManager) = MockParser.CreateAndParseWithRewritingManager(vbe.Object); + using (state) + { + Support.SetupResolver(state, rewritingManager, null); + + var target = state.DeclarationFinder.MatchName("mTest").First(); + + var modelfactory = Support.Resolve(); + var previewProvider = Support.Resolve(); + + var model = modelfactory.Create(target); + + model.EncapsulateFieldStrategy = strategy; + + var previewResult = previewProvider.Preview(model); + + StringAssert.Contains(RubberduckUI.EncapsulateField_PreviewMarker, previewResult); + } + } + + protected override IRefactoring TestRefactoring( + IRewritingManager rewritingManager, + RubberduckParserState state, + RefactoringUserInteraction userInteraction, + ISelectionService selectionService) + { + return Support.SupportTestRefactoring(rewritingManager, state, userInteraction, selectionService); + } + } +} diff --git a/RubberduckTests/Refactoring/EncapsulateField/PropertyAttributeSetsGeneratorTests.cs b/RubberduckTests/Refactoring/EncapsulateField/PropertyAttributeSetsGeneratorTests.cs new file mode 100644 index 0000000000..ad84e08cc1 --- /dev/null +++ b/RubberduckTests/Refactoring/EncapsulateField/PropertyAttributeSetsGeneratorTests.cs @@ -0,0 +1,125 @@ +using NUnit.Framework; +using Rubberduck.Refactorings.EncapsulateField; +using System.Linq; +using RubberduckTests.Mocks; +using Rubberduck.Refactorings; + +namespace RubberduckTests.Refactoring.EncapsulateField +{ + [TestFixture] + public class PropertyAttributeSetsGeneratorTests + { + private EncapsulateFieldTestSupport Support { get; } = new EncapsulateFieldTestSupport(); + + [SetUp] + public void ExecutesBeforeAllTests() + { + Support.ResetResolver(); + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(PropertyAttributeSetsGenerator))] + public void EncapsulateFieldCandidate_PrivateUDTField() + { + var inputCode = +$@" +Option Explicit + +Private Type TVehicle + Wheels As Integer +End Type + +Private Type TObjState + FirstValue As String +End Type + +Private this As TObjState + +Private mVehicle As TVehicle +"; + + + var vbe = MockVbeBuilder.BuildFromSingleStandardModule(inputCode, out _).Object; + using (var state = MockParser.CreateAndParse(vbe)) + { + var encapsulateTarget = state.AllUserDeclarations.Single(d => d.IdentifierName.Equals("mVehicle")); + var objectStateUDTTarget = state.AllUserDeclarations.Single(d => d.IdentifierName.Equals("this")); + + var encapsulateFieldCandidateFactory = Support.Resolve(state); + + var objStateCandidate = encapsulateFieldCandidateFactory.CreateFieldCandidate(objectStateUDTTarget); + var objStateUDT = encapsulateFieldCandidateFactory.CreateObjectStateField(objStateCandidate as IUserDefinedTypeCandidate); + + var candidate = new EncapsulateFieldAsUDTMemberCandidate(encapsulateFieldCandidateFactory.CreateFieldCandidate(encapsulateTarget), objStateUDT) + { + PropertyIdentifier = "MyType" + }; + + var generator = new PropertyAttributeSetsGenerator(); + var propAttributeSets = generator.GeneratePropertyAttributeSets(candidate); + StringAssert.Contains("this.MyType.Wheels", propAttributeSets.First().BackingField); + } + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(PropertyAttributeSetsGenerator))] + public void EncapsulateFieldCandidate_DeeplyNestedUDTs() + { + var inputCode = +$@" +Option Explicit + +Private Type FirstType + DeeplyNested As Long +End Type + +Private Type SecondType + Number1Type As FirstType +End Type + +Private Type ThirdType + Number2Type As SecondType +End Type + +Private Type FourthType + Number3Type As ThirdType +End Type + +Private Type FifthType + Number4Type As FourthType +End Type + +Private Type ExistingType + ExistingValue As String +End Type + +Public mTest As FifthType + +Private this As ExistingType + +"; + + var vbe = MockVbeBuilder.BuildFromSingleStandardModule(inputCode, out _).Object; + using (var state = MockParser.CreateAndParse(vbe)) + { + var encapsulateTarget = state.AllUserDeclarations.Single(d => d.IdentifierName.Equals("mTest")); + var objectStateUDTTarget = state.AllUserDeclarations.Single(d => d.IdentifierName.Equals("this")); + + var encapsulateFieldCandidateFactory = Support.Resolve(state); + + var objStateCandidate = encapsulateFieldCandidateFactory.CreateFieldCandidate(objectStateUDTTarget); + var objStateUDT = encapsulateFieldCandidateFactory.CreateObjectStateField(objStateCandidate as IUserDefinedTypeCandidate); + + var candidate = new EncapsulateFieldAsUDTMemberCandidate(encapsulateFieldCandidateFactory.CreateFieldCandidate(encapsulateTarget), objStateUDT); + + var generator = new PropertyAttributeSetsGenerator(); + var propAttributeSets = generator.GeneratePropertyAttributeSets(candidate); + StringAssert.Contains("this.Test.Number4Type.Number3Type.Number2Type.Number1Type.DeeplyNested", propAttributeSets.First().BackingField); + } + } + } +} diff --git a/RubberduckTests/Refactoring/ExtractInterface/ExtractInterfaceRefactoringActionTests.cs b/RubberduckTests/Refactoring/ExtractInterface/ExtractInterfaceRefactoringActionTests.cs index 349300abc7..fec9afe208 100644 --- a/RubberduckTests/Refactoring/ExtractInterface/ExtractInterfaceRefactoringActionTests.cs +++ b/RubberduckTests/Refactoring/ExtractInterface/ExtractInterfaceRefactoringActionTests.cs @@ -7,10 +7,12 @@ using Rubberduck.Refactorings; using Rubberduck.Refactorings.AddInterfaceImplementations; using Rubberduck.Refactorings.ExtractInterface; +using Rubberduck.SmartIndenter; using Rubberduck.VBEditor.ComManagement; using Rubberduck.VBEditor.SafeComWrappers; using Rubberduck.VBEditor.SourceCodeHandling; using Rubberduck.VBEditor.Utility; +using RubberduckTests.Settings; namespace RubberduckTests.Refactoring { @@ -755,13 +757,13 @@ private static ExtractInterfaceModel TestModel(IDeclarationFinderProvider state, var targetClass = finder.UserDeclarations(DeclarationType.ClassModule) .OfType() .Single(module => module.IdentifierName == "Class"); - var model = new ExtractInterfaceModel(state, targetClass, new CodeBuilder()); + var model = new ExtractInterfaceModel(state, targetClass, CreateCodeBuilder()); return modelAdjustment(model); } protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) { - var addInterfaceImplementationsAction = new AddInterfaceImplementationsRefactoringAction(rewritingManager, new CodeBuilder()); + var addInterfaceImplementationsAction = new AddInterfaceImplementationsRefactoringAction(rewritingManager, CreateCodeBuilder()); var addComponentService = TestAddComponentService(state?.ProjectsProvider); return new ExtractInterfaceRefactoringAction(addInterfaceImplementationsAction, state, state, rewritingManager, state?.ProjectsProvider, addComponentService); } @@ -771,5 +773,16 @@ private static IAddComponentService TestAddComponentService(IProjectsProvider pr var sourceCodeHandler = new CodeModuleComponentSourceCodeHandler(); return new AddComponentService(projectsProvider, sourceCodeHandler, sourceCodeHandler); } + + private static ICodeBuilder CreateCodeBuilder() + => new CodeBuilder(new Indenter(null, CreateIndenterSettings)); + + private static IndenterSettings CreateIndenterSettings() + { + var s = IndenterSettingsTests.GetMockIndenterSettings(); + s.VerticallySpaceProcedures = true; + s.LinesBetweenProcedures = 1; + return s; + } } } \ No newline at end of file diff --git a/RubberduckTests/Refactoring/ExtractInterface/ExtractInterfaceTests.cs b/RubberduckTests/Refactoring/ExtractInterface/ExtractInterfaceTests.cs index 47970b8836..25d49e5937 100644 --- a/RubberduckTests/Refactoring/ExtractInterface/ExtractInterfaceTests.cs +++ b/RubberduckTests/Refactoring/ExtractInterface/ExtractInterfaceTests.cs @@ -11,12 +11,14 @@ using Rubberduck.Refactorings.AddInterfaceImplementations; using Rubberduck.Refactorings.Exceptions; using Rubberduck.Refactorings.ExtractInterface; +using Rubberduck.SmartIndenter; using Rubberduck.VBEditor; using Rubberduck.VBEditor.ComManagement; using Rubberduck.VBEditor.SafeComWrappers; using Rubberduck.VBEditor.SourceCodeHandling; using Rubberduck.VBEditor.Utility; using RubberduckTests.Mocks; +using RubberduckTests.Settings; namespace RubberduckTests.Refactoring { @@ -150,7 +152,7 @@ public void ExtractInterfaceRefactoring_IgnoresField() .First(); //Specify Params to remove - var model = new ExtractInterfaceModel(state, target, new CodeBuilder()); + var model = new ExtractInterfaceModel(state, target, CreateCodeBuilder()); Assert.AreEqual(0, model.Members.Count); } } @@ -178,7 +180,7 @@ public void ExtractInterfaceRefactoring_DefaultsToPublicInterfaceForExposedImple .First(); //Specify Params to remove - var model = new ExtractInterfaceModel(state, target, new CodeBuilder()); + var model = new ExtractInterfaceModel(state, target, CreateCodeBuilder()); Assert.AreEqual(ClassInstancing.Public, model.InterfaceInstancing); } } @@ -204,7 +206,7 @@ public void ExtractInterfaceRefactoring_DefaultsToPrivateInterfaceForNonExposedI .First(); //Specify Params to remove - var model = new ExtractInterfaceModel(state, target, new CodeBuilder()); + var model = new ExtractInterfaceModel(state, target, CreateCodeBuilder()); Assert.AreEqual(ClassInstancing.Private, model.InterfaceInstancing); } } @@ -309,10 +311,10 @@ End Sub RefactoringUserInteraction userInteraction, ISelectionService selectionService) { - var addImplementationsBaseRefactoring = new AddInterfaceImplementationsRefactoringAction(rewritingManager, new CodeBuilder()); + var addImplementationsBaseRefactoring = new AddInterfaceImplementationsRefactoringAction(rewritingManager, CreateCodeBuilder()); var addComponentService = TestAddComponentService(state?.ProjectsProvider); var baseRefactoring = new ExtractInterfaceRefactoringAction(addImplementationsBaseRefactoring, state, state, rewritingManager, state?.ProjectsProvider, addComponentService); - return new ExtractInterfaceRefactoring(baseRefactoring, state, userInteraction, selectionService, new CodeBuilder()); + return new ExtractInterfaceRefactoring(baseRefactoring, state, userInteraction, selectionService, CreateCodeBuilder()); } private static IAddComponentService TestAddComponentService(IProjectsProvider projectsProvider) @@ -320,5 +322,16 @@ private static IAddComponentService TestAddComponentService(IProjectsProvider pr var sourceCodeHandler = new CodeModuleComponentSourceCodeHandler(); return new AddComponentService(projectsProvider, sourceCodeHandler, sourceCodeHandler); } + + private static ICodeBuilder CreateCodeBuilder() + => new CodeBuilder(new Indenter(null, CreateIndenterSettings)); + + private static IndenterSettings CreateIndenterSettings() + { + var s = IndenterSettingsTests.GetMockIndenterSettings(); + s.VerticallySpaceProcedures = true; + s.LinesBetweenProcedures = 1; + return s; + } } } \ No newline at end of file diff --git a/RubberduckTests/Refactoring/ImplementInterface/ImplementInterfaceRefactoringActionTests.cs b/RubberduckTests/Refactoring/ImplementInterface/ImplementInterfaceRefactoringActionTests.cs index d66dadc086..ba1d61e6da 100644 --- a/RubberduckTests/Refactoring/ImplementInterface/ImplementInterfaceRefactoringActionTests.cs +++ b/RubberduckTests/Refactoring/ImplementInterface/ImplementInterfaceRefactoringActionTests.cs @@ -1,4 +1,5 @@ -using System.Linq; +using System; +using System.Linq; using NUnit.Framework; using Rubberduck.Parsing.Rewriter; using Rubberduck.Parsing.Symbols; @@ -6,14 +7,18 @@ using Rubberduck.Refactorings; using Rubberduck.Refactorings.AddInterfaceImplementations; using Rubberduck.Refactorings.ImplementInterface; +using Rubberduck.SmartIndenter; using Rubberduck.VBEditor.SafeComWrappers; +using RubberduckTests.Settings; namespace RubberduckTests.Refactoring { [TestFixture] public class ImplementInterfaceRefactoringActionTests : RefactoringActionTestBase { - private string _todoImplementMessage = "Err.Raise 5 'TODO implement interface member"; + private string _errorRaiseStmt = "Err.Raise 5"; + private string _todoStmt = "'TODO implement interface member"; + private string ErrRaiseAndComment => $"{_errorRaiseStmt} {_todoStmt}"; private static string _rhsIdentifier = Rubberduck.Resources.Refactorings.Refactorings.CodeBuilder_DefaultPropertyRHSParam; @@ -35,7 +40,7 @@ public void ImplementInterface_Procedure() $@"Implements Interface1 Private Sub Interface1_Foo() - {_todoImplementMessage} + {ErrRaiseAndComment} End Sub "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -65,7 +70,7 @@ public void ImplementInterface_Procedure_ClassHasOtherProcedure() End Sub Private Sub Interface1_Foo() - {_todoImplementMessage} + {ErrRaiseAndComment} End Sub "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -101,15 +106,15 @@ End Property End Property Private Property Get Interface1_a() As String - {_todoImplementMessage} + {ErrRaiseAndComment} End Property Private Property Let Interface1_a(ByVal RHS As String) - {_todoImplementMessage} + {ErrRaiseAndComment} End Property Private Property Get Interface1_b() As String - {_todoImplementMessage} + {ErrRaiseAndComment} End Property "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -133,7 +138,7 @@ public void ImplementInterface_Procedure_WithParams() $@"Implements Interface1 Private Sub Interface1_Foo(ByVal a As Integer, ByRef b As Variant, c As Variant, d As Long) - {_todoImplementMessage} + {ErrRaiseAndComment} End Sub "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -157,7 +162,7 @@ public void ImplementInterface_Function() $@"Implements Interface1 Private Function Interface1_Foo() As Integer - {_todoImplementMessage} + {ErrRaiseAndComment} End Function "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -181,7 +186,7 @@ public void ImplementInterface_Function_WithImplicitType() $@"Implements Interface1 Private Function Interface1_Foo() As Variant - {_todoImplementMessage} + {ErrRaiseAndComment} End Function "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -205,7 +210,7 @@ public void ImplementInterface_Function_WithParam() $@"Implements Interface1 Private Function Interface1_Foo(a As Variant) As Variant - {_todoImplementMessage} + {ErrRaiseAndComment} End Function "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -229,7 +234,7 @@ public void ImplementInterface_PropertyGet() $@"Implements Interface1 Private Property Get Interface1_Foo() As Integer - {_todoImplementMessage} + {ErrRaiseAndComment} End Property "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -253,7 +258,7 @@ public void ImplementInterface_PropertyGet_WithImplicitType() $@"Implements Interface1 Private Property Get Interface1_Foo() As Variant - {_todoImplementMessage} + {ErrRaiseAndComment} End Property "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -277,7 +282,7 @@ public void ImplementInterface_PropertyGet_WithParam() $@"Implements Interface1 Private Property Get Interface1_Foo(a As Variant) As Variant - {_todoImplementMessage} + {ErrRaiseAndComment} End Property "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -301,7 +306,7 @@ public void ImplementInterface_PropertyLet() $@"Implements Interface1 Private Property Let Interface1_Foo(ByVal value As Long) - {_todoImplementMessage} + {ErrRaiseAndComment} End Property "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -325,7 +330,7 @@ public void ImplementInterface_PropertyLet_WithParam() $@"Implements Interface1 Private Property Let Interface1_Foo(ByVal a As Variant) - {_todoImplementMessage} + {ErrRaiseAndComment} End Property "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -349,7 +354,7 @@ public void ImplementInterface_PropertySet() $@"Implements Interface1 Private Property Set Interface1_Foo(ByVal value As Variant) - {_todoImplementMessage} + {ErrRaiseAndComment} End Property "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -373,7 +378,7 @@ public void ImplementInterface_PropertySet_WithParam() $@"Implements Interface1 Private Property Set Interface1_Foo(ByVal a As Variant) - {_todoImplementMessage} + {ErrRaiseAndComment} End Property "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -406,19 +411,19 @@ End Property $@"Implements Interface1 Private Sub Interface1_Foo() - {_todoImplementMessage} + {ErrRaiseAndComment} End Sub Private Function Interface1_Bar(ByVal a As Integer) As Boolean - {_todoImplementMessage} + {ErrRaiseAndComment} End Function Private Property Get Interface1_Buz(ByVal a As Boolean) As Integer - {_todoImplementMessage} + {ErrRaiseAndComment} End Property Private Property Let Interface1_Buz(ByVal a As Boolean, ByVal value As Integer) - {_todoImplementMessage} + {ErrRaiseAndComment} End Property "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -454,23 +459,23 @@ End Property $@"Implements Interface1 Private Sub Interface1_Foo(ByVal arg1 As Integer, ByVal arg2 As String) - {_todoImplementMessage} + {ErrRaiseAndComment} End Sub Private Function Interface1_Fizz(b As Variant) As Variant - {_todoImplementMessage} + {ErrRaiseAndComment} End Function Private Property Get Interface1_Buzz() As Variant - {_todoImplementMessage} + {ErrRaiseAndComment} End Property Private Property Let Interface1_Buzz(ByVal value As Variant) - {_todoImplementMessage} + {ErrRaiseAndComment} End Property Private Property Set Interface1_Buzz(ByVal value As Variant) - {_todoImplementMessage} + {ErrRaiseAndComment} End Property "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -491,11 +496,11 @@ public void ImplementInterface_PublicIntrinsic(string interfaceCode) $@"Implements Interface1 Private Property Get Interface1_Foo() As Long - {_todoImplementMessage} + {ErrRaiseAndComment} End Property Private Property Let Interface1_Foo(ByVal {_rhsIdentifier} As Long) - {_todoImplementMessage} + {ErrRaiseAndComment} End Property "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -516,11 +521,11 @@ public void ImplementInterface_PublicObject(string interfaceCode) $@"Implements Interface1 Private Property Get Interface1_Foo() As Object - {_todoImplementMessage} + {ErrRaiseAndComment} End Property Private Property Set Interface1_Foo(ByVal {_rhsIdentifier} As Object) - {_todoImplementMessage} + {ErrRaiseAndComment} End Property "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -543,15 +548,15 @@ public void ImplementInterface_PublicVariant(string interfaceCode) $@"Implements Interface1 Private Property Get Interface1_Foo() As Variant - {_todoImplementMessage} + {ErrRaiseAndComment} End Property Private Property Let Interface1_Foo(ByVal {_rhsIdentifier} As Variant) - {_todoImplementMessage} + {ErrRaiseAndComment} End Property Private Property Set Interface1_Foo(ByVal {_rhsIdentifier} As Variant) - {_todoImplementMessage} + {ErrRaiseAndComment} End Property "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -575,7 +580,7 @@ public void ImplementInterface_ImplicitByRefParameter() $@"Implements Interface1 Private Sub Interface1_Foo(arg As Variant) - {_todoImplementMessage} + {ErrRaiseAndComment} End Sub "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -599,7 +604,7 @@ public void ImplementInterface_ExplicitByRefParameter() $@"Implements Interface1 Private Sub Interface1_Foo(ByRef arg As Variant) - {_todoImplementMessage} + {ErrRaiseAndComment} End Sub "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -623,7 +628,7 @@ public void ImplementInterface_ByValParameter() $@"Implements Interface1 Private Sub Interface1_Foo(ByVal arg As Variant) - {_todoImplementMessage} + {ErrRaiseAndComment} End Sub "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -647,7 +652,7 @@ public void ImplementInterface_OptionalParameter_WoDefault() $@"Implements Interface1 Private Sub Interface1_Foo(Optional arg As Variant) - {_todoImplementMessage} + {ErrRaiseAndComment} End Sub "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -671,7 +676,7 @@ public void ImplementInterface_OptionalParameter_WithDefault() $@"Implements Interface1 Private Sub Interface1_Foo(Optional arg As Variant = 42) - {_todoImplementMessage} + {ErrRaiseAndComment} End Sub "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -695,7 +700,7 @@ public void ImplementInterface_ParamArray() $@"Implements Interface1 Private Sub Interface1_Foo(arg1 As Long, ParamArray args() As Variant) - {_todoImplementMessage} + {ErrRaiseAndComment} End Sub "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -719,7 +724,7 @@ public void ImplementInterface_MakesMissingAsTypesExplicit() $@"Implements Interface1 Private Sub Interface1_Foo(arg1 As Variant) - {_todoImplementMessage} + {ErrRaiseAndComment} End Sub "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -743,7 +748,7 @@ public void ImplementInterface_Array() $@"Implements Interface1 Private Sub Interface1_Foo(arg1() As Long) - {_todoImplementMessage} + {ErrRaiseAndComment} End Sub "; ExecuteTest(classCode, interfaceCode, expectedCode); @@ -756,7 +761,20 @@ private void ExecuteTest(string classCode, string interfaceCode, string expected ("Class1", classCode,ComponentType.ClassModule), ("Interface1", interfaceCode, ComponentType.ClassModule)); - Assert.AreEqual(expectedClassCode.Trim(), refactoredCode["Class1"].Trim()); + //Remove Indenter formatting effects from refactoring results evaluation + var expected = expectedClassCode.Trim().Split(new string[] { Environment.NewLine }, StringSplitOptions.None); + var refactored = refactoredCode["Class1"].Trim().Split(new string[] { Environment.NewLine }, StringSplitOptions.None); + Assert.AreEqual(expected.Count(), refactored.Count()); + for (var idx = 0; idx < expected.Count(); idx++) + { + if (expected[idx].Contains(_errorRaiseStmt)) + { + StringAssert.Contains(_errorRaiseStmt, refactored[idx]); + StringAssert.Contains(_todoStmt, refactored[idx]); + continue; + } + Assert.AreEqual(expected[idx], refactored[idx]); + } } private static ImplementInterfaceModel TestModel(RubberduckParserState state) @@ -773,8 +791,19 @@ private static ImplementInterfaceModel TestModel(RubberduckParserState state) protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) { - var addInterfaceImplementationsAction = new AddInterfaceImplementationsRefactoringAction(rewritingManager, new CodeBuilder()); + var addInterfaceImplementationsAction = new AddInterfaceImplementationsRefactoringAction(rewritingManager, CreateCodeBuilder()); return new ImplementInterfaceRefactoringAction(addInterfaceImplementationsAction, rewritingManager); } + + private static ICodeBuilder CreateCodeBuilder() + => new CodeBuilder(new Indenter(null, CreateIndenterSettings)); + + private static IndenterSettings CreateIndenterSettings() + { + var s = IndenterSettingsTests.GetMockIndenterSettings(); + s.VerticallySpaceProcedures = true; + s.LinesBetweenProcedures = 1; + return s; + } } } \ No newline at end of file diff --git a/RubberduckTests/Refactoring/ImplementInterface/ImplementInterfaceTests.cs b/RubberduckTests/Refactoring/ImplementInterface/ImplementInterfaceTests.cs index aefaaa1aac..fdfe628eaa 100644 --- a/RubberduckTests/Refactoring/ImplementInterface/ImplementInterfaceTests.cs +++ b/RubberduckTests/Refactoring/ImplementInterface/ImplementInterfaceTests.cs @@ -8,10 +8,12 @@ using Rubberduck.Refactorings.AddInterfaceImplementations; using Rubberduck.Refactorings.Exceptions.ImplementInterface; using Rubberduck.Refactorings.ImplementInterface; +using Rubberduck.SmartIndenter; using Rubberduck.VBEditor; using Rubberduck.VBEditor.SafeComWrappers; using Rubberduck.VBEditor.Utility; using RubberduckTests.Mocks; +using RubberduckTests.Settings; namespace RubberduckTests.Refactoring { @@ -217,10 +219,21 @@ End Sub protected override IRefactoring TestRefactoring(IRewritingManager rewritingManager, RubberduckParserState state, ISelectionService selectionService) { - var addImplementationsBaseRefactoring = new AddInterfaceImplementationsRefactoringAction(rewritingManager, new CodeBuilder()); + var addImplementationsBaseRefactoring = new AddInterfaceImplementationsRefactoringAction(rewritingManager, CreateCodeBuilder()); var baseRefactoring = new ImplementInterfaceRefactoringAction(addImplementationsBaseRefactoring, rewritingManager); return new ImplementInterfaceRefactoring(baseRefactoring, state, selectionService); } + + private static ICodeBuilder CreateCodeBuilder() + => new CodeBuilder(new Indenter(null, CreateIndenterSettings)); + + private static IndenterSettings CreateIndenterSettings() + { + var s = IndenterSettingsTests.GetMockIndenterSettings(); + s.VerticallySpaceProcedures = true; + s.LinesBetweenProcedures = 1; + return s; + } } } diff --git a/RubberduckTests/Refactoring/ModifyUserDefinedType/ModifyUserDefinedTypeRefactoringActionTests.cs b/RubberduckTests/Refactoring/ModifyUserDefinedType/ModifyUserDefinedTypeRefactoringActionTests.cs new file mode 100644 index 0000000000..7d59205298 --- /dev/null +++ b/RubberduckTests/Refactoring/ModifyUserDefinedType/ModifyUserDefinedTypeRefactoringActionTests.cs @@ -0,0 +1,220 @@ +using NUnit.Framework; +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings; +using Rubberduck.Refactorings.ModifyUserDefinedType; +using Rubberduck.SmartIndenter; +using RubberduckTests.Settings; +using System; +using System.Collections.Generic; +using System.Linq; + +namespace RubberduckTests.Refactoring.ModifyUserDefinedType +{ + [TestFixture] + public class ModifyUserDefinedTypeRefactoringActionTests : RefactoringActionTestBase + { + [TestCase("Private mTest As Long", DeclarationType.Variable)] + [TestCase("Private Const mTest As Long = 10", DeclarationType.Constant)] + [TestCase("Private Function mTest() As Long\r\nEnd Function", DeclarationType.Function)] + [TestCase("Private Property Get mTest() As Long\r\nEnd Property", DeclarationType.PropertyGet)] + [TestCase("Private Type ProtoType\r\n mTest As Long\r\nEnd Type", DeclarationType.UserDefinedTypeMember)] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ModifyUserDefinedTypeRefactoringAction))] + public void AddSingleMember(string prototypeDeclaration, DeclarationType declarationType) + { + var inputCode = +$@" +Option Explicit + +Private Type TestType + FirstValue As String +End Type + +{prototypeDeclaration} +"; + var expectedUDT = +$@" +Private Type TestType + FirstValue As String + Test As Long +End Type +"; + + ExecuteTest(inputCode, "TestType", expectedUDT, ("mTest", "Test", declarationType)); + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ModifyUserDefinedTypeRefactoringAction))] + public void MultipleNewMembers() + { + var inputCode = +$@" +Option Explicit + +Private mTest As Long +Private mTest1 As Long +Private mTest2 As Long + +Private Type TestType + FirstValue As String + SecondValue As Double +End Type +"; + var expectedUDT = +$@" +Private Type TestType + FirstValue As String + SecondValue As Double + Test As Long + Test1 As Long + Test2 As Long +End Type +"; + + ExecuteTest(inputCode, "TestType", expectedUDT, ("mTest", "Test", DeclarationType.Variable), ("mTest1", "Test1", DeclarationType.Variable), ("mTest2", "Test2", DeclarationType.Variable)); + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ModifyUserDefinedTypeRefactoringAction))] + public void MultipleNewMembersRemoveMultiple() + { + var inputCode = +$@" +Option Explicit + +Private mTest As Long +Private mTest1 As Long +Private mTest2 As Long + +Private Type TestType + FirstValue As String + SecondValue As Double + ThirdValue As Byte +End Type +"; + var expectedUDT = +$@" +Private Type TestType + SecondValue As Double + Test As Long + Test1 As Long + Test2 As Long +End Type +"; + var adds = new List<(string, string, DeclarationType)>() + { + ("mTest", "Test", DeclarationType.Variable), + ("mTest1", "Test1", DeclarationType.Variable), + ("mTest2", "Test2", DeclarationType.Variable) + }; + + var removes = new List() + { + "FirstValue", + "ThirdValue" + }; + + ExecuteTest(inputCode, "TestType", expectedUDT, adds, removes); + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ModifyUserDefinedTypeRefactoringAction))] + public void RemoveOnlyMultiple() + { + var inputCode = +$@" +Option Explicit + +Private Type TestType + FirstValue As String + SecondValue As Double + ThirdValue As Byte + FourthValue As Integer +End Type +"; + var expectedUDT = +$@" +Private Type TestType + FirstValue As String + SecondValue As Double +End Type +"; + var removes = new List() + { + "FourthValue", + "ThirdValue" + }; + + ExecuteTest(inputCode, "TestType", expectedUDT, Enumerable.Empty<(string,string,DeclarationType)>(), removes); + } + + private void ExecuteTest(string inputCode, string udtIdentifier, string expectedUDT, params (string, string, DeclarationType)[] fieldConversions) + { + ExecuteTest(inputCode, udtIdentifier, expectedUDT, (IEnumerable<(string, string, DeclarationType)>)fieldConversions); + } + + private void ExecuteTest(string inputCode, string udtIdentifier, string expectedUDT, IEnumerable<(string, string, DeclarationType)> fieldConversions, IEnumerable udtMemberIdentifiers = null) + { + var results = RefactoredCode(inputCode, state => TestModel(state, udtIdentifier, fieldConversions, udtMemberIdentifiers ?? Enumerable.Empty())); + + var refactoredCode = results.Trim().Split(new string[] { Environment.NewLine }, StringSplitOptions.None); + + var refactored = refactoredCode.SkipWhile(r => !r.Contains("Private Type")); + + var expected = expectedUDT.Trim().Split(new string[] { Environment.NewLine }, StringSplitOptions.None); + for (var idx = 0; idx < expected.Count(); idx++) + { + //Remove Indenter formatting effects from refactoring results evaluation + Assert.AreEqual(expected[idx].Trim(), refactored.ElementAt(idx).Trim()); + } + } + + private ModifyUserDefinedTypeModel TestModel(RubberduckParserState state, string udtIdentifier, IEnumerable<(string fieldID, string udtMemberID, DeclarationType declarationType)> fieldConversions, IEnumerable removals) + { + var udtDeclaration = GetUniquelyNamedDeclaration(state, DeclarationType.UserDefinedType, udtIdentifier); + var model = new ModifyUserDefinedTypeModel(udtDeclaration); + + foreach (var (fieldID, udtMemberID, declarationType) in fieldConversions) + { + var fieldDeclaration = GetUniquelyNamedDeclaration(state, declarationType, fieldID); + model.AddNewMemberPrototype(fieldDeclaration, udtMemberID); + } + + foreach (var udtMemberIdentifier in removals) + { + var udtMember = GetUniquelyNamedDeclaration(state, DeclarationType.UserDefinedTypeMember, udtMemberIdentifier); + model.RemoveMember(udtMember); + } + + return model; + } + + private static Declaration GetUniquelyNamedDeclaration(IDeclarationFinderProvider declarationFinderProvider, DeclarationType declarationType, string identifier) + => declarationFinderProvider.DeclarationFinder.UserDeclarations(declarationType).Single(d => d.IdentifierName.Equals(identifier)); + + protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) + { + return new ModifyUserDefinedTypeRefactoringAction(state, rewritingManager, CreateCodeBuilder()); + } + + private static ICodeBuilder CreateCodeBuilder() + => new CodeBuilder(new Indenter(null, CreateIndenterSettings)); + + private static IndenterSettings CreateIndenterSettings() + { + var s = IndenterSettingsTests.GetMockIndenterSettings(); + s.VerticallySpaceProcedures = true; + s.LinesBetweenProcedures = 1; + return s; + } + } +} diff --git a/RubberduckTests/Refactoring/RefactoringTestBase.cs b/RubberduckTests/Refactoring/RefactoringTestBase.cs index c2ee30d6cd..02d977f299 100644 --- a/RubberduckTests/Refactoring/RefactoringTestBase.cs +++ b/RubberduckTests/Refactoring/RefactoringTestBase.cs @@ -21,7 +21,7 @@ public abstract class RefactoringTestBase { [Test] [Category("Refactorings")] - public void NoActiveSelection_Throws() + public virtual void NoActiveSelection_Throws() { var rewritingManager = new Mock().Object; var refactoring = TestRefactoring(rewritingManager, null, initialSelection: null); diff --git a/RubberduckTests/Refactoring/ReplacePrivateUDTMemberReferences/ReplacePrivateUDTMemberReferencesRefactoringActionTests.cs b/RubberduckTests/Refactoring/ReplacePrivateUDTMemberReferences/ReplacePrivateUDTMemberReferencesRefactoringActionTests.cs new file mode 100644 index 0000000000..79ba15b1e2 --- /dev/null +++ b/RubberduckTests/Refactoring/ReplacePrivateUDTMemberReferences/ReplacePrivateUDTMemberReferencesRefactoringActionTests.cs @@ -0,0 +1,170 @@ +using NUnit.Framework; +using Rubberduck.Common; +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings; +using Rubberduck.Refactorings.ReplacePrivateUDTMemberReferences; +using RubberduckTests.Mocks; +using RubberduckTests.Refactoring; +using System; +using System.Linq; + +namespace RubberduckTests.ReplacePrivateUDTMemberReferences +{ + [TestFixture] + public class ReplacePrivateUDTMemberReferencesRefactoringActionTests : RefactoringActionTestBase + { + [TestCase("TheFirst", "TheSecond")] + [TestCase("afirst", "asecond")] //respects casing + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ReplacePrivateUDTMemberReferencesRefactoringAction))] + public void RenameFieldReferences(string firstValueRefReplacement, string secondValueRefReplacement) + { + string inputCode = +$@" +Private Type TBazz + FirstValue As String + SecondValue As Long +End Type + +Private myBazz As TBazz + +Public Sub Fizz(newValue As String) + myBazz.FirstValue = newValue +End Sub + +Public Sub Bazz(newValue As String) + myBazz.SecondValue = newValue +End Sub +"; + + var vbe = MockVbeBuilder.BuildFromStdModules((MockVbeBuilder.TestModuleName, inputCode)); + + var testParam1 = new PrivateUDTExpressions("myBazz", "FirstValue") + { + InternalName = firstValueRefReplacement, + }; + var testParam2 = new PrivateUDTExpressions("myBazz", "SecondValue") + { + InternalName = secondValueRefReplacement, + }; + + var results = RefactoredCode(vbe.Object, state => TestModel(state, false, testParam1, testParam2)); + StringAssert.Contains($" {firstValueRefReplacement} = newValue", results[MockVbeBuilder.TestModuleName]); + StringAssert.Contains($" {secondValueRefReplacement} = newValue", results[MockVbeBuilder.TestModuleName]); + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ReplacePrivateUDTMemberReferencesRefactoringAction))] + public void RenameFieldReferences_WithMemberAccess() + { + string inputCode = +$@" +Private Type TBazz + FirstValue As String + SecondValue As Long +End Type + +Private myBazz As TBazz + +Public Sub Fizz(newValue As String) + With myBazz + .FirstValue = newValue + End With +End Sub + +Public Sub Bazz(newValue As String) + With myBazz + .SecondValue = newValue + End With +End Sub +"; + + var vbe = MockVbeBuilder.BuildFromStdModules((MockVbeBuilder.TestModuleName, inputCode)); + + var testParam1 = new PrivateUDTExpressions("myBazz", "FirstValue") + { + InternalName = "TheFirst", + }; + var testParam2 = new PrivateUDTExpressions("myBazz", "SecondValue") + { + InternalName = "TheSecond", + }; + + var results = RefactoredCode(vbe.Object, state => TestModel(state, false, testParam1, testParam2)); + StringAssert.Contains($" With myBazz{Environment.NewLine}", results[MockVbeBuilder.TestModuleName]); + StringAssert.Contains(" TheFirst = newValue", results[MockVbeBuilder.TestModuleName]); + StringAssert.Contains(" TheSecond = newValue", results[MockVbeBuilder.TestModuleName]); + } + + private ReplacePrivateUDTMemberReferencesModel TestModel(RubberduckParserState state, bool moduleQualify = true, params PrivateUDTExpressions[] fieldConversions) + { + var fields = state.DeclarationFinder.UserDeclarations(DeclarationType.Variable) + .Where(d => d.AsTypeDeclaration?.DeclarationType.HasFlag(DeclarationType.UserDefinedType) ?? false) + .Select(v => v as VariableDeclaration); + + var factory = new ReplacePrivateUDTMemberReferencesModelFactory(state); + + var model = factory.Create(fields); + + foreach (var fieldConversion in fieldConversions) + { + var fieldDeclaration = fields.Single(f => f.IdentifierName == fieldConversion.FieldID); + var udtMember = model.UDTMembers + .Single(udtm => udtm.ParentDeclaration == fieldDeclaration.AsTypeDeclaration + && udtm.IdentifierName == fieldConversion.UDTMemberID); + + var expressions = new PrivateUDTMemberReferenceReplacementExpressions(fieldConversion.InternalName); + + model.AssignUDTMemberReferenceExpressions(fieldDeclaration as VariableDeclaration, udtMember, expressions); + } + return model; + } + + private static bool IsExternalReference(IdentifierReference identifierReference) + => identifierReference.QualifiedModuleName != identifierReference.Declaration.QualifiedModuleName; + + private static Declaration GetUniquelyNamedDeclaration(IDeclarationFinderProvider declarationFinderProvider, DeclarationType declarationType, string identifier) + { + return declarationFinderProvider.DeclarationFinder.UserDeclarations(declarationType).Single(d => d.IdentifierName.Equals(identifier)); + } + + protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) + { + return new ReplacePrivateUDTMemberReferencesRefactoringAction(rewritingManager); + } + + private struct PrivateUDTExpressions + { + public PrivateUDTExpressions(string fieldID, string udtMemberIdentifier) + { + FieldID = fieldID; + UDTMemberID = udtMemberIdentifier; + _externalName = null; + _internalName = null; + } + + public string FieldID { set; get; } + + public string UDTMemberID {set; get;} + + private string _internalName; + public string InternalName + { + set => _internalName = value; + get => _internalName ?? FieldID.CapitalizeFirstLetter(); + } + + private string _externalName; + public string ExternalName + { + set => _externalName = value; + get => _externalName ?? FieldID.CapitalizeFirstLetter(); + } + } +} +} diff --git a/RubberduckTests/Refactoring/ReplacePrivateUDTMemberReferences/UserDefinedTypeInstanceTests.cs b/RubberduckTests/Refactoring/ReplacePrivateUDTMemberReferences/UserDefinedTypeInstanceTests.cs new file mode 100644 index 0000000000..f5e9f64956 --- /dev/null +++ b/RubberduckTests/Refactoring/ReplacePrivateUDTMemberReferences/UserDefinedTypeInstanceTests.cs @@ -0,0 +1,136 @@ +using NUnit.Framework; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Refactorings.ReplacePrivateUDTMemberReferences; +using Rubberduck.VBEditor.SafeComWrappers; +using RubberduckTests.Mocks; +using System.Linq; + +namespace RubberduckTests.Refactoring.ReplacePrivateUDTMemberReferences +{ + [TestFixture] + public class UserDefinedTypeInstanceTests + { + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ReplacePrivateUDTMemberReferencesRefactoringAction))] + [Category(nameof(UserDefinedTypeInstanceTests))] + public void GetsCorrectReferenceCount() + { + string inputCode = +$@" +Private Type TBar + First As String + Second As String +End Type + +Private bizz_ As TBar + +Private fizz_ As TBar + +Public Sub Fizz(newValue As String) + With bizz_ + .First = newValue + End With +End Sub + +Public Sub Buzz(newValue As String) + With bizz_ + .Second = newValue + End With +End Sub + +Public Sub Fizz1(newValue As String) + bizz_.First = newValue +End Sub + +Public Sub Buzz1(newValue As String) + bizz_.Second = newValue +End Sub + +Public Sub Tazz(newValue As String) + fizz_.First = newValue + fizz_.Second = newValue +End Sub +"; + + var vbe = MockVbeBuilder.BuildFromModules((MockVbeBuilder.TestModuleName, inputCode, ComponentType.StandardModule)); + using (var state = MockParser.CreateAndParse(vbe.Object)) + { + var bizz_Target = state.DeclarationFinder.UserDeclarations(DeclarationType.Variable) + .Where(d => d.IdentifierName == "bizz_") + .Single(); + + var udtMembers = state.DeclarationFinder.UserDeclarations(DeclarationType.UserDefinedTypeMember); + + var sut = new UserDefinedTypeInstance(bizz_Target as VariableDeclaration, udtMembers); + Assert.AreEqual(4, sut.UDTMemberReferences.Count()); + } + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ReplacePrivateUDTMemberReferencesRefactoringAction))] + [Category(nameof(UserDefinedTypeInstanceTests))] + public void GetsCorrectReferenceCount_ClassAccessor() + { + string className = "TestClass"; + string classCode = +$@" +Public this As TBar +"; + + string classInstance = "theClass"; + string moduleName = MockVbeBuilder.TestModuleName; + string moduleCode = +$@" +Public Type TBar + First As String + Second As String +End Type + +Private {classInstance} As {className} + +Public Sub Initialize() + Set {classInstance} = New {className} +End Sub + +'Public Sub Fizz(newValue As String) +' With {classInstance} +' .this.First = newValue +' End With +'End Sub + +'Public Sub Buzz(newValue As String) +' With {classInstance} +' .this.Second = newValue +' End With +'End Sub + +Public Sub Fizz1(newValue As String) + {classInstance}.this.First = newValue +End Sub + +Public Sub Buzz1(newValue As String) + {classInstance}.this.Second = newValue +End Sub + +"; + + var vbe = MockVbeBuilder.BuildFromModules((moduleName, moduleCode, ComponentType.StandardModule), + (className, classCode, ComponentType.ClassModule)); + using (var state = MockParser.CreateAndParse(vbe.Object)) + { + var this_Target = state.DeclarationFinder.UserDeclarations(DeclarationType.Variable) + .Where(d => d.IdentifierName == "this") + .Single(); + + var udtMembers = state.DeclarationFinder.UserDeclarations(DeclarationType.UserDefinedTypeMember); + + var sut = new UserDefinedTypeInstance(this_Target as VariableDeclaration, udtMembers); + Assert.AreEqual(2, sut.UDTMemberReferences.Count()); + } + } + } +} diff --git a/RubberduckTests/Refactoring/ReplaceReferences/ReplaceReferencesRefactoringActionTests.cs b/RubberduckTests/Refactoring/ReplaceReferences/ReplaceReferencesRefactoringActionTests.cs new file mode 100644 index 0000000000..7e3f63e179 --- /dev/null +++ b/RubberduckTests/Refactoring/ReplaceReferences/ReplaceReferencesRefactoringActionTests.cs @@ -0,0 +1,498 @@ +using NUnit.Framework; +using Rubberduck.Parsing.Rewriter; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Refactorings; +using Rubberduck.Refactorings.ReplaceReferences; +using Rubberduck.Refactorings.ReplacePrivateUDTMemberReferences; +using Rubberduck.VBEditor.SafeComWrappers; +using RubberduckTests.Mocks; +using System.Linq; + +namespace RubberduckTests.Refactoring.RenameReferences +{ + [TestFixture] + public class ReplaceReferencesRefactoringActionTests : RefactoringActionTestBase + { + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ReplaceReferencesRefactoringAction))] + public void ValueField() + { + var inputCode = +$@" +Option Explicit + +Public mTest As Long + +Private mValue As Long + +Public Sub Fizz(arg As Long) + mValue = mTest + arg +End Sub + +Public Function RetrieveTest() As Long + RetrieveTest = mTest +End Function +"; + + string externalModule = "ExternalModule"; + string externalCode = +$@" +Option Explicit + +Private mValue As Long + +Public Sub Fazz(arg As Long) + mValue = mTest * arg +End Sub +"; + var vbe = MockVbeBuilder.BuildFromStdModules((MockVbeBuilder.TestModuleName, inputCode), (externalModule, externalCode)); + var results = RefactoredCode(vbe.Object, state => TestModel(state, ("mTest", "mNewName", "RetrieveTest()"))); + + StringAssert.Contains($"RetrieveTest = mNewName", results[MockVbeBuilder.TestModuleName]); + StringAssert.Contains($"Public mTest As Long", results[MockVbeBuilder.TestModuleName]); + + StringAssert.Contains($"mValue = {MockVbeBuilder.TestModuleName}.RetrieveTest()", results[externalModule]); + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ReplaceReferencesRefactoringAction))] + public void ExternalReferences() + { + var sourceModuleName = "SourceModule"; + var referenceExpression = $"{sourceModuleName}."; + var sourceModuleCode = +$@" + +Public this As Long"; + + var procedureModuleReferencingCode = +$@"Option Explicit + +Private Const bar As Long = 7 + +Public Sub Bar() + {referenceExpression}this = bar +End Sub + +Public Sub Foo() + With {sourceModuleName} + .this = bar + End With +End Sub +"; + + var vbe = MockVbeBuilder.BuildFromStdModules((sourceModuleName, sourceModuleCode), (MockVbeBuilder.TestModuleName, procedureModuleReferencingCode)); + var actualModuleCode = RefactoredCode(vbe.Object, state => TestModel(state, ("this", "test", "MyProperty"))); + + var referencingModuleCode = actualModuleCode[MockVbeBuilder.TestModuleName]; + StringAssert.Contains($"{sourceModuleName}.MyProperty = ", referencingModuleCode); + StringAssert.DoesNotContain($"{sourceModuleName}.{sourceModuleName}.MyProperty = ", referencingModuleCode); + StringAssert.Contains($" .MyProperty = bar", referencingModuleCode); + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ReplaceReferencesRefactoringAction))] + public void ArrayReferences2() + { + var sourceModuleName = "SourceModule"; + var inputCode = + @"Private Sub Foo() + ReDim arr(0 To 1) + arr(1) = arr(0) +End Sub"; + string expectedCode = + @"Private Sub Foo() + ReDim bar(0 To 1) + bar(1) = bar(0) +End Sub"; + + var vbe = MockVbeBuilder.BuildFromStdModules((sourceModuleName, inputCode)); + var actualModuleCode = RefactoredCode(vbe.Object, state => TestModel(state, ("arr", "bar", null))); + + var results = actualModuleCode[sourceModuleName]; + Assert.AreEqual(expectedCode, results); + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ReplaceReferencesRefactoringAction))] + public void ArrayReferences() + { + var sourceModuleName = "SourceModule"; + var inputCode = +$@" +Option Explicit + +Private myArray() As Integer + +Private Sub InitializeArray(size As Long) + Redim myArray(size) + Dim idx As Long + For idx = 1 To size + myArray(idx) = idx + Next idx +End Sub +"; + string expectedCode = +$@" +Option Explicit + +Private myArray() As Integer + +Private Sub InitializeArray(size As Long) + Redim renamedArray(size) + Dim idx As Long + For idx = 1 To size + renamedArray(idx) = idx + Next idx +End Sub +"; + + var vbe = MockVbeBuilder.BuildFromStdModules((sourceModuleName, inputCode)); + var actualModuleCode = RefactoredCode(vbe.Object, state => TestModel(state, ("myArray", "renamedArray", "renamedArray"))); + + var results = actualModuleCode[sourceModuleName]; + Assert.AreEqual(expectedCode, results); + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ReplaceReferencesRefactoringAction))] + public void ClassModuleReferences() + { + var sourceModuleName = "SourceModule"; + var referenceExpression = $"{sourceModuleName}."; + var sourceModuleCode = +$@" + +Public this As Long"; + + string classModuleReferencingCode = +$@"Option Explicit + +Private Const bar As Long = 7 + +Public Sub Bar() + {referenceExpression}this = bar +End Sub + +Public Sub Foo() + With {sourceModuleName} + .this = bar + End With +End Sub +"; + + var vbe = MockVbeBuilder.BuildFromModules((sourceModuleName, sourceModuleCode, ComponentType.StandardModule), (MockVbeBuilder.TestModuleName, classModuleReferencingCode, ComponentType.ClassModule)); + var actualModuleCode = RefactoredCode(vbe.Object, state => TestModel(state, ("this", "test", "MyProperty"))); + + var referencingModuleCode = actualModuleCode[MockVbeBuilder.TestModuleName]; + StringAssert.Contains($"{sourceModuleName}.MyProperty = ", referencingModuleCode); + StringAssert.DoesNotContain($"{sourceModuleName}.{sourceModuleName}.MyProperty = ", referencingModuleCode); + StringAssert.Contains($" .MyProperty = bar", referencingModuleCode); + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ReplaceReferencesRefactoringAction))] + public void UDTField_MemberAccess() + { + var inputCode = +$@" +Private Type TBar + FirstVal As String + SecondVal As Long + ThirdVal As Byte +End Type + +Private myBar As TBar +Private myFoo As TBar + +Public Function GetOne() As String + GetOne = myBar.FirstVal +End Function + +Public Function GetTwo() As Long + GetTwo = myBar.ThirdVal +End Function + +Public Function GetThree() As Long + GetThree = myFoo.ThirdVal +End Function + +"; + + var vbe = MockVbeBuilder.BuildFromStdModules((MockVbeBuilder.TestModuleName, inputCode)); + var state = MockParser.CreateAndParse(vbe.Object); + using (state) + { + var target = state.DeclarationFinder.UserDeclarations(DeclarationType.Variable) + .OfType() + .Where(d => "myBar" == d.IdentifierName) + .Single(); + + var udtMembers = state.DeclarationFinder.UserDeclarations(DeclarationType.UserDefinedTypeMember) + .Where(d => "TBar" == d.ParentDeclaration.IdentifierName); + + var test = new UserDefinedTypeInstance(target, udtMembers); + var refs = test.UDTMemberReferences; + Assert.AreEqual(2, refs.Select(rf => rf.IdentifierName).Count()); + } + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ReplaceReferencesRefactoringAction))] + public void UDTField_MemberAccessMultipleInstances() + { + var inputCode = +$@" +Private Type TBar + FirstVal As String + SecondVal As Long + ThirdVal As Byte +End Type + +Private myBar As TBar +Private myFoo As TBar + +Public Function GetOne() As String + GetOne = myBar.FirstVal +End Function + +Public Function GetTwo() As Long + GetTwo = myBar.ThirdVal +End Function + +Public Function GetThree() As Long + GetThree = myFoo.ThirdVal +End Function + +"; + + var vbe = MockVbeBuilder.BuildFromStdModules((MockVbeBuilder.TestModuleName, inputCode)); + var state = MockParser.CreateAndParse(vbe.Object); + using (state) + { + var myBarTarget = state.DeclarationFinder.UserDeclarations(DeclarationType.Variable) + .OfType() + .Where(d => "myBar" == d.IdentifierName) + .Single(); + + var myFooTarget = state.DeclarationFinder.UserDeclarations(DeclarationType.Variable) + .OfType() + .Where(d => "myFoo" == d.IdentifierName) + .Single(); + + var udtMembers = state.DeclarationFinder.UserDeclarations(DeclarationType.UserDefinedTypeMember) + .Where(d => "TBar" == d.ParentDeclaration.IdentifierName); + + var myBarRefs = new UserDefinedTypeInstance(myBarTarget, udtMembers); + var refs = myBarRefs.UDTMemberReferences; + Assert.AreEqual(2, refs.Select(rf => rf.IdentifierName).Count()); + + var myFooRefs = new UserDefinedTypeInstance(myFooTarget, udtMembers); + var fooRefs = myBarRefs.UDTMemberReferences; + Assert.AreEqual(2, fooRefs.Select(rf => rf.IdentifierName).Count()); + } + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ReplaceReferencesRefactoringAction))] + public void UDTField_WithMemberAccess() + { + var inputCode = +$@" +Private Type TBar + FirstVal As String + SecondVal As Long + ThirdVal As Byte +End Type + +Private myBar As TBar +Private myFoo As TBar + +Public Function GetOne() As String + With myBar + GetOne = .FirstVal + End With +End Function + +Public Function GetTwo() As Long + With myBar + GetTwo = .SecondVal + End With +End Function + +Public Function GetThree() As Long + With myFoo + GetThree = .ThirdVal + End With +End Function + +"; + + var vbe = MockVbeBuilder.BuildFromStdModules((MockVbeBuilder.TestModuleName, inputCode)); + var state = MockParser.CreateAndParse(vbe.Object); + using (state) + { + var target = state.DeclarationFinder.UserDeclarations(DeclarationType.Variable) + .OfType() + .Where(d => "myBar" == d.IdentifierName) + .Single(); + + var udtMembers = state.DeclarationFinder.UserDeclarations(DeclarationType.UserDefinedTypeMember) + .Where(d => "TBar" == d.ParentDeclaration.IdentifierName); + + var test = new UserDefinedTypeInstance(target, udtMembers); + var refs = test.UDTMemberReferences; + Assert.AreEqual(2, refs.Select(rf => rf.IdentifierName).Count()); + } + } + + [Test] + [Category("Refactorings")] + [Category("Encapsulate Field")] + [Category(nameof(ReplaceReferencesRefactoringAction))] + public void ClassModuleUDTField_ExternalReferences() + { + var className = "TestClass"; + var classInputCode = +$@" + +Public this As TBar +"; + + var classInstanceName = "theClass"; + var proceduralModuleName = MockVbeBuilder.TestModuleName; + var procedureModuleReferencingCode = +$@"Option Explicit + +Public Type TBar + First As String + Second As Long +End Type + +Private {classInstanceName} As {className} +Private Const foo As String = ""Foo"" +Private Const bar As Long = 7 + +Public Sub Initialize() + Set {classInstanceName} = New {className} +End Sub + +Public Sub Foo() + {classInstanceName}.this.First = foo +End Sub + +Public Sub Bar() + {classInstanceName}.this.Second = bar +End Sub + +Public Sub FooBar() + With {classInstanceName} + .this.First = foo + .this.Second = bar + End With +End Sub +"; + + var vbe = MockVbeBuilder.BuildFromModules((className, classInputCode, ComponentType.ClassModule), + (proceduralModuleName, procedureModuleReferencingCode, ComponentType.StandardModule)); + + var actualModuleCode = RefactoredCode(vbe.Object, state => TestModel(state, ("this", "MyType", "MyType"))); + + var referencingModuleCode = actualModuleCode[proceduralModuleName]; + StringAssert.Contains($"{classInstanceName}.MyType.First = ", referencingModuleCode); + StringAssert.Contains($"{classInstanceName}.MyType.Second = ", referencingModuleCode); + StringAssert.Contains($" .MyType.Second = ", referencingModuleCode); + } + + [TestCase("DeclaringModule.this", "DeclaringModule.TheFirst.First")] + [TestCase("this", "DeclaringModule.TheFirst.First")] + [Category("Encapsulate Field")] + [Category("Refactorings")] + [Category(nameof(ReplaceReferencesRefactoringAction))] + public void PublicUDT_ExternalFieldReferences(string memberAccessExpression, string expectedExpression) + { + var moduleName = "DeclaringModule"; + var inputCode = +$@" +Public this As TBazz + +Public Property Let TheFirst(ByVal RHS As String) + 'this.First = RHS +End Property +"; + + var referencingModuleName = MockVbeBuilder.TestModuleName; + var referencingCode = +$@"Option Explicit + +Public Type TBazz + First As String +End Type + +Public Sub Fizz() + {memberAccessExpression}.First = ""Fizz"" +End Sub +"; + + var vbe = MockVbeBuilder.BuildFromModules((moduleName, inputCode, ComponentType.StandardModule), + (referencingModuleName, referencingCode, ComponentType.StandardModule)); + + var actualModuleCode = RefactoredCode(vbe.Object, state => TestModel(state, ("this", "TheFirst", "TheFirst"))); + + var referencingModuleCode = actualModuleCode[referencingModuleName]; + StringAssert.Contains($"{expectedExpression} = ", referencingModuleCode); + } + + private ReplaceReferencesModel TestModel(RubberduckParserState state, params (string fieldID, string internalName, string externalName)[] fieldConversions) + { + var model = new ReplaceReferencesModel() + { + ModuleQualifyExternalReferences = true, + }; + + foreach (var (fieldID, internalName, externalName) in fieldConversions) + { + var fieldDeclaration = GetUniquelyNamedDeclaration(state, DeclarationType.Variable, fieldID); + foreach (var reference in fieldDeclaration.References) + { + var replacementExpression = fieldDeclaration.QualifiedModuleName != reference.QualifiedModuleName + ? externalName + : internalName; + + model.AssignReferenceReplacementExpression(reference, replacementExpression); + } + } + return model; + } + + private static bool IsExternalReference(IdentifierReference identifierReference) + => identifierReference.QualifiedModuleName != identifierReference.Declaration.QualifiedModuleName; + + private static Declaration GetUniquelyNamedDeclaration(IDeclarationFinderProvider declarationFinderProvider, DeclarationType declarationType, string identifier) + { + return declarationFinderProvider.DeclarationFinder.UserDeclarations(declarationType).Single(d => d.IdentifierName.Equals(identifier)); + } + + protected override IRefactoringAction TestBaseRefactoring(RubberduckParserState state, IRewritingManager rewritingManager) + { + return new ReplaceReferencesRefactoringAction(rewritingManager); + } + } +}