From abc2b53881c0e827ff972cabc1677d9ad60d132e Mon Sep 17 00:00:00 2001 From: Vogel612 Date: Sat, 25 Nov 2017 16:42:05 +0100 Subject: [PATCH 1/2] Stop renaming references to Me Class module references to Me should not be renamed to not break the code. Fixes #2710 --- .../Refactorings/Rename/RenameRefactoring.cs | 4 +- RubberduckTests/Refactoring/RenameTests.cs | 42 +++++++++++++++++++ 2 files changed, 45 insertions(+), 1 deletion(-) diff --git a/RetailCoder.VBE/Refactorings/Rename/RenameRefactoring.cs b/RetailCoder.VBE/Refactorings/Rename/RenameRefactoring.cs index 6276a9cb4c..c859ab826d 100644 --- a/RetailCoder.VBE/Refactorings/Rename/RenameRefactoring.cs +++ b/RetailCoder.VBE/Refactorings/Rename/RenameRefactoring.cs @@ -476,7 +476,9 @@ private void RenameStandardElements(Declaration target, string newName) private void RenameReferences(Declaration target, string newName) { - var modules = target.References.GroupBy(r => r.QualifiedModuleName); + var modules = target.References + .Where(reference => reference.Context.GetText() != "Me") + .GroupBy(r => r.QualifiedModuleName); foreach (var grouping in modules) { _modulesToRewrite.Add(grouping.Key); diff --git a/RubberduckTests/Refactoring/RenameTests.cs b/RubberduckTests/Refactoring/RenameTests.cs index 6910cf7655..02f0f9ab14 100644 --- a/RubberduckTests/Refactoring/RenameTests.cs +++ b/RubberduckTests/Refactoring/RenameTests.cs @@ -1962,6 +1962,48 @@ public void RenameRefactoring_RenameViewModel_IsValidName_ChangeCasingNotValid() Assert.IsFalse(renameViewModel.IsValidName); } + + [TestMethod] + [TestCategory("Refactorings")] + [TestCategory("Rename")] + public void RenameRefactoring_RenameClassModule_DoesNotChangeMeReferences() + { + const string newName = "RenamedClassModule"; + + //Input + const string inputCode = + @"Property Get Self() As IClassModule + Set Self = Me +End Property"; + + var selection = new Selection(3, 27, 3, 27); + + IVBComponent component; + var vbe = MockVbeBuilder.BuildFromSingleModule(inputCode, "ClassModule1", ComponentType.ClassModule, out component, selection); + using (var state = MockParser.CreateAndParse(vbe.Object)) + { + + var qualifiedSelection = new QualifiedSelection(new QualifiedModuleName(component), selection); + + var msgbox = new Mock(); + msgbox.Setup(m => m.Show(It.IsAny(), It.IsAny(), MessageBoxButtons.YesNo, It.IsAny())) + .Returns(DialogResult.Yes); + + var vbeWrapper = vbe.Object; + var model = new RenameModel(vbeWrapper, state, qualifiedSelection) { NewName = newName }; + model.Target = model.Declarations.FirstOrDefault(i => i.DeclarationType == DeclarationType.ClassModule && i.IdentifierName == "ClassModule1"); + + //SetupFactory + var factory = SetupFactory(model); + + var refactoring = new RenameRefactoring(vbeWrapper, factory.Object, msgbox.Object, state); + refactoring.Refactor(model.Target); + + Assert.AreSame(newName, component.CodeModule.Name); + Assert.AreEqual(inputCode, component.CodeModule.GetLines(0, component.CodeModule.CountOfLines)); + } + + } #endregion #region Test Execution From ef11a057caebf54af7159a8fac05939de7e1fd46 Mon Sep 17 00:00:00 2001 From: Vogel612 Date: Sat, 25 Nov 2017 21:23:57 +0100 Subject: [PATCH 2/2] Consider More than just ClassModules for MemberNotOnInterface fixes #2189 --- .../MemberNotOnInterfaceInspection.cs | 7 +-- .../Symbols/IdentifierReferenceResolver.cs | 2 +- .../MemberNotOnInterfaceInspectionTests.cs | 62 +++++++++++++++++++ 3 files changed, 66 insertions(+), 5 deletions(-) diff --git a/Rubberduck.Inspections/Concrete/MemberNotOnInterfaceInspection.cs b/Rubberduck.Inspections/Concrete/MemberNotOnInterfaceInspection.cs index 26498d4066..eebbc88556 100644 --- a/Rubberduck.Inspections/Concrete/MemberNotOnInterfaceInspection.cs +++ b/Rubberduck.Inspections/Concrete/MemberNotOnInterfaceInspection.cs @@ -23,16 +23,15 @@ protected override IEnumerable DoGetInspectionResults() var targets = Declarations.Where(decl => decl.AsTypeDeclaration != null && !decl.AsTypeDeclaration.IsUserDefined && - decl.AsTypeDeclaration.DeclarationType == DeclarationType.ClassModule && + decl.AsTypeDeclaration.DeclarationType.HasFlag(DeclarationType.ClassModule) && ((ClassModuleDeclaration)decl.AsTypeDeclaration).IsExtensible) .SelectMany(decl => decl.References).ToList(); - return from access in unresolved let callingContext = targets.FirstOrDefault(usage => usage.Context.Equals(access.CallingContext)) where callingContext != null select new DeclarationInspectionResult(this, - string.Format(InspectionsUI.MemberNotOnInterfaceInspectionResultFormat, access.IdentifierName, callingContext.Declaration.AsTypeDeclaration.IdentifierName), - access); + string.Format(InspectionsUI.MemberNotOnInterfaceInspectionResultFormat, access.IdentifierName, callingContext.Declaration.AsTypeDeclaration.IdentifierName), + access); } } } diff --git a/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs b/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs index 205c999650..15b4657606 100644 --- a/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs +++ b/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs @@ -174,7 +174,7 @@ private void ResolveLabel(ParserRuleContext context, string label) { var lexpression = expression as VBAParser.LExpressionContext ?? expression.GetChild(0) - ?? (expression as VBAParser.LExprContext + ?? (expression as VBAParser.LExprContext ?? expression.GetChild(0))?.lExpression(); if (lexpression != null) diff --git a/RubberduckTests/Inspections/MemberNotOnInterfaceInspectionTests.cs b/RubberduckTests/Inspections/MemberNotOnInterfaceInspectionTests.cs index 08d8120785..25f5b2bb00 100644 --- a/RubberduckTests/Inspections/MemberNotOnInterfaceInspectionTests.cs +++ b/RubberduckTests/Inspections/MemberNotOnInterfaceInspectionTests.cs @@ -265,5 +265,67 @@ public void MemberNotOnInterface_Ignored_DoesNotReturnResult() Assert.IsFalse(inspectionResults.Any()); } } + + [TestMethod] + [DeploymentItem(@"Testfiles\")] + [TestCategory("Inspections")] + public void MemberNotOnInterface_CatchesInvalidUseOfMember() + { + const string userForm1Code = @" +Private _fooBar As String + +Public Property Let FooBar(value As String) + _fooBar = value +End Property + +Public Property Get FooBar() As String + FooBar = _fooBar +End Property +"; + + const string analyzedCode = @"Option Explicit + +Sub FizzBuzz() + + Dim bar As UserForm1 + Set bar = New UserForm1 + bar.FooBar = ""FooBar"" + + Dim foo As UserForm + Set foo = New UserForm1 + foo.FooBar = ""BarFoo"" + +End Sub +"; + var mockVbe = new MockVbeBuilder(); + var projectBuilder = mockVbe.ProjectBuilder("testproject", ProjectProtection.Unprotected); + projectBuilder.MockUserFormBuilder("UserForm1", userForm1Code).MockProjectBuilder() + .AddComponent("ReferencingModule", ComponentType.StandardModule, analyzedCode) + //.AddReference("Excel", MockVbeBuilder.LibraryPathMsExcel) + .AddReference("MSForms", MockVbeBuilder.LibraryPathMsForms); + + mockVbe.AddProject(projectBuilder.Build()); + + + var parser = MockParser.Create(mockVbe.Build().Object); + + //parser.State.AddTestLibrary("Excel.1.8.xml"); + parser.State.AddTestLibrary("MSForms.2.0.xml"); + + parser.Parse(new CancellationTokenSource()); + if (parser.State.Status >= ParserState.Error) + { + Assert.Inconclusive("Parser Error"); + } + + using (var state = parser.State) + { + var inspection = new MemberNotOnInterfaceInspection(state); + var inspectionResults = inspection.GetInspectionResults(); + + Assert.IsTrue(inspectionResults.Any()); + } + + } } }