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/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.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/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/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) {