From 105cbdd82e1834dc41628e6ddf0f05ac64215c60 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Thu, 1 Oct 2020 00:38:41 +0200 Subject: [PATCH 1/7] Get document supertypes from user com projects We use the user com projects to get the names of the implemented interfaces; the type hierarchy pass does the rest. There is one hack in this: we suppress the underscore in front of the implemented interfaces in order to emulate the VBE's behaviour to let type checks pass relative to the coclass instead of the interface. This is entirely based on convention. Moreover, this lacks unit test since the com projects cannot be mocked at this stage. --- .../CompilationPasses/TypeHierarchyPass.cs | 4 +- .../ReferenceResolveRunner.cs | 13 +- .../ReferenceResolveRunnerBase.cs | 128 +++++++----------- .../SynchronousReferenceResolveRunner.cs | 13 +- RubberduckTests/Mocks/MockParser.cs | 3 +- 5 files changed, 66 insertions(+), 95 deletions(-) diff --git a/Rubberduck.Parsing/VBA/ReferenceManagement/CompilationPasses/TypeHierarchyPass.cs b/Rubberduck.Parsing/VBA/ReferenceManagement/CompilationPasses/TypeHierarchyPass.cs index 000bfb55d5..87ffef3bd2 100644 --- a/Rubberduck.Parsing/VBA/ReferenceManagement/CompilationPasses/TypeHierarchyPass.cs +++ b/Rubberduck.Parsing/VBA/ReferenceManagement/CompilationPasses/TypeHierarchyPass.cs @@ -31,12 +31,12 @@ public TypeHierarchyPass(DeclarationFinder declarationFinder, VBAExpressionParse public void Execute(IReadOnlyCollection modules) { - var toRelsolveSupertypesFor = _declarationFinder.UserDeclarations(DeclarationType.ClassModule) + var toResolveSupertypesFor = _declarationFinder.UserDeclarations(DeclarationType.ClassModule) .Concat(_declarationFinder.UserDeclarations(DeclarationType.Document)) .Concat(_declarationFinder.UserDeclarations(DeclarationType.UserForm)) .Where(decl => modules.Contains(decl.QualifiedName.QualifiedModuleName)) .Concat(_declarationFinder.BuiltInDeclarations(DeclarationType.ClassModule)); - foreach (var declaration in toRelsolveSupertypesFor) + foreach (var declaration in toResolveSupertypesFor) { AddImplementedInterface(declaration); } diff --git a/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunner.cs b/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunner.cs index d9047ad98d..b37aa0b666 100644 --- a/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunner.cs +++ b/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunner.cs @@ -5,6 +5,7 @@ using System.Threading; using System.Threading.Tasks; using Antlr4.Runtime.Tree; +using Rubberduck.Parsing.ComReflection; using Rubberduck.Parsing.VBA.DeclarationCaching; using Rubberduck.VBEditor; @@ -17,13 +18,15 @@ public class ReferenceResolveRunner : ReferenceResolveRunnerBase public ReferenceResolveRunner( RubberduckParserState state, IParserStateManager parserStateManager, - IModuleToModuleReferenceManager moduletToModuleReferenceManager, - IReferenceRemover referenceRemover) + IModuleToModuleReferenceManager moduleToModuleReferenceManager, + IReferenceRemover referenceRemover, + IUserComProjectProvider userComProjectProvider) :base(state, parserStateManager, - moduletToModuleReferenceManager, - referenceRemover) - { } + moduleToModuleReferenceManager, + referenceRemover, + userComProjectProvider) + {} protected override void ResolveReferences(ICollection> toResolve, CancellationToken token) diff --git a/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs b/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs index 31b8577a3d..fc55a4d21c 100644 --- a/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs +++ b/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs @@ -6,6 +6,7 @@ using Antlr4.Runtime.Tree; using NLog; using Rubberduck.Parsing.Common; +using Rubberduck.Parsing.ComReflection; using Rubberduck.Parsing.Symbols; using Rubberduck.Parsing.VBA.DeclarationCaching; using Rubberduck.Parsing.VBA.Extensions; @@ -29,12 +30,14 @@ public abstract class ReferenceResolveRunnerBase : IReferenceResolveRunner protected readonly IParserStateManager _parserStateManager; private readonly IModuleToModuleReferenceManager _moduleToModuleReferenceManager; private readonly IReferenceRemover _referenceRemover; + private readonly IUserComProjectProvider _userComProjectProvider; public ReferenceResolveRunnerBase( RubberduckParserState state, IParserStateManager parserStateManager, - IModuleToModuleReferenceManager moduletToModuleReferenceManager, - IReferenceRemover referenceRemover) + IModuleToModuleReferenceManager moduleToModuleReferenceManager, + IReferenceRemover referenceRemover, + IUserComProjectProvider userComProjectProvider) { if (state == null) { @@ -44,19 +47,24 @@ public abstract class ReferenceResolveRunnerBase : IReferenceResolveRunner { throw new ArgumentNullException(nameof(parserStateManager)); } - if (moduletToModuleReferenceManager == null) + if (moduleToModuleReferenceManager == null) { - throw new ArgumentNullException(nameof(moduletToModuleReferenceManager)); + throw new ArgumentNullException(nameof(moduleToModuleReferenceManager)); } if (referenceRemover == null) { throw new ArgumentNullException(nameof(referenceRemover)); } + if (userComProjectProvider == null) + { + throw new ArgumentNullException(nameof(userComProjectProvider)); + } _state = state; _parserStateManager = parserStateManager; - _moduleToModuleReferenceManager = moduletToModuleReferenceManager; + _moduleToModuleReferenceManager = moduleToModuleReferenceManager; _referenceRemover = referenceRemover; + _userComProjectProvider = userComProjectProvider; } @@ -81,18 +89,18 @@ public void ResolveReferences(IReadOnlyCollection toResolve var parsingStageTimer = ParsingStageTimer.StartNew(); - ExecuteCompilationPasses(_toResolve.AsReadOnly(), token); + AddSuperTypeNamesForDocumentModules(_toResolve.AsReadOnly(), _state, _userComProjectProvider); token.ThrowIfCancellationRequested(); parsingStageTimer.Stop(); - parsingStageTimer.Log("Executed compilation passes in {0}ms."); - parsingStageTimer.Restart(); + parsingStageTimer.Log("Added supertypes for document modules in {0}ms."); - AddSupertypesForDocumentModules(_toResolve.AsReadOnly(), _state); + ExecuteCompilationPasses(_toResolve.AsReadOnly(), token); token.ThrowIfCancellationRequested(); parsingStageTimer.Stop(); - parsingStageTimer.Log("Added supertypes for document modules in {0}ms."); + parsingStageTimer.Log("Executed compilation passes in {0}ms."); + parsingStageTimer.Restart(); var parseTreesToResolve = _state.ParseTrees.Where(kvp => _toResolve.Contains(kvp.Key)).ToList(); token.ThrowIfCancellationRequested(); @@ -151,90 +159,46 @@ private void ExecuteCompilationPasses(IReadOnlyCollection m } } - private void AddSupertypesForDocumentModules(IReadOnlyCollection modules, RubberduckParserState state) - { - var documentModuleDeclarations = state.DeclarationFinder.UserDeclarations(DeclarationType.Document) - .OfType() - .Where(declaration => modules.Contains(declaration.QualifiedName.QualifiedModuleName)); - - foreach (var documentDeclaration in documentModuleDeclarations) - { - var documentSupertype = SupertypeForDocument(documentDeclaration.QualifiedName.QualifiedModuleName, state); - if (documentSupertype != null) - { - documentDeclaration.AddSupertype(documentSupertype); - } - } - } + // skip IDispatch.. just about everything implements it and RD doesn't need to care about it; don't care about IUnknown either + private static readonly HashSet IgnoredComInterfaces = new HashSet(new[] { "IDispatch", "IUnknown" }); - private Declaration SupertypeForDocument(QualifiedModuleName module, RubberduckParserState state) + private void AddSuperTypeNamesForDocumentModules(IReadOnlyCollection modules, RubberduckParserState state, IUserComProjectProvider userComProjectProvider) { - if(module.ComponentType != ComponentType.Document) - { - return null; - } + //todo: Figure out how to unit test this. - var component = _state.ProjectsProvider.Component(module); - if (component == null || component.IsWrappingNullReference) - { - return null; - } + var documentModuleDeclarationsByProject = state.DeclarationFinder.UserDeclarations(DeclarationType.Document) + .OfType() + .Where(declaration => modules.Contains(declaration.QualifiedName.QualifiedModuleName)) + .GroupBy(declaration => declaration.ProjectId); - Declaration superType = null; - // TODO: Replace with TypeLibAPI call, require a solution regarding thread synchronization or caching - /* - using (var properties = component.Properties) + foreach (var projectGroup in documentModuleDeclarationsByProject) { - int documentPropertyCount = 0; - try + var userComProject = userComProjectProvider.UserProject(projectGroup.Key); + var documents = projectGroup.ToDictionary(module => module.IdentifierName); + foreach (var comModule in userComProject.Members) { - if (properties == null || properties.IsWrappingNullReference) + if (!(documents.TryGetValue(comModule.Name, out var document))) { - return null; + continue; } - documentPropertyCount = properties.Count; - } - catch(COMException) - { - return null; - } - - foreach (var coclass in state.CoClasses) - { - try - { - if (coclass.Key.Count != documentPropertyCount) - { - continue; - } - - var allNamesMatch = true; - for (var i = 0; i < coclass.Key.Count; i++) - { - using (var property = properties[i+1]) - { - if (coclass.Key[i] != property?.Name) - { - allNamesMatch = false; - break; - } - } - } - - if (allNamesMatch) - { - superType = coclass.Value; - break; - } - } - catch (COMException) + + var inheritedInterfaces = comModule is ComCoClass documentCoClass + ? documentCoClass.ImplementedInterfaces + : (comModule as ComInterface)?.InheritedInterfaces; + + //todo: Find a way to deal with the VBE's document type assignment behaviour not relying on an assumption about an interface naming convention. + var superTypeNames = inheritedInterfaces? + .Where(i => !i.IsRestricted && !IgnoredComInterfaces.Contains(i.Name)) + .Select(i => i.Name) + .Select(name => name.StartsWith("_") ? name.Substring(1) : name) //This emulates the VBE's behaviour to allow assignment to the coclass type instead on the interface. + ?? Enumerable.Empty(); + + foreach (var superTypeName in superTypeNames) { + document.AddSupertypeName(superTypeName); } } } - */ - - return superType; } protected void ResolveReferences(DeclarationFinder finder, QualifiedModuleName module, IParseTree tree, CancellationToken token) diff --git a/Rubberduck.Parsing/VBA/ReferenceManagement/SynchronousReferenceResolveRunner.cs b/Rubberduck.Parsing/VBA/ReferenceManagement/SynchronousReferenceResolveRunner.cs index 9b09f2cd73..04ff280f64 100644 --- a/Rubberduck.Parsing/VBA/ReferenceManagement/SynchronousReferenceResolveRunner.cs +++ b/Rubberduck.Parsing/VBA/ReferenceManagement/SynchronousReferenceResolveRunner.cs @@ -2,6 +2,7 @@ using System.Collections.Generic; using System.Threading; using Antlr4.Runtime.Tree; +using Rubberduck.Parsing.ComReflection; using Rubberduck.Parsing.VBA.DeclarationCaching; using Rubberduck.VBEditor; @@ -12,13 +13,15 @@ public class SynchronousReferenceResolveRunner : ReferenceResolveRunnerBase public SynchronousReferenceResolveRunner( RubberduckParserState state, IParserStateManager parserStateManager, - IModuleToModuleReferenceManager moduletToModuleReferenceManager, - IReferenceRemover referenceRemover) + IModuleToModuleReferenceManager moduleToModuleReferenceManager, + IReferenceRemover referenceRemover, + IUserComProjectProvider userComProjectProvider) : base(state, parserStateManager, - moduletToModuleReferenceManager, - referenceRemover) - { } + moduleToModuleReferenceManager, + referenceRemover, + userComProjectProvider) + {} protected override void ResolveReferences(ICollection> toResolve, CancellationToken token) diff --git a/RubberduckTests/Mocks/MockParser.cs b/RubberduckTests/Mocks/MockParser.cs index 222fb32f19..cd5a64e5d9 100644 --- a/RubberduckTests/Mocks/MockParser.cs +++ b/RubberduckTests/Mocks/MockParser.cs @@ -122,7 +122,8 @@ public static (SynchronousParseCoordinator parser, IRewritingManager rewritingMa state, parserStateManager, moduleToModuleReferenceManager, - referenceRemover); + referenceRemover, + userComProjectsRepository); var parsingStageService = new ParsingStageService( comSynchronizer, builtInDeclarationLoader, From 650d5635c934662b8dd6231dc2d6a93453b10859 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Thu, 1 Oct 2020 21:17:43 +0200 Subject: [PATCH 2/7] Change the document module supertype behaviour to adding supertypes without underscore This seems safer in case we actually have a declaration for the interface with an underscore. --- .../ReferenceResolveRunnerBase.cs | 34 +++++++++++++------ 1 file changed, 24 insertions(+), 10 deletions(-) diff --git a/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs b/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs index fc55a4d21c..36916638e4 100644 --- a/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs +++ b/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs @@ -182,16 +182,7 @@ private void AddSuperTypeNamesForDocumentModules(IReadOnlyCollection !i.IsRestricted && !IgnoredComInterfaces.Contains(i.Name)) - .Select(i => i.Name) - .Select(name => name.StartsWith("_") ? name.Substring(1) : name) //This emulates the VBE's behaviour to allow assignment to the coclass type instead on the interface. - ?? Enumerable.Empty(); + var superTypeNames = SuperTypeNamesForDocumentFromComType(comModule); foreach (var superTypeName in superTypeNames) { @@ -201,6 +192,29 @@ private void AddSuperTypeNamesForDocumentModules(IReadOnlyCollection SuperTypeNamesForDocumentFromComType(IComType comModule) + { + var inheritedInterfaces = comModule is ComCoClass documentCoClass + ? documentCoClass.ImplementedInterfaces + : (comModule as ComInterface)?.InheritedInterfaces; + + //todo: Find a way to deal with the VBE's document type assignment behaviour not relying on an assumption about an interface naming convention. + var superTypeNames = (inheritedInterfaces? + .Where(i => !i.IsRestricted && !IgnoredComInterfaces.Contains(i.Name)) + .Select(i => i.Name) + ?? Enumerable.Empty()) + .ToList(); + + //This emulates the VBE's behaviour to allow assignment to the coclass type instead on the interface. + var additionalSuperTypes = superTypeNames + .Where(name => name.StartsWith("_")) + .Select(name => name.Substring(1)) + .ToList(); + + superTypeNames.AddRange(additionalSuperTypes); + return superTypeNames; + } + protected void ResolveReferences(DeclarationFinder finder, QualifiedModuleName module, IParseTree tree, CancellationToken token) { token.ThrowIfCancellationRequested(); From 80e13479f626808f0155a3822bcd4823738aeded Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Fri, 2 Oct 2020 01:36:04 +0200 Subject: [PATCH 3/7] Fix NRE if the user com project for a document module does not exist An appropriate guard clause was missing in the previous two commits. --- .../VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs b/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs index 36916638e4..8c3bd6eda1 100644 --- a/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs +++ b/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs @@ -14,7 +14,6 @@ using Rubberduck.Parsing.VBA.ReferenceManagement.CompilationPasses; using Rubberduck.VBEditor; using Rubberduck.VBEditor.Extensions; -using Rubberduck.VBEditor.SafeComWrappers; namespace Rubberduck.Parsing.VBA.ReferenceManagement { @@ -174,6 +173,12 @@ private void AddSuperTypeNamesForDocumentModules(IReadOnlyCollection module.IdentifierName); foreach (var comModule in userComProject.Members) { From 9a7d34c5c8b8dc3b321dd10639ad749b10c1c635 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Fri, 2 Oct 2020 02:01:50 +0200 Subject: [PATCH 4/7] Add ImplicitContainingWorkbookReferenceInspection and ImplicitContainingWorksheetReferenceInspection These two find unqualified references inside the corresponding document modules to certain members that point to the ActiveWorkbook or ActiveSheet when used unqualified outside the appropriate document modules. That the reference is actually to the containing document can be surprising. Because of that, they should be qualified with Me. This also removes the corresponding false-positives for the ImplicitActiveSheetReferenceInspection and ImplicitActiveWorkbookReferenceInspection. Technically, both the containing and active workbook/worksheet types now share a common base inspection handling (most of) the selection of the declarations whose references can be suspicious. --- .../ImplicitSheetReferenceInspectionBase.cs | 46 ++++ ...ImplicitWorkbookReferenceInspectionBase.cs | 46 ++++ .../ImplicitActiveSheetReferenceInspection.cs | 38 +--- ...plicitActiveWorkbookReferenceInspection.cs | 33 +-- ...itContainingWorkbookReferenceInspection.cs | 72 +++++++ ...tContainingWorksheetReferenceInspection.cs | 59 ++++++ .../CodeInspectionDefaults.Designer.cs | 116 +++++----- .../CodeInspectionDefaults.settings | 2 + .../Inspections/InspectionInfo.Designer.cs | 20 +- .../Inspections/InspectionInfo.de.resx | 6 + .../Inspections/InspectionInfo.resx | 6 + .../Inspections/InspectionNames.Designer.cs | 20 +- .../Inspections/InspectionNames.de.resx | 6 + .../Inspections/InspectionNames.resx | 6 + .../Inspections/InspectionResults.Designer.cs | 20 +- .../Inspections/InspectionResults.de.resx | 6 + .../Inspections/InspectionResults.resx | 7 + ...icitActiveSheetReferenceInspectionTests.cs | 56 +++++ ...tActiveWorkbookReferenceInspectionTests.cs | 83 ++++++++ ...ContainingSheetreferenceInspectionTests.cs | 142 +++++++++++++ ...tainingWorkbookReferenceInspectionTests.cs | 200 ++++++++++++++++++ 21 files changed, 873 insertions(+), 117 deletions(-) create mode 100644 Rubberduck.CodeAnalysis/Inspections/Abstract/ImplicitSheetReferenceInspectionBase.cs create mode 100644 Rubberduck.CodeAnalysis/Inspections/Abstract/ImplicitWorkbookReferenceInspectionBase.cs create mode 100644 Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitContainingWorkbookReferenceInspection.cs create mode 100644 Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitContainingWorksheetReferenceInspection.cs create mode 100644 RubberduckTests/Inspections/ImplicitContainingSheetreferenceInspectionTests.cs create mode 100644 RubberduckTests/Inspections/ImplicitContainingWorkbookReferenceInspectionTests.cs diff --git a/Rubberduck.CodeAnalysis/Inspections/Abstract/ImplicitSheetReferenceInspectionBase.cs b/Rubberduck.CodeAnalysis/Inspections/Abstract/ImplicitSheetReferenceInspectionBase.cs new file mode 100644 index 0000000000..7160af6643 --- /dev/null +++ b/Rubberduck.CodeAnalysis/Inspections/Abstract/ImplicitSheetReferenceInspectionBase.cs @@ -0,0 +1,46 @@ +using System.Collections.Generic; +using System.Linq; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Parsing.VBA.DeclarationCaching; + +namespace Rubberduck.CodeAnalysis.Inspections.Abstract +{ + internal abstract class ImplicitSheetReferenceInspectionBase : IdentifierReferenceInspectionFromDeclarationsBase + { + public ImplicitSheetReferenceInspectionBase(IDeclarationFinderProvider declarationFinderProvider) + : base(declarationFinderProvider) + { } + + protected override IEnumerable ObjectionableDeclarations(DeclarationFinder finder) + { + var excel = finder.Projects + .SingleOrDefault(item => !item.IsUserDefined + && item.IdentifierName == "Excel"); + if (excel == null) + { + return Enumerable.Empty(); + } + + var globalModules = GlobalObjectClassNames + .Select(className => finder.FindClassModule(className, excel, true)) + .OfType(); + + return globalModules + .SelectMany(moduleClass => moduleClass.Members) + .Where(declaration => TargetMemberNames.Contains(declaration.IdentifierName) + && declaration.DeclarationType.HasFlag(DeclarationType.Member) + && declaration.AsTypeName == "Range"); + } + + private static readonly string[] GlobalObjectClassNames = + { + "Global", "_Global" + }; + + private static readonly string[] TargetMemberNames = + { + "Cells", "Range", "Columns", "Rows" + }; + } +} \ No newline at end of file diff --git a/Rubberduck.CodeAnalysis/Inspections/Abstract/ImplicitWorkbookReferenceInspectionBase.cs b/Rubberduck.CodeAnalysis/Inspections/Abstract/ImplicitWorkbookReferenceInspectionBase.cs new file mode 100644 index 0000000000..3fd009e56b --- /dev/null +++ b/Rubberduck.CodeAnalysis/Inspections/Abstract/ImplicitWorkbookReferenceInspectionBase.cs @@ -0,0 +1,46 @@ +using System.Collections.Generic; +using System.Linq; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Parsing.VBA.DeclarationCaching; + +namespace Rubberduck.CodeAnalysis.Inspections.Abstract +{ + internal abstract class ImplicitWorkbookReferenceInspectionBase : IdentifierReferenceInspectionFromDeclarationsBase + { + internal ImplicitWorkbookReferenceInspectionBase(IDeclarationFinderProvider declarationFinderProvider) + : base(declarationFinderProvider) + { } + + private static readonly string[] InterestingMembers = + { + "Worksheets", "Sheets", "Names" + }; + + private static readonly string[] InterestingClasses = + { + "_Global", "_Application", "Global", "Application" + }; + + protected override IEnumerable ObjectionableDeclarations(DeclarationFinder finder) + { + var excel = finder.Projects + .SingleOrDefault(project => project.IdentifierName == "Excel" && !project.IsUserDefined); + if (excel == null) + { + return Enumerable.Empty(); + } + + var relevantClasses = InterestingClasses + .Select(className => finder.FindClassModule(className, excel, true)) + .OfType(); + + var relevantProperties = relevantClasses + .SelectMany(classDeclaration => classDeclaration.Members) + .OfType() + .Where(member => InterestingMembers.Contains(member.IdentifierName)); + + return relevantProperties; + } + } +} \ No newline at end of file diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitActiveSheetReferenceInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitActiveSheetReferenceInspection.cs index 4f2cf28f4e..b7026a6ea7 100644 --- a/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitActiveSheetReferenceInspection.cs +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitActiveSheetReferenceInspection.cs @@ -1,5 +1,4 @@ -using System.Collections.Generic; -using System.Linq; +using System.Linq; using Rubberduck.CodeAnalysis.Inspections.Abstract; using Rubberduck.CodeAnalysis.Inspections.Attributes; using Rubberduck.Parsing.Symbols; @@ -10,7 +9,7 @@ namespace Rubberduck.CodeAnalysis.Inspections.Concrete { /// - /// Locates unqualified Worksheet.Range/Cells/Columns/Rows member calls that implicitly refer to ActiveSheet. + /// Locates unqualified Worksheet.Range/Cells/Columns/Rows member calls inside worksheet modules. /// /// /// @@ -42,43 +41,18 @@ namespace Rubberduck.CodeAnalysis.Inspections.Concrete /// /// [RequiredLibrary("Excel")] - internal sealed class ImplicitActiveSheetReferenceInspection : IdentifierReferenceInspectionFromDeclarationsBase + internal sealed class ImplicitActiveSheetReferenceInspection : ImplicitSheetReferenceInspectionBase { public ImplicitActiveSheetReferenceInspection(IDeclarationFinderProvider declarationFinderProvider) : base(declarationFinderProvider) {} - protected override IEnumerable ObjectionableDeclarations(DeclarationFinder finder) + protected override bool IsResultReference(IdentifierReference reference, DeclarationFinder finder) { - var excel = finder.Projects - .SingleOrDefault(item => !item.IsUserDefined - && item.IdentifierName == "Excel"); - if (excel == null) - { - return Enumerable.Empty(); - } - - var globalModules = GlobalObjectClassNames - .Select(className => finder.FindClassModule(className, excel, true)) - .OfType(); - - return globalModules - .SelectMany(moduleClass => moduleClass.Members) - .Where(declaration => TargetMemberNames.Contains(declaration.IdentifierName) - && declaration.DeclarationType.HasFlag(DeclarationType.Member) - && declaration.AsTypeName == "Range"); + return !(Declaration.GetModuleParent(reference.ParentNonScoping) is DocumentModuleDeclaration document) + || !document.SupertypeNames.Contains("Worksheet"); } - private static readonly string[] GlobalObjectClassNames = - { - "Global", "_Global" - }; - - private static readonly string[] TargetMemberNames = - { - "Cells", "Range", "Columns", "Rows" - }; - protected override string ResultDescription(IdentifierReference reference) { return string.Format( diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitActiveWorkbookReferenceInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitActiveWorkbookReferenceInspection.cs index 0f976c810c..f90b6011ff 100644 --- a/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitActiveWorkbookReferenceInspection.cs +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitActiveWorkbookReferenceInspection.cs @@ -40,41 +40,22 @@ namespace Rubberduck.CodeAnalysis.Inspections.Concrete /// /// [RequiredLibrary("Excel")] - internal sealed class ImplicitActiveWorkbookReferenceInspection : IdentifierReferenceInspectionFromDeclarationsBase + internal sealed class ImplicitActiveWorkbookReferenceInspection : ImplicitWorkbookReferenceInspectionBase { public ImplicitActiveWorkbookReferenceInspection(IDeclarationFinderProvider declarationFinderProvider) : base(declarationFinderProvider) {} - private static readonly string[] InterestingMembers = + private static readonly List _alwaysActiveWorkbookReferenceParents = new List { - "Worksheets", "Sheets", "Names" + "_Application", "Application" }; - private static readonly string[] InterestingClasses = + protected override bool IsResultReference(IdentifierReference reference, DeclarationFinder finder) { - "_Global", "_Application", "Global", "Application" - }; - - protected override IEnumerable ObjectionableDeclarations(DeclarationFinder finder) - { - var excel = finder.Projects - .SingleOrDefault(project => project.IdentifierName == "Excel" && !project.IsUserDefined); - if (excel == null) - { - return Enumerable.Empty(); - } - - var relevantClasses = InterestingClasses - .Select(className => finder.FindClassModule(className, excel, true)) - .OfType(); - - var relevantProperties = relevantClasses - .SelectMany(classDeclaration => classDeclaration.Members) - .OfType() - .Where(member => InterestingMembers.Contains(member.IdentifierName)); - - return relevantProperties; + return !(Declaration.GetModuleParent(reference.ParentNonScoping) is DocumentModuleDeclaration document) + || !document.SupertypeNames.Contains("Workbook") + || _alwaysActiveWorkbookReferenceParents.Contains(reference.Declaration.ParentDeclaration.IdentifierName); } protected override string ResultDescription(IdentifierReference reference) diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitContainingWorkbookReferenceInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitContainingWorkbookReferenceInspection.cs new file mode 100644 index 0000000000..cc2ab5efd6 --- /dev/null +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitContainingWorkbookReferenceInspection.cs @@ -0,0 +1,72 @@ +using System.Collections.Generic; +using System.Linq; +using Rubberduck.CodeAnalysis.Inspections.Abstract; +using Rubberduck.CodeAnalysis.Inspections.Attributes; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Parsing.VBA.DeclarationCaching; +using Rubberduck.Resources.Inspections; + +namespace Rubberduck.CodeAnalysis.Inspections.Concrete +{ + /// + /// Locates unqualified Workbook.Worksheets/Sheets/Names member calls inside workbook document modules that implicitly refer to the containing workbook. + /// + /// + /// + /// Implicit references inside a workbook document module can be mistakes for implicit references to the active workbook, which is the behavior in all other modules + /// By explicitly qualifying these member calls with Me, the ambiguity can be resolved. + /// + /// + /// + /// + /// + /// + /// + /// + /// + /// + /// + [RequiredLibrary("Excel")] + internal sealed class ImplicitContainingWorkbookReferenceInspection : ImplicitWorkbookReferenceInspectionBase + { + public ImplicitContainingWorkbookReferenceInspection(IDeclarationFinderProvider declarationFinderProvider) + : base(declarationFinderProvider) + { } + + private static readonly List _alwaysActiveWorkbookReferenceParents = new List + { + "_Application", "Application" + }; + + protected override IEnumerable ObjectionableDeclarations(DeclarationFinder finder) + { + return base.ObjectionableDeclarations(finder) + .Where(declaration => !_alwaysActiveWorkbookReferenceParents.Contains(declaration.ParentDeclaration.IdentifierName)); + } + + protected override bool IsResultReference(IdentifierReference reference, DeclarationFinder finder) + { + return Declaration.GetModuleParent(reference.ParentNonScoping) is DocumentModuleDeclaration document + && document.SupertypeNames.Contains("Workbook"); + } + + protected override string ResultDescription(IdentifierReference reference) + { + var referenceText = reference.Context.GetText(); + return string.Format( + InspectionResults.ImplicitContainingWorkbookReferenceInspection, + referenceText); + } + } +} \ No newline at end of file diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitContainingWorksheetReferenceInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitContainingWorksheetReferenceInspection.cs new file mode 100644 index 0000000000..2e2038dfde --- /dev/null +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/ImplicitContainingWorksheetReferenceInspection.cs @@ -0,0 +1,59 @@ +using System.Linq; +using Rubberduck.CodeAnalysis.Inspections.Abstract; +using Rubberduck.CodeAnalysis.Inspections.Attributes; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Parsing.VBA.DeclarationCaching; +using Rubberduck.Resources.Inspections; + +namespace Rubberduck.CodeAnalysis.Inspections.Concrete +{ + /// + /// Locates unqualified Worksheet.Range/Cells/Columns/Rows member calls inside worksheet modules that implicitly refer to the containing sheet. + /// + /// + /// + /// Implicit references inside a worksheet document module can be mistakes for implicit references to the active worksheet, which is the behavior in all other places. + /// By explicitly qualifying these member calls with Me, the ambiguity can be resolved. + /// + /// + /// + /// + /// + /// + /// + /// + /// + /// + /// + [RequiredLibrary("Excel")] + internal sealed class ImplicitContainingWorksheetReferenceInspection : ImplicitSheetReferenceInspectionBase + { + public ImplicitContainingWorksheetReferenceInspection(IDeclarationFinderProvider declarationFinderProvider) + : base(declarationFinderProvider) + {} + + protected override bool IsResultReference(IdentifierReference reference, DeclarationFinder finder) + { + return Declaration.GetModuleParent(reference.ParentNonScoping) is DocumentModuleDeclaration document + && document.SupertypeNames.Contains("Worksheet"); + } + + protected override string ResultDescription(IdentifierReference reference) + { + return string.Format( + InspectionResults.ImplicitContainingWorksheetReferenceInspection, + reference.Declaration.IdentifierName); + } + } +} \ No newline at end of file diff --git a/Rubberduck.CodeAnalysis/Properties/CodeInspectionDefaults.Designer.cs b/Rubberduck.CodeAnalysis/Properties/CodeInspectionDefaults.Designer.cs index 999c5f7299..c7d0c0aed7 100644 --- a/Rubberduck.CodeAnalysis/Properties/CodeInspectionDefaults.Designer.cs +++ b/Rubberduck.CodeAnalysis/Properties/CodeInspectionDefaults.Designer.cs @@ -92,63 +92,67 @@ public sealed partial class CodeInspectionDefaults : global::System.Configuratio "odeInspection Name=\"HungarianNotationInspection\" Severity=\"Suggestion\" Inspectio" + "nType=\"MaintainabilityAndReadabilityIssues\" />\r\n \r\n \r\n \r\n \r\n " + - " \r\n \r\n " + - "\r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n <" + - "CodeInspection Name=\"ModuleWithoutFolderInspection\" Severity=\"Suggestion\" Inspec" + - "tionType=\"RubberduckOpportunities\" />\r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n true\r\n")] + "odeInspection Name=\"ImplicitPublicMemberInspection\" Severity=\"Hint\" InspectionTy" + + "pe=\"LanguageOpportunities\" />\r\n \r\n \r\n " + + "\r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n \r\n <" + + "CodeInspection Name=\"IsMissingWithNonArgumentParameterInspection\" Severity=\"Warn" + + "ing\" InspectionType=\"CodeQualityIssues\" />\r\n \r\n" + + " \r\n \r\n \r\n \r\n true\r\n")] public global::Rubberduck.CodeAnalysis.Settings.CodeInspectionSettings CodeInspectionSettings { get { return ((global::Rubberduck.CodeAnalysis.Settings.CodeInspectionSettings)(this["CodeInspectionSettings"])); diff --git a/Rubberduck.CodeAnalysis/Properties/CodeInspectionDefaults.settings b/Rubberduck.CodeAnalysis/Properties/CodeInspectionDefaults.settings index 864f41f743..d0b41da20e 100644 --- a/Rubberduck.CodeAnalysis/Properties/CodeInspectionDefaults.settings +++ b/Rubberduck.CodeAnalysis/Properties/CodeInspectionDefaults.settings @@ -48,7 +48,9 @@ <CodeInspection Name="HostSpecificExpressionInspection" Severity="Warning" InspectionType="LanguageOpportunities" /> <CodeInspection Name="HungarianNotationInspection" Severity="Suggestion" InspectionType="MaintainabilityAndReadabilityIssues" /> <CodeInspection Name="ImplicitActiveSheetReferenceInspection" Severity="Warning" InspectionType="LanguageOpportunities" /> + <CodeInspection Name="ImplicitContainingSheetReferenceInspection" Severity="Suggestion" InspectionType="LanguageOpportunities" /> <CodeInspection Name="ImplicitActiveWorkbookReferenceInspection" Severity="Warning" InspectionType="LanguageOpportunities" /> + <CodeInspection Name="ImplicitContainingWorkbookReferenceInspection" Severity="Suggestion" InspectionType="LanguageOpportunities" /> <CodeInspection Name="ImplicitDefaultMemberAssignmentInspection" Severity="Suggestion" InspectionType="LanguageOpportunities" /> <CodeInspection Name="ImplicitPublicMemberInspection" Severity="Hint" InspectionType="LanguageOpportunities" /> <CodeInspection Name="ImplicitVariantReturnTypeInspection" Severity="Hint" InspectionType="LanguageOpportunities" /> diff --git a/Rubberduck.Resources/Inspections/InspectionInfo.Designer.cs b/Rubberduck.Resources/Inspections/InspectionInfo.Designer.cs index 5456788d54..7f9fc2bc26 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 { @@ -357,6 +357,24 @@ public class InspectionInfo { } } + /// + /// Looks up a localized string similar to Implicit references to workbook members inside a workbook document module can be mistakes for implicit references to the active workbook, which is the behavior in all other modules. By explicitly qualifying these member calls with Me, the ambiguity can be resolved.. + /// + public static string ImplicitContainingWorkbookReferenceInspection { + get { + return ResourceManager.GetString("ImplicitContainingWorkbookReferenceInspection", resourceCulture); + } + } + + /// + /// Looks up a localized string similar to Implicit references to worksheet members inside a worksheet document module can be mistakes for implicit references to the active worksheet, which is the behavior in all other modules. By explicitly qualifying these member calls with Me, the ambiguity can be resolved.. + /// + public static string ImplicitContainingWorksheetReferenceInspection { + get { + return ResourceManager.GetString("ImplicitContainingWorksheetReferenceInspection", resourceCulture); + } + } + /// /// Looks up a localized string similar to Default member accesses hide away the actually called member. This is especially misleading if there is no indication in the expression that such a call is made. It can cause errors in which a member was forgotten to be called to go unnoticed.. /// diff --git a/Rubberduck.Resources/Inspections/InspectionInfo.de.resx b/Rubberduck.Resources/Inspections/InspectionInfo.de.resx index cee0d8c7be..2473ca2af4 100644 --- a/Rubberduck.Resources/Inspections/InspectionInfo.de.resx +++ b/Rubberduck.Resources/Inspections/InspectionInfo.de.resx @@ -442,4 +442,10 @@ Falls der Parameter 'null' sein kann, bitte dieses Auftreten ignorieren. 'null' Eine Annotation hat mehr Argumente als erlaubt. Die überzähligen Argumente werden ignoriert. + + Implizite Referenzen zu Elementen eines Workbooks in einem Workbook-Modul können mit Referenzen zum aktiven Workbook verwechselt werden, da dies das Verhalten für solche Referenzen ist überall außerhalb von Workbook-Modulen. Die Uneindeutigkeit kann aufgelöst werden, indem die Referenzen mit 'Me' qualifiziert werden. + + + Implizite Referenzen zu Elementen eines Worksheets in einem Worksheet-Modul können mit Referenzen zum aktiven Worksheet verwechselt werden, da dies das Verhalten für solche Referenzen ist überall außerhalb von Worksheet-Modulen. Die Uneindeutigkeit kann aufgelöst werden, indem die Referenzen mit 'Me' qualifiziert werden. + \ No newline at end of file diff --git a/Rubberduck.Resources/Inspections/InspectionInfo.resx b/Rubberduck.Resources/Inspections/InspectionInfo.resx index 48142a3ca8..f2c24146ba 100644 --- a/Rubberduck.Resources/Inspections/InspectionInfo.resx +++ b/Rubberduck.Resources/Inspections/InspectionInfo.resx @@ -442,4 +442,10 @@ 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. + + Implicit references to workbook members inside a workbook document module can be mistakes for implicit references to the active workbook, which is the behavior in all other modules. By explicitly qualifying these member calls with Me, the ambiguity can be resolved. + + + Implicit references to worksheet members inside a worksheet document module can be mistakes for implicit references to the active worksheet, which is the behavior in all other modules. By explicitly qualifying these member calls with Me, the ambiguity can be resolved. + \ No newline at end of file diff --git a/Rubberduck.Resources/Inspections/InspectionNames.Designer.cs b/Rubberduck.Resources/Inspections/InspectionNames.Designer.cs index e5f58a3536..5b076eef8e 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 { @@ -357,6 +357,24 @@ public class InspectionNames { } } + /// + /// Looks up a localized string similar to Implicit reference to the containing Workbook module. + /// + public static string ImplicitContainingWorkbookReferenceInspection { + get { + return ResourceManager.GetString("ImplicitContainingWorkbookReferenceInspection", resourceCulture); + } + } + + /// + /// Looks up a localized string similar to Implicit reference to containing Worksheet module. + /// + public static string ImplicitContainingWorksheetReferenceInspection { + get { + return ResourceManager.GetString("ImplicitContainingWorksheetReferenceInspection", resourceCulture); + } + } + /// /// Looks up a localized string similar to Implicit default member access. /// diff --git a/Rubberduck.Resources/Inspections/InspectionNames.de.resx b/Rubberduck.Resources/Inspections/InspectionNames.de.resx index 8301974bb3..f129a82bbf 100644 --- a/Rubberduck.Resources/Inspections/InspectionNames.de.resx +++ b/Rubberduck.Resources/Inspections/InspectionNames.de.resx @@ -438,4 +438,10 @@ Name, der ein geschütztes Leerzeichen enthält + + Implizite Referenz zum umgebenden Worksheet-Modul + + + Implizite Referenz zum umgebenden Workbook-Modul + \ No newline at end of file diff --git a/Rubberduck.Resources/Inspections/InspectionNames.resx b/Rubberduck.Resources/Inspections/InspectionNames.resx index 2b7f7de244..454a369b70 100644 --- a/Rubberduck.Resources/Inspections/InspectionNames.resx +++ b/Rubberduck.Resources/Inspections/InspectionNames.resx @@ -446,4 +446,10 @@ Superfluous annotation arguments + + Implicit reference to containing Worksheet module + + + Implicit reference to the containing Workbook module + \ No newline at end of file diff --git a/Rubberduck.Resources/Inspections/InspectionResults.Designer.cs b/Rubberduck.Resources/Inspections/InspectionResults.Designer.cs index 00e2338b40..10a437fb01 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 { @@ -366,6 +366,24 @@ public class InspectionResults { } } + /// + /// Looks up a localized string similar to Member '{0}' implicitly references the containing workbook document module.. + /// + public static string ImplicitContainingWorkbookReferenceInspection { + get { + return ResourceManager.GetString("ImplicitContainingWorkbookReferenceInspection", resourceCulture); + } + } + + /// + /// Looks up a localized string similar to Member '{0}' implicitly references the containing worksheet document module.. + /// + public static string ImplicitContainingWorksheetReferenceInspection { + get { + return ResourceManager.GetString("ImplicitContainingWorksheetReferenceInspection", resourceCulture); + } + } + /// /// Looks up a localized string similar to On the expression '{0}', there is an implicit default member access to '{1}'.. /// diff --git a/Rubberduck.Resources/Inspections/InspectionResults.de.resx b/Rubberduck.Resources/Inspections/InspectionResults.de.resx index 9f65f6db82..14d64a6d77 100644 --- a/Rubberduck.Resources/Inspections/InspectionResults.de.resx +++ b/Rubberduck.Resources/Inspections/InspectionResults.de.resx @@ -467,4 +467,10 @@ In Memoriam, 1972-2018 Die Annotation '{0}' erwartet weniger Argumente. + + Element '{0}' referenziert implizit auf das umgebende Workbook-Modul. + + + Element '{0}' referenziert implizit auf das umgebende Worksheet-Modul. + \ No newline at end of file diff --git a/Rubberduck.Resources/Inspections/InspectionResults.resx b/Rubberduck.Resources/Inspections/InspectionResults.resx index aa86d062a7..71e550e9b8 100644 --- a/Rubberduck.Resources/Inspections/InspectionResults.resx +++ b/Rubberduck.Resources/Inspections/InspectionResults.resx @@ -513,4 +513,11 @@ In memoriam, 1972-2018 The annotation '{0}' was expected to have less arguments. {0} annotation name + + Member '{0}' implicitly references the containing workbook document module. + {0} member name + + + Member '{0}' implicitly references the containing worksheet document module. + \ No newline at end of file diff --git a/RubberduckTests/Inspections/ImplicitActiveSheetReferenceInspectionTests.cs b/RubberduckTests/Inspections/ImplicitActiveSheetReferenceInspectionTests.cs index 83553f15ad..b450db962f 100644 --- a/RubberduckTests/Inspections/ImplicitActiveSheetReferenceInspectionTests.cs +++ b/RubberduckTests/Inspections/ImplicitActiveSheetReferenceInspectionTests.cs @@ -1,7 +1,9 @@ using System.Linq; +using System.Threading; using NUnit.Framework; using Rubberduck.CodeAnalysis.Inspections; using Rubberduck.CodeAnalysis.Inspections.Concrete; +using Rubberduck.Parsing.Symbols; using Rubberduck.Parsing.VBA; using Rubberduck.VBEditor.SafeComWrappers; using RubberduckTests.Mocks; @@ -67,6 +69,60 @@ End Sub Assert.AreEqual(1, InspectionResultsForModules(modules, ReferenceLibrary.Excel).Count()); } + [Test] + [Category("Inspections")] + public void ImplicitActiveSheetReference_DoesNotReportInWorkSheetModules() + { + const string inputCode = + @"Sub foo() + Dim arr1() As Variant + arr1 = Cells(1,2) +End Sub +"; + var module = ("Sheet1", inputCode, ComponentType.Document); + var vbe = MockVbeBuilder.BuildFromModules(module, ReferenceLibrary.Excel).Object; + + using (var state = MockParser.CreateAndParse(vbe)) + { + var documentModule = state.DeclarationFinder.UserDeclarations(DeclarationType.Document) + .OfType() + .Single(); + documentModule.AddSupertypeName("Worksheet"); + + var inspection = InspectionUnderTest(state); + var inspectionResults = inspection.GetInspectionResults(CancellationToken.None); + + Assert.AreEqual(0, inspectionResults.Count()); + } + } + + [Test] + [Category("Inspections")] + public void ImplicitActiveSheetReference_ReportsInWorkbookModules() + { + const string inputCode = + @"Sub foo() + Dim arr1() As Variant + arr1 = Cells(1,2) +End Sub +"; + var module = ("Sheet1", inputCode, ComponentType.Document); + var vbe = MockVbeBuilder.BuildFromModules(module, ReferenceLibrary.Excel).Object; + + using (var state = MockParser.CreateAndParse(vbe)) + { + var documentModule = state.DeclarationFinder.UserDeclarations(DeclarationType.Document) + .OfType() + .Single(); + documentModule.AddSupertypeName("Workbook"); + + var inspection = InspectionUnderTest(state); + var inspectionResults = inspection.GetInspectionResults(CancellationToken.None); + + Assert.AreEqual(1, inspectionResults.Count()); + } + } + [Test] [Category("Inspections")] public void ImplicitActiveSheetReference_Ignored_DoesNotReportRange() diff --git a/RubberduckTests/Inspections/ImplicitActiveWorkbookReferenceInspectionTests.cs b/RubberduckTests/Inspections/ImplicitActiveWorkbookReferenceInspectionTests.cs index 6e2a196150..a92889d39e 100644 --- a/RubberduckTests/Inspections/ImplicitActiveWorkbookReferenceInspectionTests.cs +++ b/RubberduckTests/Inspections/ImplicitActiveWorkbookReferenceInspectionTests.cs @@ -1,7 +1,9 @@ using System.Linq; +using System.Threading; using NUnit.Framework; using Rubberduck.CodeAnalysis.Inspections; using Rubberduck.CodeAnalysis.Inspections.Concrete; +using Rubberduck.Parsing.Symbols; using Rubberduck.Parsing.VBA; using Rubberduck.VBEditor.SafeComWrappers; using RubberduckTests.Mocks; @@ -160,6 +162,87 @@ Sub foo() Assert.AreEqual(expected, actual); } + [Test] + [Category("Inspections")] + public void ImplicitActiveWorkbookReference_DoesNotReportUnqualifiedInWorkbookModules() + { + const string inputCode = + @" +Sub foo() + Dim sheet As Worksheet + Set sheet = Worksheets(""Sheet1"") +End Sub"; + var module = ("SomeWorkbook", inputCode, ComponentType.Document); + var vbe = MockVbeBuilder.BuildFromModules(module, ReferenceLibrary.Excel).Object; + + using (var state = MockParser.CreateAndParse(vbe)) + { + var documentModule = state.DeclarationFinder.UserDeclarations(DeclarationType.Document) + .OfType() + .Single(); + documentModule.AddSupertypeName("Workbook"); + + var inspection = InspectionUnderTest(state); + var inspectionResults = inspection.GetInspectionResults(CancellationToken.None); + + Assert.AreEqual(0, inspectionResults.Count()); + } + } + + [Test] + [Category("Inspections")] + public void ImplicitActiveWorkbookReference_ReportsApplicationQualifiedInWorkbookModules() + { + const string inputCode = + @" +Sub foo() + Dim sheet As Worksheet + Set sheet = Application.Worksheets(""Sheet1"") +End Sub"; + var module = ("SomeWorkbook", inputCode, ComponentType.Document); + var vbe = MockVbeBuilder.BuildFromModules(module, ReferenceLibrary.Excel).Object; + + using (var state = MockParser.CreateAndParse(vbe)) + { + var documentModule = state.DeclarationFinder.UserDeclarations(DeclarationType.Document) + .OfType() + .Single(); + documentModule.AddSupertypeName("Workbook"); + + var inspection = InspectionUnderTest(state); + var inspectionResults = inspection.GetInspectionResults(CancellationToken.None); + + Assert.AreEqual(1, inspectionResults.Count()); + } + } + + [Test] + [Category("Inspections")] + public void ImplicitActiveWorkbookReference_ReportsInWorksheetModules() + { + const string inputCode = + @" +Sub foo() + Dim sheet As Worksheet + Set sheet = Worksheets(""Sheet1"") +End Sub"; + var module = ("Sheet1", inputCode, ComponentType.Document); + var vbe = MockVbeBuilder.BuildFromModules(module, ReferenceLibrary.Excel).Object; + + using (var state = MockParser.CreateAndParse(vbe)) + { + var documentModule = state.DeclarationFinder.UserDeclarations(DeclarationType.Document) + .OfType() + .Single(); + documentModule.AddSupertypeName("Worksheet"); + + var inspection = InspectionUnderTest(state); + var inspectionResults = inspection.GetInspectionResults(CancellationToken.None); + + Assert.AreEqual(1, inspectionResults.Count()); + } + } + [Test] [Category("Inspections")] public void ImplicitActiveWorkbookReference_Ignored_DoesNotReportRange() diff --git a/RubberduckTests/Inspections/ImplicitContainingSheetreferenceInspectionTests.cs b/RubberduckTests/Inspections/ImplicitContainingSheetreferenceInspectionTests.cs new file mode 100644 index 0000000000..79aea689d1 --- /dev/null +++ b/RubberduckTests/Inspections/ImplicitContainingSheetreferenceInspectionTests.cs @@ -0,0 +1,142 @@ +using System.Collections.Generic; +using System.Linq; +using System.Threading; +using NUnit.Framework; +using Rubberduck.CodeAnalysis.Inspections; +using Rubberduck.CodeAnalysis.Inspections.Concrete; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.VBEditor.SafeComWrappers; +using RubberduckTests.Mocks; + +namespace RubberduckTests.Inspections +{ + [TestFixture] + public class ImplicitContainingSheetReferenceInspectionTests : InspectionTestsBase + { + [Test] + [Category("Inspections")] + public void ImplicitContainingSheetReference_ReportsRangeInWorksheets() + { + const string inputCode = +@"Sub foo() + Dim arr1() As Variant + arr1 = Range(""A1:B2"") +End Sub +"; + Assert.AreEqual(1, InspectionResultsInWorksheet(inputCode).Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingSheetReference_ReportsCellsInWorksheets() + { + const string inputCode = + @"Sub foo() + Dim arr1() As Variant + arr1 = Cells(1,2) +End Sub +"; + Assert.AreEqual(1, InspectionResultsInWorksheet(inputCode).Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingSheetReference_ReportsColumnsInWorksheets() + { + const string inputCode = + @"Sub foo() + Dim arr1() As Variant + arr1 = Columns(3) +End Sub +"; + Assert.AreEqual(1, InspectionResultsInWorksheet(inputCode).Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingSheetReference_ReportsRowsInWorksheets() + { + const string inputCode = + @"Sub foo() + Dim arr1() As Variant + arr1 = Rows(3) +End Sub +"; + Assert.AreEqual(1, InspectionResultsInWorksheet(inputCode).Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingSheetReference_DoesNotReportsMembersQualifiedWithMe() + { + const string inputCode = + @"Sub foo() + Dim arr1() As Variant + arr1 = Me.Rows(3) +End Sub +"; + Assert.AreEqual(0, InspectionResultsInWorksheet(inputCode).Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingSheetReference_DoesNotReportOutsideWorkSheetModules() + { + const string inputCode = + @"Sub foo() + Dim arr1() As Variant + arr1 = Cells(1,2) +End Sub +"; + var modules = new (string, string, ComponentType)[] { ("Class1", inputCode, ComponentType.ClassModule) }; + Assert.AreEqual(0, InspectionResultsForModules(modules, ReferenceLibrary.Excel).Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingSheetReference_Ignored_DoesNotReportRange() + { + const string inputCode = +@"Sub foo() + Dim arr1() As Variant + + '@Ignore ImplicitContainingWorksheetReference + arr1 = Range(""A1:B2"") +End Sub +"; + Assert.AreEqual(0, InspectionResultsInWorksheet(inputCode).Count()); + } + + [Test] + [Category("Inspections")] + public void InspectionName() + { + var inspection = new ImplicitContainingWorksheetReferenceInspection(null); + + Assert.AreEqual(nameof(ImplicitContainingWorksheetReferenceInspection), inspection.Name); + } + + private IEnumerable InspectionResultsInWorksheet(string inputCode) + { + var module = ("Sheet1", inputCode, ComponentType.Document); + var vbe = MockVbeBuilder.BuildFromModules(module, ReferenceLibrary.Excel).Object; + + using (var state = MockParser.CreateAndParse(vbe)) + { + var documentModule = state.DeclarationFinder.UserDeclarations(DeclarationType.Document) + .OfType() + .Single(); + documentModule.AddSupertypeName("Worksheet"); + + var inspection = InspectionUnderTest(state); + return inspection.GetInspectionResults(CancellationToken.None); + } + } + + protected override IInspection InspectionUnderTest(RubberduckParserState state) + { + return new ImplicitContainingWorksheetReferenceInspection(state); + } + } +} \ No newline at end of file diff --git a/RubberduckTests/Inspections/ImplicitContainingWorkbookReferenceInspectionTests.cs b/RubberduckTests/Inspections/ImplicitContainingWorkbookReferenceInspectionTests.cs new file mode 100644 index 0000000000..29ecc902c3 --- /dev/null +++ b/RubberduckTests/Inspections/ImplicitContainingWorkbookReferenceInspectionTests.cs @@ -0,0 +1,200 @@ +using System.Collections.Generic; +using System.Linq; +using System.Threading; +using NUnit.Framework; +using Rubberduck.CodeAnalysis.Inspections; +using Rubberduck.CodeAnalysis.Inspections.Concrete; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.VBEditor.SafeComWrappers; +using RubberduckTests.Mocks; + +namespace RubberduckTests.Inspections +{ + [TestFixture] + public class ImplicitContainingWorkbookReferenceInspectionTests : InspectionTestsBase + { + [Test] + [Category("Inspections")] + public void ImplicitContainingWorkbookReference_ReportsWorksheets() + { + const string inputCode = + @" +Sub foo() + Dim sheet As Worksheet + Set sheet = Worksheets(""Sheet1"") +End Sub"; + Assert.AreEqual(1, InspectionResultsInWorkbook(inputCode).Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingWorkbookReference_ExplicitApplication() + { + const string inputCode = + @" +Sub foo() + Dim sheet As Worksheet + Set sheet = Application.Worksheets(""Sheet1"") +End Sub"; + Assert.AreEqual(0, InspectionResultsInWorkbook(inputCode).Count()); + ; + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingWorkbookReference_ReportsSheets() + { + const string inputCode = + @" +Sub foo() + Dim sheet As Worksheet + Set sheet = Sheets(""Sheet1"") +End Sub"; + Assert.AreEqual(1, InspectionResultsInWorkbook(inputCode).Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingWorkbookReference_ReportsNames() + { + const string inputCode = + @" +Sub foo() + Names.Add ""foo"", Rows(1) +End Sub"; + Assert.AreEqual(1, InspectionResultsInWorkbook(inputCode).Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingWorkbookReference_ExplicitReference_NotReported() + { + const string inputCode = + @" +Sub foo() + Dim book As Workbook + Dim sheet As Worksheet + Set sheet = book.Worksheets(1) +End Sub"; + Assert.AreEqual(0, InspectionResultsInWorkbook(inputCode).Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingWorkbookReference_MeReference_NotReported() + { + const string inputCode = + @" +Sub foo() + Dim sheet As Worksheet + Set sheet = Me.Worksheets(1) +End Sub"; + Assert.AreEqual(0, InspectionResultsInWorkbook(inputCode).Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingWorkbookReference_DimAsTypeWorksheets_NotReported() + { + const string inputCode = + @" +Sub foo() + Dim allSheets As Worksheets +End Sub"; + Assert.AreEqual(0, InspectionResultsInWorkbook(inputCode).Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingWorkbookReference_DimAsTypeSheets_NotReported() + { + const string inputCode = + @" +Sub foo() + Dim allSheets As Sheets +End Sub"; + Assert.AreEqual(0, InspectionResultsInWorkbook(inputCode).Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingWorkbookReference_DimAsTypeNames_NotReported() + { + const string inputCode = + @" +Sub foo() + Dim allNames As Names +End Sub"; + Assert.AreEqual(0, InspectionResultsInWorkbook(inputCode).Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingWorkbookReference_DoesNotReportUnqualifiedOutsideWorkbookModules() + { + const string inputCode = + @" +Sub foo() + Dim sheet As Worksheet + Set sheet = Worksheets(""Sheet1"") +End Sub"; + const int expected = 0; + var actual = ArrangeOutsideWorkbookAndGetInspectionCount(inputCode); + + Assert.AreEqual(expected, actual); + } + + [Test] + [Category("Inspections")] + public void ImplicitContainingWorkbookReference_Ignored_DoesNotReportRange() + { + const string inputCode = + @" +Sub foo() + Dim sheet As Worksheet + + '@Ignore ImplicitContainingWorkbookReference + Set sheet = Worksheets(""Sheet1"") +End Sub"; + Assert.AreEqual(0, InspectionResultsInWorkbook(inputCode).Count()); + } + + private int ArrangeOutsideWorkbookAndGetInspectionCount(string code) + { + var modules = new (string, string, ComponentType)[] {("Module1", code, ComponentType.StandardModule)}; + return InspectionResultsForModules(modules, ReferenceLibrary.Excel).Count(); + } + + [Test] + [Category("Inspections")] + public void InspectionName() + { + var inspection = new ImplicitContainingWorkbookReferenceInspection(null); + + Assert.AreEqual(nameof(ImplicitContainingWorkbookReferenceInspection), inspection.Name); + } + + private IEnumerable InspectionResultsInWorkbook(string inputCode) + { + var module = ("SomeWorkbook", inputCode, ComponentType.Document); + var vbe = MockVbeBuilder.BuildFromModules(module, ReferenceLibrary.Excel).Object; + + using (var state = MockParser.CreateAndParse(vbe)) + { + var documentModule = state.DeclarationFinder.UserDeclarations(DeclarationType.Document) + .OfType() + .Single(); + documentModule.AddSupertypeName("Workbook"); + + var inspection = InspectionUnderTest(state); + return inspection.GetInspectionResults(CancellationToken.None); + } + } + + protected override IInspection InspectionUnderTest(RubberduckParserState state) + { + return new ImplicitContainingWorkbookReferenceInspection(state); + } + } +} \ No newline at end of file From a5b115e7610cb3753692a4f715bba15e5e76a70f Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Fri, 2 Oct 2020 02:36:32 +0200 Subject: [PATCH 5/7] Adjust com interface discovery for documents with separate interface Hosts like Access insert an additional interface for document modules between the document and the built-in one. Since we do not have a declaration for the separate interface, we also add the interface two levels op to the supertypes of the document. --- .../ReferenceResolveRunnerBase.cs | 39 +++++++++++++------ 1 file changed, 28 insertions(+), 11 deletions(-) diff --git a/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs b/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs index 8c3bd6eda1..315f2a149a 100644 --- a/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs +++ b/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs @@ -200,23 +200,40 @@ private void AddSuperTypeNamesForDocumentModules(IReadOnlyCollection SuperTypeNamesForDocumentFromComType(IComType comModule) { var inheritedInterfaces = comModule is ComCoClass documentCoClass - ? documentCoClass.ImplementedInterfaces - : (comModule as ComInterface)?.InheritedInterfaces; - - //todo: Find a way to deal with the VBE's document type assignment behaviour not relying on an assumption about an interface naming convention. - var superTypeNames = (inheritedInterfaces? - .Where(i => !i.IsRestricted && !IgnoredComInterfaces.Contains(i.Name)) - .Select(i => i.Name) - ?? Enumerable.Empty()) + ? documentCoClass.ImplementedInterfaces.ToList() + : (comModule as ComInterface)?.InheritedInterfaces.ToList(); + + if (inheritedInterfaces == null) + { + return Enumerable.Empty(); + } + + var relevantInterfaces = inheritedInterfaces + .Where(i => !i.IsRestricted && !IgnoredComInterfaces.Contains(i.Name)) + .ToList(); + + //todo: Find a way to deal with the VBE's document type assignment and interface behaviour not relying on an assumption about an interface naming conventions. + + //Some hosts like Access chose to have a separate hidden interface for each document module and only let that inherit the built-in base interface. + //Since we do not have a declaration for the hidden interface, we have to go one more step up the hierarchy. + var additionalInterfaces = relevantInterfaces + .Where(i => i.Name.Equals("_" + comModule.Name)) + .SelectMany(i => i.InheritedInterfaces); + + relevantInterfaces.AddRange(additionalInterfaces); + + var superTypeNames = relevantInterfaces + .Select(i => i.Name) .ToList(); //This emulates the VBE's behaviour to allow assignment to the coclass type instead on the interface. - var additionalSuperTypes = superTypeNames + var additionalSuperTypeNames = superTypeNames .Where(name => name.StartsWith("_")) .Select(name => name.Substring(1)) + .Where(name => !name.Equals(comModule.Name)) .ToList(); - superTypeNames.AddRange(additionalSuperTypes); + superTypeNames.AddRange(additionalSuperTypeNames); return superTypeNames; } @@ -240,7 +257,7 @@ protected void ResolveReferences(DeclarationFinder finder, QualifiedModuleName m Logger.Debug("Binding resolution done for component '{0}' in {1}ms (thread {2})", module.Name, watch.ElapsedMilliseconds, Thread.CurrentThread.ManagedThreadId); - //Evaluation of the overall status has to be defered to allow processing of undeclared variables before setting the ready state. + //Evaluation of the overall status has to be deferred to allow processing of undeclared variables before setting the ready state. _parserStateManager.SetModuleState(module, ParserState.Ready, token, false); } catch (OperationCanceledException) From 10d173f83d4dcba92769d1929a8eaaa82363d768 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Fri, 2 Oct 2020 19:13:59 +0200 Subject: [PATCH 6/7] Add QualifyWithMeQuickFix for ImplicitContainingWorkbook/WorksheetReferenceInspection It does what the name suggests. --- .../Concrete/QualifyWithMeQuickFix.cs | 61 +++++++++ .../Inspections/QuickFixes.Designer.cs | 11 +- .../Inspections/QuickFixes.de.resx | 3 + .../Inspections/QuickFixes.resx | 3 + .../QuickFixes/QualifyWithMeQuickFixTests.cs | 124 ++++++++++++++++++ 5 files changed, 201 insertions(+), 1 deletion(-) create mode 100644 Rubberduck.CodeAnalysis/QuickFixes/Concrete/QualifyWithMeQuickFix.cs create mode 100644 RubberduckTests/QuickFixes/QualifyWithMeQuickFixTests.cs diff --git a/Rubberduck.CodeAnalysis/QuickFixes/Concrete/QualifyWithMeQuickFix.cs b/Rubberduck.CodeAnalysis/QuickFixes/Concrete/QualifyWithMeQuickFix.cs new file mode 100644 index 0000000000..32734ccddb --- /dev/null +++ b/Rubberduck.CodeAnalysis/QuickFixes/Concrete/QualifyWithMeQuickFix.cs @@ -0,0 +1,61 @@ +using Rubberduck.CodeAnalysis.Inspections; +using Rubberduck.CodeAnalysis.Inspections.Concrete; +using Rubberduck.CodeAnalysis.QuickFixes.Abstract; +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Rewriter; + +namespace Rubberduck.CodeAnalysis.QuickFixes.Concrete +{ + /// + /// Qualifies an implicit reference with 'Me'. + /// + /// + /// + /// + /// + /// + /// + /// + /// + /// + /// + /// + /// + /// + internal class QualifyWithMeQuickFix : QuickFixBase + { + public QualifyWithMeQuickFix() + : base(typeof(ImplicitContainingWorkbookReferenceInspection), + typeof(ImplicitContainingWorksheetReferenceInspection)) + {} + + public override void Fix(IInspectionResult result, IRewriteSession rewriteSession) + { + var rewriter = rewriteSession.CheckOutModuleRewriter(result.QualifiedSelection.QualifiedName); + + var context = result.Context; + rewriter.InsertBefore(context.Start.TokenIndex, $"{Tokens.Me}."); + } + + public override string Description(IInspectionResult result) + { + return Resources.Inspections.QuickFixes.QualifyWithMeQuickFix; + } + + public override bool CanFixMultiple => true; + public override bool CanFixInProcedure => true; + public override bool CanFixInModule => true; + public override bool CanFixInProject => true; + public override bool CanFixAll => true; + } +} \ No newline at end of file diff --git a/Rubberduck.Resources/Inspections/QuickFixes.Designer.cs b/Rubberduck.Resources/Inspections/QuickFixes.Designer.cs index 8c676de34f..6692c3adbd 100644 --- a/Rubberduck.Resources/Inspections/QuickFixes.Designer.cs +++ b/Rubberduck.Resources/Inspections/QuickFixes.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 QuickFixes { @@ -339,6 +339,15 @@ public class QuickFixes { } } + /// + /// Looks up a localized string similar to Qualify reference with 'Me'.. + /// + public static string QualifyWithMeQuickFix { + get { + return ResourceManager.GetString("QualifyWithMeQuickFix", resourceCulture); + } + } + /// /// Looks up a localized string similar to Remove 'ByRef' modifier. /// diff --git a/Rubberduck.Resources/Inspections/QuickFixes.de.resx b/Rubberduck.Resources/Inspections/QuickFixes.de.resx index 7a59cda349..cbf9dac78f 100644 --- a/Rubberduck.Resources/Inspections/QuickFixes.de.resx +++ b/Rubberduck.Resources/Inspections/QuickFixes.de.resx @@ -300,4 +300,7 @@ In Modul ignorieren + + Qualifiziere die Referenz mit 'Me'. + \ No newline at end of file diff --git a/Rubberduck.Resources/Inspections/QuickFixes.resx b/Rubberduck.Resources/Inspections/QuickFixes.resx index 081c9a2825..88642f1b08 100644 --- a/Rubberduck.Resources/Inspections/QuickFixes.resx +++ b/Rubberduck.Resources/Inspections/QuickFixes.resx @@ -300,4 +300,7 @@ Ignore in module + + Qualify reference with 'Me'. + \ No newline at end of file diff --git a/RubberduckTests/QuickFixes/QualifyWithMeQuickFixTests.cs b/RubberduckTests/QuickFixes/QualifyWithMeQuickFixTests.cs new file mode 100644 index 0000000000..1320b5b384 --- /dev/null +++ b/RubberduckTests/QuickFixes/QualifyWithMeQuickFixTests.cs @@ -0,0 +1,124 @@ +using System.Linq; +using System.Threading; +using NUnit.Framework; +using Rubberduck.CodeAnalysis.Inspections.Concrete; +using Rubberduck.CodeAnalysis.QuickFixes; +using Rubberduck.CodeAnalysis.QuickFixes.Concrete; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.VBEditor.SafeComWrappers; +using RubberduckTests.Mocks; + +namespace RubberduckTests.QuickFixes +{ + [TestFixture] + public class QualifyWithMeQuickFixTests : QuickFixTestBase + { + [Test] + [Category("QuickFixes")] + public void QualifiesImplicitWorkbookReferencesInWorkbooks() + { + const string inputCode = + @" +Sub foo() + Dim sheet As Worksheet + Set sheet = Worksheets(""Sheet1"") +End Sub"; + + const string expectedCode = + @" +Sub foo() + Dim sheet As Worksheet + Set sheet = Me.Worksheets(""Sheet1"") +End Sub"; + + var actualCode = ApplyQuickFixToFirstInspectionResultForImplicitWorkbookInspection(inputCode); + Assert.AreEqual(expectedCode, actualCode); + } + + private string ApplyQuickFixToFirstInspectionResultForImplicitWorkbookInspection(string inputCode) + { + var inputModule = ("SomeWorkbook", inputCode, ComponentType.Document); + var vbe = MockVbeBuilder.BuildFromModules(inputModule, ReferenceLibrary.Excel).Object; + + var (state, rewriteManager) = MockParser.CreateAndParseWithRewritingManager(vbe); + using (state) + { + var documentModule = state.DeclarationFinder.UserDeclarations(DeclarationType.Document) + .OfType() + .Single(); + documentModule.AddSupertypeName("Workbook"); + + var inspection = new ImplicitContainingWorkbookReferenceInspection(state); + var inspectionResults = inspection.GetInspectionResults(CancellationToken.None); + + var rewriteSession = rewriteManager.CheckOutCodePaneSession(); + + var quickFix = QuickFix(state); + + var resultToFix = inspectionResults.First(); + quickFix.Fix(resultToFix, rewriteSession); + + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "SomeWorkbook"); + + return rewriteSession.CheckOutModuleRewriter(module).GetText(); + } + } + + [Test] + [Category("QuickFixes")] + public void QualifiesImplicitWorksheetReferencesInWorksheets() + { + const string inputCode = + @" +Private Sub Example() + Dim foo As Range + Set foo = Range(""A1"") +End Sub"; + + const string expectedCode = + @" +Private Sub Example() + Dim foo As Range + Set foo = Me.Range(""A1"") +End Sub"; + + var actualCode = ApplyQuickFixToFirstInspectionResultForImplicitWorksheetInspection(inputCode); + Assert.AreEqual(expectedCode, actualCode); + } + + private string ApplyQuickFixToFirstInspectionResultForImplicitWorksheetInspection(string inputCode) + { + var inputModule = ("Sheet1", inputCode, ComponentType.Document); + var vbe = MockVbeBuilder.BuildFromModules(inputModule, ReferenceLibrary.Excel).Object; + + var (state, rewriteManager) = MockParser.CreateAndParseWithRewritingManager(vbe); + using (state) + { + var documentModule = state.DeclarationFinder.UserDeclarations(DeclarationType.Document) + .OfType() + .Single(); + documentModule.AddSupertypeName("Worksheet"); + + var inspection = new ImplicitContainingWorksheetReferenceInspection(state); + var inspectionResults = inspection.GetInspectionResults(CancellationToken.None); + + var rewriteSession = rewriteManager.CheckOutCodePaneSession(); + + var quickFix = QuickFix(state); + + var resultToFix = inspectionResults.First(); + quickFix.Fix(resultToFix, rewriteSession); + + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "Sheet1"); + + return rewriteSession.CheckOutModuleRewriter(module).GetText(); + } + } + + protected override IQuickFix QuickFix(RubberduckParserState state) + { + return new QualifyWithMeQuickFix(); + } + } +} From 04510b518adc93582f77342455f1722f1acf82f8 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Fri, 23 Oct 2020 13:31:28 +0200 Subject: [PATCH 7/7] Stop adding super type names for documents that are already there This fixes a small memory leak in the reference resolver. Although the supertypes of a class declaration are a hash set, the super type names are a list. So, adding all supertype names derived from the typeLib API every parse would grow that list unnecessarily. --- .../VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs b/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs index 315f2a149a..6fa0c0ac44 100644 --- a/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs +++ b/Rubberduck.Parsing/VBA/ReferenceManagement/ReferenceResolveRunnerBase.cs @@ -191,6 +191,11 @@ private void AddSuperTypeNamesForDocumentModules(IReadOnlyCollection