From a993dfd3232c06075f910f7054e99cf0f73c9406 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Sun, 2 Jun 2019 23:58:32 +0200 Subject: [PATCH 01/22] Add initial SetAssignmentWithIncompatibleObjectTypeInspection Currently only supports variable assignments on the RHS. Also fixes a previously ignored test for the MoveCloserToUsageRefactoring. --- ...entWithIncompatibleObjectTypeInspection.cs | 229 ++++++++ .../Rubberduck.CodeAnalysis.xml | 104 +++- Rubberduck.Parsing/Symbols/Declaration.cs | 11 +- .../Inspections/InspectionInfo.Designer.cs | 9 + .../Inspections/InspectionInfo.de.resx | 6 + .../Inspections/InspectionInfo.resx | 3 + .../Inspections/InspectionNames.Designer.cs | 9 + .../Inspections/InspectionNames.de.resx | 6 + .../Inspections/InspectionNames.resx | 3 + .../Inspections/InspectionResults.Designer.cs | 9 + .../Inspections/InspectionResults.de.resx | 6 + .../Inspections/InspectionResults.resx | 4 + ...thIncompatibleObjectTypeInspectionTests.cs | 487 ++++++++++++++++++ .../Refactoring/MoveCloserToUsageTests.cs | 5 +- 14 files changed, 875 insertions(+), 16 deletions(-) create mode 100644 Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs create mode 100644 RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs new file mode 100644 index 0000000000..69ec29668a --- /dev/null +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs @@ -0,0 +1,229 @@ +using System.Collections.Generic; +using System.Linq; +using Rubberduck.Inspections.Abstract; +using Rubberduck.Inspections.Inspections.Extensions; +using Rubberduck.Inspections.Results; +using Rubberduck.Parsing; +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Inspections.Abstract; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Parsing.VBA.DeclarationCaching; +using Rubberduck.Resources.Inspections; +using Rubberduck.VBEditor; + +namespace Rubberduck.CodeAnalysis.Inspections.Concrete +{ + public class SetAssignmentWithIncompatibleObjectTypeInspection : InspectionBase + { + private readonly IDeclarationFinderProvider _declarationFinderProvider; + + private const string UndeterminedValue = "Undetermined"; + + /// + /// Locates assignments to object variables for which the RHS does not have a compatible declared type. + /// + /// + /// The VBA compiler does not check whether different object types are compatible. Instead there is a runtime error whenever the types are incompatible. + /// + /// + /// + /// + /// + /// + /// + public SetAssignmentWithIncompatibleObjectTypeInspection(RubberduckParserState state) + : base(state) + { + _declarationFinderProvider = state; + } + + protected override IEnumerable DoGetInspectionResults() + { + var finder = _declarationFinderProvider.DeclarationFinder; + + var offendingAssignments = StronglyTypedObjectVariables(finder) + .SelectMany(SetAssignments) + .Select(setAssignment => SetAssignmentWithAssignedTypeName(setAssignment, finder)) + .Where(setAssignmentWithAssignedTypeName => setAssignmentWithAssignedTypeName.assignedTypeName != UndeterminedValue + && !SetAssignmentPossiblyLegal(setAssignmentWithAssignedTypeName)); + + return offendingAssignments + .Where(setAssignmentWithAssignedTypeName => !IsIgnored(setAssignmentWithAssignedTypeName.setAssignment)) + .Select(setAssignmentWithAssignedTypeName => InspectionResult(setAssignmentWithAssignedTypeName, _declarationFinderProvider)); + } + + + private IEnumerable StronglyTypedObjectVariables(DeclarationFinder declarationFinder) + { + return declarationFinder.DeclarationsWithType(DeclarationType.Variable) + .Where(declaration => declaration.IsObject + && declaration.AsTypeDeclaration != null); + } + + private IEnumerable SetAssignments(Declaration declaration) + { + return declaration.References.Where(reference => reference.IsSetAssignment); + } + + private (IdentifierReference setAssignment, string assignedTypeName) SetAssignmentWithAssignedTypeName(IdentifierReference setAssignment, DeclarationFinder finder) + { + return (setAssignment, SetTypeNameOfExpression(RHS(setAssignment), setAssignment.QualifiedModuleName, finder)); + } + + private VBAParser.ExpressionContext RHS(IdentifierReference setAssignment) + { + return setAssignment.Context.GetAncestor().expression(); + } + + private string SetTypeNameOfExpression(VBAParser.ExpressionContext expression, QualifiedModuleName containingModule, DeclarationFinder finder) + { + switch (expression) + { + case VBAParser.LExprContext lExpression: + return SetTypeNameOfExpression(lExpression.lExpression(), containingModule, finder); + case VBAParser.NewExprContext newExpression: + return UndeterminedValue; + default: + return UndeterminedValue; + } + } + + private string SetTypeNameOfExpression(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) + { + switch (lExpression) + { + case VBAParser.SimpleNameExprContext simpleNameExpression: + return SetTypeNameOfExpression(simpleNameExpression.identifier(), containingModule, finder); + case VBAParser.InstanceExprContext instanceExpression: + return SetTypeNameOfInstance(containingModule); + default: + return UndeterminedValue; + } + } + + private string SetTypeNameOfExpression(VBAParser.IdentifierContext identifier, QualifiedModuleName containingModule, DeclarationFinder finder) + { + var typeName = finder.IdentifierReferences(identifier, containingModule) + .Select(reference => reference.Declaration) + .Where(declaration => declaration.IsObject) + .Select(declaration => declaration.FullAsTypeName) + .FirstOrDefault(); + return typeName ?? UndeterminedValue; + } + + private string SetTypeNameOfInstance(QualifiedModuleName instance) + { + return instance.ToString(); + } + + private bool SetAssignmentPossiblyLegal((IdentifierReference setAssignment, string assignedTypeName) setAssignmentWithAssignedType) + { + var (setAssignment, assignedTypeName) = setAssignmentWithAssignedType; + + return SetAssignmentPossiblyLegal(setAssignment.Declaration, assignedTypeName); + } + + private bool SetAssignmentPossiblyLegal(Declaration declaration, string assignedTypeName) + { + return assignedTypeName == declaration.FullAsTypeName + || assignedTypeName == Tokens.Variant + || assignedTypeName == Tokens.Object + || HasBaseType(declaration, assignedTypeName) + || HasSubType(declaration, assignedTypeName); + } + + private bool HasBaseType(Declaration declaration, string typeName) + { + var ownType = declaration.AsTypeDeclaration; + if (ownType == null || !(ownType is ClassModuleDeclaration classType)) + { + return false; + } + + return classType.Subtypes.Select(subtype => subtype.QualifiedModuleName.ToString()).Contains(typeName); + } + + private bool HasSubType(Declaration declaration, string typeName) + { + var ownType = declaration.AsTypeDeclaration; + if (ownType == null || !(ownType is ClassModuleDeclaration classType)) + { + return false; + } + + return classType.Supertypes.Select(supertype => supertype.QualifiedModuleName.ToString()).Contains(typeName); + } + + private bool IsIgnored(IdentifierReference assignment) + { + return assignment.IsIgnoringInspectionResultFor(AnnotationName) + // Ignoring the Declaration disqualifies all assignments + || assignment.Declaration.IsIgnoringInspectionResultFor(AnnotationName); + } + + private IInspectionResult InspectionResult((IdentifierReference setAssignment, string assignedTypeName) setAssignmentWithAssignedType, IDeclarationFinderProvider declarationFinderProvider) + { + var (setAssignment, assignedTypeName) = setAssignmentWithAssignedType; + return new IdentifierReferenceInspectionResult(this, + ResultDescription(setAssignment, assignedTypeName), + declarationFinderProvider, + setAssignment); + } + + private string ResultDescription(IdentifierReference setAssignment, string assignedTypeName) + { + var declarationName = setAssignment.Declaration.IdentifierName; + var variableTypeName = setAssignment.Declaration.FullAsTypeName; + return string.Format(InspectionResults.SetAssignmentWithIncompatibleObjectTypeInspection, declarationName, variableTypeName, assignedTypeName); + } + } +} \ No newline at end of file diff --git a/Rubberduck.CodeAnalysis/Rubberduck.CodeAnalysis.xml b/Rubberduck.CodeAnalysis/Rubberduck.CodeAnalysis.xml index c7153eb96e..3d7a0ee97c 100644 --- a/Rubberduck.CodeAnalysis/Rubberduck.CodeAnalysis.xml +++ b/Rubberduck.CodeAnalysis/Rubberduck.CodeAnalysis.xml @@ -65,6 +65,68 @@ ]]> + + + Locates assignments to object variables for which the RHS does not have a compatible declared type. + + + The VBA compiler does not check whether different object types are compatible. Instead there is a runtime error whenever the types are incompatible. + + + + + + + + Default constructor required for XML serialization. @@ -147,13 +209,13 @@ @@ -198,11 +260,7 @@ @@ -531,7 +589,7 @@ Public Sub DoSomething(ByVal foo As Long) Do ' no executable statement... - Loop While foo < 100 + Loop While foo < 100 End Sub ]]> @@ -540,7 +598,7 @@ Public Sub DoSomething(ByVal foo As Long) Do Debug.Print foo - Loop While foo < 100 + Loop While foo < 100 End Sub ]]> @@ -702,7 +760,7 @@ - + + + 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. + + + + + + + + Identifies implicit default member calls. @@ -1815,7 +1895,7 @@ Option Explicit '@Ignore ProcedureNotUsed - Public Sub DoSomething() As Long + Public Sub DoSomething() ' macro is attached to a worksheet Shape. End Sub ]]> diff --git a/Rubberduck.Parsing/Symbols/Declaration.cs b/Rubberduck.Parsing/Symbols/Declaration.cs index 55d359e347..0a8b1918fb 100644 --- a/Rubberduck.Parsing/Symbols/Declaration.cs +++ b/Rubberduck.Parsing/Symbols/Declaration.cs @@ -448,7 +448,7 @@ public object[] ToArray() public string IdentifierName { get; } /// - /// Gets the name of the declared type. + /// Gets the name of the declared type as specified in code. /// /// /// This value is null if not applicable, @@ -468,6 +468,15 @@ public string AsTypeNameWithoutArrayDesignator } } + /// + /// Gets the fully qualified name of the declared type. + /// + /// + /// This value is null if not applicable, + /// and Variant if applicable but unspecified. + /// + public string FullAsTypeName => AsTypeDeclaration?.QualifiedModuleName.ToString() ?? AsTypeName; + public bool AsTypeIsBaseType => string.IsNullOrWhiteSpace(AsTypeName) || SymbolList.BaseTypes.Contains(AsTypeName.ToUpperInvariant()); private Declaration _asTypeDeclaration; diff --git a/Rubberduck.Resources/Inspections/InspectionInfo.Designer.cs b/Rubberduck.Resources/Inspections/InspectionInfo.Designer.cs index 9caa412a25..939755518e 100644 --- a/Rubberduck.Resources/Inspections/InspectionInfo.Designer.cs +++ b/Rubberduck.Resources/Inspections/InspectionInfo.Designer.cs @@ -708,6 +708,15 @@ public class InspectionInfo { } } + /// + /// Looks up a localized string similar to The VBA compiler does not raise an error if an object is set assigned to a variable with an incompatible declared object type, i.e. with an object type that is neither the same type, a supertype nor a subtype. Under almost all circumstances such an assignment leads to a run-time error, which is harder to detect and indicates a bug. In all other situations the code can be changed to use only assignments between compatible declared types.. + /// + public static string SetAssignmentWithIncompatibleObjectTypeInspection { + get { + return ResourceManager.GetString("SetAssignmentWithIncompatibleObjectTypeInspection", resourceCulture); + } + } + /// /// Looks up a localized string similar to Two declarations are in scope and have the same identifier name. Consider using fully qualified identifier names, otherwise only one of them will be available to use.. /// diff --git a/Rubberduck.Resources/Inspections/InspectionInfo.de.resx b/Rubberduck.Resources/Inspections/InspectionInfo.de.resx index 88887e33af..739ceaf4f8 100644 --- a/Rubberduck.Resources/Inspections/InspectionInfo.de.resx +++ b/Rubberduck.Resources/Inspections/InspectionInfo.de.resx @@ -379,4 +379,10 @@ Falls der Parameter 'null' sein kann, bitte dieses Auftreten ignorieren. 'null' Hierbei handelt es sich um ein schlecht dokumentiertes Feature: Im Normallfall wird der Fehlerspeicher geleert und jegliche Fehlerbehandlung deaktiviert. Sollte allerdings -1 als Zeilennummer vorhanden sein, kann diese als Marker der zu verwendenden Fehlerbehandlung interpretiert werden. + + 'While..Wend'-Schleifen existieren um Rückwärtskompatibilität zu älteren BASIC Versionen zu gewährleisten. Als Ersatz wurden 'Do While...Loop'-Blöcke eingeführt, welche durch die 'Exist Do'-Anweisung verlassen werden können. Eine 'While...Wend'-Schleife kann ausschließlich durch Erfüllen der Whilebedingung verlassen werden. + + + Der VBA-Compiler gibt keinen Fehler aus, wenn ein Objekt einer Variables Set-zugewiesen wird mit einem inkompatiblen Objecttype, d.h. deren Type weder identisch, ein Subtyp noch ein Supertyp ist. In fast allen Fällen führt dies zu einem Laufzeitfehler, der schwerer zu entdecken ist und auf einen Programmierfehler hinweist. In allen anderen Fällen kann der Quallcode so geändert werden, dass er ausschließlich Zuweisungen zwischen kompatiblen deklarierten Typen verwendet. + \ No newline at end of file diff --git a/Rubberduck.Resources/Inspections/InspectionInfo.resx b/Rubberduck.Resources/Inspections/InspectionInfo.resx index 797f11c6ee..26c8b70ff7 100644 --- a/Rubberduck.Resources/Inspections/InspectionInfo.resx +++ b/Rubberduck.Resources/Inspections/InspectionInfo.resx @@ -382,4 +382,7 @@ If the parameter can be null, ignore this inspection result; passing a null valu 'While...Wend' loops exist for backward compatibility and have been superseded by the introduction of 'Do While...Loop' blocks, which support the 'Exit Do' exit statement. 'While...Wend' loops cannot be exited other than fulfilling the 'While' condition. + + The VBA compiler does not raise an error if an object is set assigned to a variable with an incompatible declared object type, i.e. with an object type that is neither the same type, a supertype nor a subtype. Under almost all circumstances such an assignment leads to a run-time error, which is harder to detect and indicates a bug. In all other situations the code can be changed to use only assignments between compatible declared types. + \ No newline at end of file diff --git a/Rubberduck.Resources/Inspections/InspectionNames.Designer.cs b/Rubberduck.Resources/Inspections/InspectionNames.Designer.cs index 39790287cb..033e4ee4fb 100644 --- a/Rubberduck.Resources/Inspections/InspectionNames.Designer.cs +++ b/Rubberduck.Resources/Inspections/InspectionNames.Designer.cs @@ -708,6 +708,15 @@ public class InspectionNames { } } + /// + /// Looks up a localized string similar to Set Assignment With Incompatible Object Type. + /// + public static string SetAssignmentWithIncompatibleObjectTypeInspection { + get { + return ResourceManager.GetString("SetAssignmentWithIncompatibleObjectTypeInspection", resourceCulture); + } + } + /// /// Looks up a localized string similar to Shadowed declaration. /// diff --git a/Rubberduck.Resources/Inspections/InspectionNames.de.resx b/Rubberduck.Resources/Inspections/InspectionNames.de.resx index 2771307d90..e2f3591721 100644 --- a/Rubberduck.Resources/Inspections/InspectionNames.de.resx +++ b/Rubberduck.Resources/Inspections/InspectionNames.de.resx @@ -363,4 +363,10 @@ Fehlende Modulannotation + + Set-Zuweisung mit nicht kompatiblem Objekttyp + + + Verwendung der veralteten 'While...Wend'-Anweisung + \ No newline at end of file diff --git a/Rubberduck.Resources/Inspections/InspectionNames.resx b/Rubberduck.Resources/Inspections/InspectionNames.resx index 386290b4a7..5fceb3831b 100644 --- a/Rubberduck.Resources/Inspections/InspectionNames.resx +++ b/Rubberduck.Resources/Inspections/InspectionNames.resx @@ -386,4 +386,7 @@ Use of obsolete 'While...Wend' statement + + Set Assignment With Incompatible Object Type + \ No newline at end of file diff --git a/Rubberduck.Resources/Inspections/InspectionResults.Designer.cs b/Rubberduck.Resources/Inspections/InspectionResults.Designer.cs index f1db10907c..6c0af7178c 100644 --- a/Rubberduck.Resources/Inspections/InspectionResults.Designer.cs +++ b/Rubberduck.Resources/Inspections/InspectionResults.Designer.cs @@ -726,6 +726,15 @@ public class InspectionResults { } } + /// + /// Looks up a localized string similar to To the variable '{0}' of declared type '{1}' a value is set assigned with the incompatible declared type '{2}'. . + /// + public static string SetAssignmentWithIncompatibleObjectTypeInspection { + get { + return ResourceManager.GetString("SetAssignmentWithIncompatibleObjectTypeInspection", resourceCulture); + } + } + /// /// Looks up a localized string similar to {0} '{1}' hides {2} '{3}'.. /// diff --git a/Rubberduck.Resources/Inspections/InspectionResults.de.resx b/Rubberduck.Resources/Inspections/InspectionResults.de.resx index 45cfc3dc23..d031be919c 100644 --- a/Rubberduck.Resources/Inspections/InspectionResults.de.resx +++ b/Rubberduck.Resources/Inspections/InspectionResults.de.resx @@ -401,4 +401,10 @@ In Memoriam, 1972-2018 Verwendung von 'On Error GoTo -1' + + Die 'While...Wend'-Schleife kann als 'Do While...Loop'-Block geschrieben werden. + + + Der Variablen '{0}' vom deklarierten Typ '{1}' wird eine Wert des inkompatiblen Typs '{2}' Set-zugewiesen. + \ No newline at end of file diff --git a/Rubberduck.Resources/Inspections/InspectionResults.resx b/Rubberduck.Resources/Inspections/InspectionResults.resx index c3d0944518..e9225b6426 100644 --- a/Rubberduck.Resources/Inspections/InspectionResults.resx +++ b/Rubberduck.Resources/Inspections/InspectionResults.resx @@ -425,4 +425,8 @@ In memoriam, 1972-2018 'While...Wend' conditional loop can be written as a 'Do While...Loop' block. + + To the variable '{0}' of declared type '{1}' a value is set assigned with the incompatible declared type '{2}'. + {0} variable name, {1} variable declared type, {2} rhs declared type + \ No newline at end of file diff --git a/RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs b/RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs new file mode 100644 index 0000000000..c2e1a3af37 --- /dev/null +++ b/RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs @@ -0,0 +1,487 @@ +using System.Collections.Generic; +using System.Linq; +using System.Threading; +using NUnit.Framework; +using Rubberduck.CodeAnalysis.Inspections.Concrete; +using Rubberduck.Parsing.Inspections.Abstract; +using Rubberduck.Parsing.VBA; +using Rubberduck.VBEditor.SafeComWrappers; +using Rubberduck.VBEditor.SafeComWrappers.Abstract; +using RubberduckTests.Mocks; + +namespace RubberduckTests.Inspections +{ + [TestFixture] + public class SetAssignmentWithIncompatibleObjectTypeInspectionTests + { + [Test] + [Category("Inspections")] + public void AssignmentToNotImplementedInterface_Result() + { + const string interface1 = + @"Public Sub DoIt() +End Sub"; + + const string class1 = + @" +Private Sub Interface1_DoIt() +End Sub +"; + + const string consumerModule = + @" +Private Sub TestIt() + Dim intrfc As Interface1 + Dim cls As Class1 + + Set cls = new Class1 + Set intrfc = cls +End Sub +"; + + var inspectionResults = InspectionResults( + ("Interface1", interface1, ComponentType.ClassModule), + ("Class1", class1, ComponentType.ClassModule), + ("Module1", consumerModule, ComponentType.StandardModule)); + + Assert.AreEqual(1,inspectionResults.Count()); + } + + [Test] + [Category("Inspections")] + public void AssignmentToInterfaceIncompatibleWithDeclaredTypeButNotWithUnderlyingType_Result() + { + const string interface1 = + @"Public Sub DoIt() +End Sub"; + + const string interface2 = + @"Public Sub DoSomething() +End Sub"; + + const string class1 = + @"Implements Interface1 +Implements Interface2 + +Private Sub Interface1_DoIt() +End Sub + +Private Sub Interface2_DoSomething() +End Sub +"; + + const string consumerModule = + @" +Private Sub TestIt() + Dim intrfc As Interface1 + Dim otherIntrfc As Interface2 + + Set otherIntrfc = new Class1 + Set intrfc = otherIntrfc +End Sub +"; + + var inspectionResults = InspectionResults( + ("Interface1", interface1, ComponentType.ClassModule), + ("Interface2", interface2, ComponentType.ClassModule), + ("Class1", class1, ComponentType.ClassModule), + ("Module1", consumerModule, ComponentType.StandardModule)); + + Assert.AreEqual(1, inspectionResults.Count()); + } + + [Test] + [Category("Inspections")] + public void AssignmentToImplementedInterface_NoResult() + { + const string interface1 = + @"Public Sub DoIt() +End Sub"; + + const string class1 = + @"Implements Interface1 + +Private Sub Interface1_DoIt() +End Sub +"; + + const string consumerModule = + @" +Private Sub TestIt() + Dim intrfc As Interface1 + Dim cls As Class1 + + Set cls = new Class1 + Set intrfc = cls +End Sub +"; + + var inspectionResults = InspectionResults( + ("Interface1", interface1, ComponentType.ClassModule), + ("Class1", class1, ComponentType.ClassModule), + ("Module1", consumerModule, ComponentType.StandardModule)); + + Assert.IsFalse(inspectionResults.Any()); + } + + [Test] + [Category("Inspections")] + public void AssignmentToSameClass_NoResult() + { + const string class1 = + @" +Private Sub Interface1_DoIt() +End Sub +"; + + const string consumerModule = + @" +Private Sub TestIt() + Dim cls As Class1 + Dim otherCls As Class1 + + Set otherCls = new Class1 + Set cls = otherCls +End Sub +"; + + var inspectionResults = InspectionResults( + ("Class1", class1, ComponentType.ClassModule), + ("Module1", consumerModule, ComponentType.StandardModule)); + + Assert.IsFalse(inspectionResults.Any()); + } + + [Test] + [Category("Inspections")] + public void AssignmentToSameClass_InconsistentlyQualified_NoResult() + { + const string class1 = + @" +Private Sub Interface1_DoIt() +End Sub +"; + + const string consumerModule = + @" +Private Sub TestIt() + Dim cls As Project1.Class1 + Dim otherCls As Class1 + + Set otherCls = new Class1 + Set cls = otherCls + Set otherCls = cls +End Sub +"; + + var vbe = new MockVbeBuilder() + .ProjectBuilder("Project1", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, consumerModule) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var inspectionResults = InspectionResults(vbe); + + Assert.IsFalse(inspectionResults.Any()); + } + + [Test] + [Category("Inspections")] + public void AssignmentToOtherClassWithSameName_OneResultEach() + { + const string class1 = + @"Attribute VB_Exposed = True +Private Sub Interface1_DoIt() +End Sub +"; + + const string consumerModule = + @" +Private Sub TestIt() + Dim cls As Project2.Class1 + Dim otherCls As Class1 + + Set otherCls = new Class1 + Set cls = otherCls + Set otherCls = cls +End Sub +"; + + var vbe = new MockVbeBuilder() + .ProjectBuilder("Project2", "project2path", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddProjectToVbeBuilder() + .ProjectBuilder("Project1", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, consumerModule) + .AddReference("Project2", "project2path", 0, 0, false, ReferenceKind.Project) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var inspectionResults = InspectionResults(vbe).ToList(); + + Assert.AreEqual(2,inspectionResults.Count()); + } + + [Test] + [Category("Inspections")] + public void LegalDowncastFromImplementedInterface_NoResult() + { + const string interface1 = + @"Public Sub DoIt() +End Sub"; + + const string class1 = + @"Implements Interface1 + +Private Sub Interface1_DoIt() +End Sub +"; + + const string consumerModule = + @" +Private Sub TestIt() + Dim intrfc As Interface1 + Dim cls As Class1 + + Set intrfc = new Class1 + Set cls = intrfc +End Sub +"; + + var inspectionResults = InspectionResults( + ("Interface1", interface1, ComponentType.ClassModule), + ("Class1", class1, ComponentType.ClassModule), + ("Module1", consumerModule, ComponentType.StandardModule)); + + Assert.IsFalse(inspectionResults.Any()); + } + + [Test] + [Category("Inspections")] + //We cannot know whether a downcast is legal at compile time. + public void IllegalDowncastFromImplementedInterface_NoResult() + { + const string interface1 = + @"Public Sub DoIt() +End Sub"; + + const string class1 = + @"Implements Interface1 + +Private Sub Interface1_DoIt() +End Sub +"; + + const string consumerModule = + @" +Private Sub TestIt() + Dim intrfc As Interface1 + Dim cls As Class1 + + Set intrfc = new Class2 + Set cls = intrfc +End Sub +"; + + var inspectionResults = InspectionResults( + ("Interface1", interface1, ComponentType.ClassModule), + ("Class1", class1, ComponentType.ClassModule), + ("Class2", class1, ComponentType.ClassModule), + ("Module1", consumerModule, ComponentType.StandardModule)); + + Assert.IsFalse(inspectionResults.Any()); + } + + [Test] + [Category("Inspections")] + public void AssignmentToObject_NoResult() + { + const string class1 = + @" +Private Sub Interface1_DoIt() +End Sub +"; + + const string consumerModule = + @" +Private Sub TestIt() + Dim cls As Object + Dim otherCls As Class1 + + Set otherCls = new Class1 + Set cls = otherCls +End Sub +"; + + var inspectionResults = InspectionResults( + ("Class1", class1, ComponentType.ClassModule), + ("Module1", consumerModule, ComponentType.StandardModule)); + + Assert.IsFalse(inspectionResults.Any()); + } + + [Test] + [Category("Inspections")] + public void AssignmentToVariant_NoResult() + { + const string class1 = + @" +Private Sub Interface1_DoIt() +End Sub +"; + + const string consumerModule = + @" +Private Sub TestIt() + Dim cls As Variant + Dim otherCls As Class1 + + Set otherCls = new Class1 + Set cls = otherCls +End Sub +"; + + var inspectionResults = InspectionResults( + ("Class1", class1, ComponentType.ClassModule), + ("Module1", consumerModule, ComponentType.StandardModule)); + + Assert.IsFalse(inspectionResults.Any()); + } + + [Test] + [Category("Inspections")] + public void AssignmentOfObject_NoResult() + { + const string class1 = + @" +Private Sub Interface1_DoIt() +End Sub +"; + + const string consumerModule = + @" +Private Sub TestIt() + Dim cls As Class1 + Dim otherCls As Object + + Set otherCls = new Class2 + Set cls = otherCls +End Sub +"; + + var inspectionResults = InspectionResults( + ("Class1", class1, ComponentType.ClassModule), + ("Class2", class1, ComponentType.ClassModule), + ("Module1", consumerModule, ComponentType.StandardModule)); + + Assert.IsFalse(inspectionResults.Any()); + } + + [Test] + [Category("Inspections")] + public void AssignmentOfVariant_NoResult() + { + const string class1 = + @" +Private Sub Interface1_DoIt() +End Sub +"; + + const string consumerModule = + @" +Private Sub TestIt() + Dim cls As Class1 + Dim otherCls As Variant + + Set otherCls = new Class2 + Set cls = otherCls +End Sub +"; + + var inspectionResults = InspectionResults( + ("Class1", class1, ComponentType.ClassModule), + ("Class2", class1, ComponentType.ClassModule), + ("Module1", consumerModule, ComponentType.StandardModule)); + + Assert.IsFalse(inspectionResults.Any()); + } + + [Test] + [Category("Inspections")] + public void AssignmentOfMeToProperlyTypesVariable_NoResult() + { + const string interface1 = + @" +Private Sub DoIt() +End Sub +"; + const string class1 = + @"Implements Interface1 +Private Sub Interface1_DoIt() +End Sub + +Public Sub AssignIt() + Dim cls As Interface1 + Set cls = Me +End Sub +"; + + var inspectionResults = InspectionResults( + ("Class1", class1, ComponentType.ClassModule), + ("Interface1", interface1, ComponentType.ClassModule)); + + Assert.IsFalse(inspectionResults.Any()); + } + + [Test] + [Category("Inspections")] + public void AssignmentOfMeToImproperlyTypesVariable_Result() + { + const string interface1 = + @" +Private Sub DoIt() +End Sub +"; + const string class1 = + @" +Private Sub Interface1_DoIt() +End Sub + +Public Sub AssignIt() + Dim cls As Interface1 + Set cls = Me +End Sub +"; + + var inspectionResults = InspectionResults( + ("Class1", class1, ComponentType.ClassModule), + ("Interface1", interface1, ComponentType.ClassModule)); + + Assert.AreEqual(1,inspectionResults.Count()); + } + + private static IEnumerable InspectionResults(params (string moduleName, string content, ComponentType componentType)[] testModules) + { + var vbe = MockVbeBuilder.BuildFromModules(testModules).Object; + return InspectionResults(vbe); + } + + private static IEnumerable InspectionResults(IVBE vbe) + { + using (var state = MockParser.CreateAndParse(vbe)) + { + var inspection = InspectionUnderTest(state); + return inspection.GetInspectionResults(CancellationToken.None); + } + } + + private static IInspection InspectionUnderTest(RubberduckParserState state) + { + return new SetAssignmentWithIncompatibleObjectTypeInspection(state); + } + } +} \ No newline at end of file diff --git a/RubberduckTests/Refactoring/MoveCloserToUsageTests.cs b/RubberduckTests/Refactoring/MoveCloserToUsageTests.cs index fadf680be2..fa310e7e9b 100644 --- a/RubberduckTests/Refactoring/MoveCloserToUsageTests.cs +++ b/RubberduckTests/Refactoring/MoveCloserToUsageTests.cs @@ -767,7 +767,6 @@ public void MoveCloserToUsageRefactoring_TargetInDifferentNonStandardModule() [Test] [Category("Refactorings")] [Category("Move Closer")] - [Ignore("For some reason the reference is not recognized by the resolver in this test.")] public void MoveCloserToUsageRefactoring_TargetInDifferentProject() { //Input @@ -781,12 +780,12 @@ public void MoveCloserToUsageRefactoring_TargetInDifferentProject() @"Public Bar As Boolean"; var vbe = new MockVbeBuilder() - .ProjectBuilder("OtherProject", ProjectProtection.Unprotected) + .ProjectBuilder("OtherProject", "otherProjectPath",ProjectProtection.Unprotected) .AddComponent("OtherModule", ComponentType.StandardModule, otherModuleInputCode) .AddProjectToVbeBuilder() .ProjectBuilder("TestProject", ProjectProtection.Unprotected) .AddComponent("Module", ComponentType.StandardModule, inputCode) - .AddReference("OtherProject", string.Empty,0,0,false,ReferenceKind.Project) + .AddReference("OtherProject", "otherProjectPath", 0,0,false,ReferenceKind.Project) .AddProjectToVbeBuilder() .Build() .Object; From e3693827566b7a54b7cfee667cb09a475eb0f463 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Fri, 14 Jun 2019 00:36:12 +0200 Subject: [PATCH 02/22] Extract set type resolution from SetAssignmentWithIncompatibleObjectTypeInspection into ISetTypeResolver implementation Currently only handles simple name expressions and instance expressions. Also fixed Declaration.FullAsTypeName for enums and UDTs. --- ...entWithIncompatibleObjectTypeInspection.cs | 47 +--- Rubberduck.Parsing/Symbols/Declaration.cs | 19 +- .../TypeResolvers/ISetTypeResolver.cs | 27 +++ .../TypeResolvers/SetTypeResolver.cs | 121 ++++++++++ .../SetTypeResolverTests.cs | 223 ++++++++++++++++++ ...thIncompatibleObjectTypeInspectionTests.cs | 78 +++++- 6 files changed, 469 insertions(+), 46 deletions(-) create mode 100644 Rubberduck.Parsing/TypeResolvers/ISetTypeResolver.cs create mode 100644 Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs create mode 100644 RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs index 69ec29668a..5f98fdf1a5 100644 --- a/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs @@ -7,6 +7,7 @@ using Rubberduck.Parsing.Grammar; using Rubberduck.Parsing.Inspections.Abstract; using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.TypeResolvers; using Rubberduck.Parsing.VBA; using Rubberduck.Parsing.VBA.DeclarationCaching; using Rubberduck.Resources.Inspections; @@ -17,8 +18,7 @@ namespace Rubberduck.CodeAnalysis.Inspections.Concrete public class SetAssignmentWithIncompatibleObjectTypeInspection : InspectionBase { private readonly IDeclarationFinderProvider _declarationFinderProvider; - - private const string UndeterminedValue = "Undetermined"; + private readonly ISetTypeResolver _setTypeResolver; /// /// Locates assignments to object variables for which the RHS does not have a compatible declared type. @@ -80,10 +80,11 @@ public class SetAssignmentWithIncompatibleObjectTypeInspection : InspectionBase /// End Sub /// ]]> /// - public SetAssignmentWithIncompatibleObjectTypeInspection(RubberduckParserState state) + public SetAssignmentWithIncompatibleObjectTypeInspection(RubberduckParserState state, ISetTypeResolver setTypeResolver) : base(state) { _declarationFinderProvider = state; + _setTypeResolver = setTypeResolver; } protected override IEnumerable DoGetInspectionResults() @@ -93,7 +94,7 @@ protected override IEnumerable DoGetInspectionResults() var offendingAssignments = StronglyTypedObjectVariables(finder) .SelectMany(SetAssignments) .Select(setAssignment => SetAssignmentWithAssignedTypeName(setAssignment, finder)) - .Where(setAssignmentWithAssignedTypeName => setAssignmentWithAssignedTypeName.assignedTypeName != UndeterminedValue + .Where(setAssignmentWithAssignedTypeName => setAssignmentWithAssignedTypeName.assignedTypeName != null && !SetAssignmentPossiblyLegal(setAssignmentWithAssignedTypeName)); return offendingAssignments @@ -126,43 +127,7 @@ private VBAParser.ExpressionContext RHS(IdentifierReference setAssignment) private string SetTypeNameOfExpression(VBAParser.ExpressionContext expression, QualifiedModuleName containingModule, DeclarationFinder finder) { - switch (expression) - { - case VBAParser.LExprContext lExpression: - return SetTypeNameOfExpression(lExpression.lExpression(), containingModule, finder); - case VBAParser.NewExprContext newExpression: - return UndeterminedValue; - default: - return UndeterminedValue; - } - } - - private string SetTypeNameOfExpression(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) - { - switch (lExpression) - { - case VBAParser.SimpleNameExprContext simpleNameExpression: - return SetTypeNameOfExpression(simpleNameExpression.identifier(), containingModule, finder); - case VBAParser.InstanceExprContext instanceExpression: - return SetTypeNameOfInstance(containingModule); - default: - return UndeterminedValue; - } - } - - private string SetTypeNameOfExpression(VBAParser.IdentifierContext identifier, QualifiedModuleName containingModule, DeclarationFinder finder) - { - var typeName = finder.IdentifierReferences(identifier, containingModule) - .Select(reference => reference.Declaration) - .Where(declaration => declaration.IsObject) - .Select(declaration => declaration.FullAsTypeName) - .FirstOrDefault(); - return typeName ?? UndeterminedValue; - } - - private string SetTypeNameOfInstance(QualifiedModuleName instance) - { - return instance.ToString(); + return _setTypeResolver.SetTypeName(expression, containingModule); } private bool SetAssignmentPossiblyLegal((IdentifierReference setAssignment, string assignedTypeName) setAssignmentWithAssignedType) diff --git a/Rubberduck.Parsing/Symbols/Declaration.cs b/Rubberduck.Parsing/Symbols/Declaration.cs index 0a8b1918fb..86f2d42e9a 100644 --- a/Rubberduck.Parsing/Symbols/Declaration.cs +++ b/Rubberduck.Parsing/Symbols/Declaration.cs @@ -475,7 +475,24 @@ public string AsTypeNameWithoutArrayDesignator /// This value is null if not applicable, /// and Variant if applicable but unspecified. /// - public string FullAsTypeName => AsTypeDeclaration?.QualifiedModuleName.ToString() ?? AsTypeName; + public string FullAsTypeName + { + get + { + if (AsTypeDeclaration == null) + { + return AsTypeName; + } + + if (AsTypeDeclaration.DeclarationType.HasFlag(DeclarationType.ClassModule)) + { + return AsTypeDeclaration.QualifiedModuleName.ToString(); + } + + //Enums and UDTs have to be qualified by the module they are contained in. + return AsTypeDeclaration.QualifiedName.ToString(); + } + } public bool AsTypeIsBaseType => string.IsNullOrWhiteSpace(AsTypeName) || SymbolList.BaseTypes.Contains(AsTypeName.ToUpperInvariant()); diff --git a/Rubberduck.Parsing/TypeResolvers/ISetTypeResolver.cs b/Rubberduck.Parsing/TypeResolvers/ISetTypeResolver.cs new file mode 100644 index 0000000000..2a260a8d7a --- /dev/null +++ b/Rubberduck.Parsing/TypeResolvers/ISetTypeResolver.cs @@ -0,0 +1,27 @@ +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Symbols; +using Rubberduck.VBEditor; + +namespace Rubberduck.Parsing.TypeResolvers +{ + public interface ISetTypeResolver + { + /// + /// Determines the declaration representing the Set type of an expression, if there is one. + /// + /// + /// Declaration representing the Set type of an expression, if there is such a declaration, and + /// null, otherwise. In particular, null is returned for expressions of Set type Variant and Object. + /// + Declaration SetTypeDeclaration(VBAParser.ExpressionContext expression, QualifiedModuleName containingModule); + + /// + /// Determines the name of the Set type of an expression, if it has a Set type. + /// + /// + /// Qualified name of the Set type of the expression, if there is one, and + /// null, otherwise. + /// + string SetTypeName(VBAParser.ExpressionContext expression, QualifiedModuleName containingModule); + } +} diff --git a/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs new file mode 100644 index 0000000000..e155de2951 --- /dev/null +++ b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs @@ -0,0 +1,121 @@ +using System; +using System.Linq; +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.VBA; +using Rubberduck.Parsing.VBA.DeclarationCaching; +using Rubberduck.VBEditor; + +namespace Rubberduck.Parsing.TypeResolvers +{ + public class SetTypeResolver : ISetTypeResolver + { + private readonly IDeclarationFinderProvider _declarationFinderProvider; + + public SetTypeResolver(IDeclarationFinderProvider declarationFinderProvider) + { + _declarationFinderProvider = declarationFinderProvider; + } + + public Declaration SetTypeDeclaration(VBAParser.ExpressionContext expression, QualifiedModuleName containingModule) + { + var finder = _declarationFinderProvider.DeclarationFinder; + var setTypeDeterminingDeclaration = SetTypeDeterminingDeclarationOfExpression(expression, containingModule, finder); + return SetTypeDeclaration(setTypeDeterminingDeclaration); + } + + private Declaration SetTypeDeclaration(Declaration setTypeDeterminingDeclaration) + { + return setTypeDeterminingDeclaration?.DeclarationType.HasFlag(DeclarationType.ClassModule) ?? true + ? setTypeDeterminingDeclaration + : setTypeDeterminingDeclaration.AsTypeDeclaration; + } + + + public string SetTypeName(VBAParser.ExpressionContext expression, QualifiedModuleName containingModule) + { + var finder = _declarationFinderProvider.DeclarationFinder; + var setTypeDeterminingDeclaration = SetTypeDeterminingDeclarationOfExpression(expression, containingModule, finder); + return FullObjectTypeName(setTypeDeterminingDeclaration); + } + + private string FullObjectTypeName(Declaration setTypeDeterminingDeclaration) + { + if (setTypeDeterminingDeclaration == null) + { + return null; + } + + if (setTypeDeterminingDeclaration.DeclarationType.HasFlag(DeclarationType.ClassModule)) + { + return setTypeDeterminingDeclaration.QualifiedModuleName.ToString(); + } + + if (setTypeDeterminingDeclaration.IsObject) + { + return setTypeDeterminingDeclaration.FullAsTypeName; + } + + return setTypeDeterminingDeclaration.AsTypeName == Tokens.Variant + ? setTypeDeterminingDeclaration.AsTypeName + : null; + } + + private Declaration SetTypeDeterminingDeclarationOfExpression(VBAParser.ExpressionContext expression, QualifiedModuleName containingModule, DeclarationFinder finder) + { + switch (expression) + { + case VBAParser.LExprContext lExpression: + return SetTypeDeterminingDeclarationOfExpression(lExpression.lExpression(), containingModule, finder); + case VBAParser.NewExprContext newExpression: + return null; //Not implemented yet, but it fails inspection tests on the wrong set assignment if we throw here. + //throw new NotImplementedException(); + case VBAParser.TypeofexprContext typeOfExpression: + throw new NotImplementedException(); + case VBAParser.LiteralExprContext literalExpression: + throw new NotImplementedException(); + case VBAParser.BuiltInTypeExprContext builtInTypeExpression: + throw new NotImplementedException(); + default: + return null; + } + } + + private Declaration SetTypeDeterminingDeclarationOfExpression(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) + { + switch (lExpression) + { + case VBAParser.SimpleNameExprContext simpleNameExpression: + return SetTypeDeterminingDeclarationOfExpression(simpleNameExpression.identifier(), containingModule, finder); + case VBAParser.InstanceExprContext instanceExpression: + return SetTypeDeterminingDeclarationOfInstance(containingModule, finder); + case VBAParser.IndexExprContext indexExpression: + throw new NotImplementedException(); + case VBAParser.MemberAccessExprContext memberAccessExpression: + throw new NotImplementedException(); + case VBAParser.WithMemberAccessExprContext withMemberAccessExpression: + throw new NotImplementedException(); + case VBAParser.DictionaryAccessExprContext dictionaryAccessExpression: + throw new NotImplementedException(); + case VBAParser.WithDictionaryAccessExprContext withDictionaryAccessExpression: + throw new NotImplementedException(); + case VBAParser.WhitespaceIndexExprContext whitespaceIndexExpression: + throw new NotImplementedException(); + default: + return null; + } + } + + private Declaration SetTypeDeterminingDeclarationOfExpression(VBAParser.IdentifierContext identifier, QualifiedModuleName containingModule, DeclarationFinder finder) + { + return finder.IdentifierReferences(identifier, containingModule) + .Select(reference => reference.Declaration) + .FirstOrDefault(declaration => declaration.IsObject || declaration.AsTypeName == Tokens.Variant); + } + + private Declaration SetTypeDeterminingDeclarationOfInstance(QualifiedModuleName instance, DeclarationFinder finder) + { + return finder.Classes.FirstOrDefault(cls => cls.QualifiedModuleName.Equals(instance)); + } + } +} \ No newline at end of file diff --git a/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs new file mode 100644 index 0000000000..b6476ee963 --- /dev/null +++ b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs @@ -0,0 +1,223 @@ +using System.Linq; +using Antlr4.Runtime; +using NUnit.Framework; +using Rubberduck.Parsing; +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Symbols; +using Rubberduck.Parsing.TypeResolvers; +using Rubberduck.Parsing.VBA; +using Rubberduck.Parsing.VBA.Parsing; +using Rubberduck.VBEditor; +using Rubberduck.VBEditor.SafeComWrappers; +using Rubberduck.VBEditor.SafeComWrappers.Abstract; +using RubberduckTests.Mocks; + +namespace RubberduckTests.ExpressionResolving +{ + [TestFixture] + public class SetTypeResolverTests + { + [Test] + [Category("ExpressionResolver")] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("TestProject.Class1", "TestProject.Class1")] + [TestCase("Variant", "Variant")] + [TestCase("Object", "Object")] + [TestCase("Long", null)] + public void SimpleNameExpression_SetTypeNameTests(string typeName, string expectedSetTypeName) + { + const string class1 = + @" +Private Sub Foo() +End Sub +"; + + var module1 = + $@" +Private Sub Bar() + Dim cls As {typeName} + Set cls = cls +End Sub +"; + + var expressionSelection = new Selection(4, 15, 4, 18); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Module1", expressionSelection); + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("TestProject.Class1", "TestProject.Class1")] + [TestCase("Variant", null)] + [TestCase("Object", null)] + [TestCase("Long", null)] + public void SimpleNameExpression_SetTypeDeclarationTests(string typeName, string expectedNameOfSetTypeDeclaration) + { + const string class1 = + @" +Private Sub Foo() +End Sub +"; + + var module1 = + $@" +Private Sub Bar() + Dim cls As {typeName} + Set cls = cls +End Sub +"; + + var expressionSelection = new Selection(4, 15, 4, 18); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Module1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } + + [Test] + [Category("ExpressionResolver")] + public void InstanceExpression_SetTypeName_ReturnsNameOfContainingClass() + { + const string class1 = + @" +Private Sub Foo() + Dim bar As Variant + Set bar = Me +End Sub +"; + + var expressionSelection = new Selection(4, 15, 4, 17); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Class1", expressionSelection); + var expectedSetTypeName = "TestProject.Class1"; + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + public void InstanceExpression_SetTypeDeclaration_ReturnsDeclarationOfContainingClass() + { + const string class1 = + @" +Private Sub Foo() + Dim bar As Variant + Set bar = Me +End Sub +"; + + var expressionSelection = new Selection(4, 15, 4, 17); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Class1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + var expectedNameOfSetTypeDeclaration = "TestProject.Class1"; + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } + + + private Declaration ExpressionTypeDeclaration(IVBE vbe, string componentName, Selection selection) + { + using (var state = MockParser.CreateAndParse(vbe)) + { + var resolver = ExpressionResolverUnderTest(state); + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName.Equals(componentName)); + var expression = TestExpression(state, module, selection); + return resolver.SetTypeDeclaration(expression, module); + } + } + + private string ExpressionTypeName(IVBE vbe, string componentName, Selection selection) + { + using (var state = MockParser.CreateAndParse(vbe)) + { + var resolver = ExpressionResolverUnderTest(state); + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName.Equals(componentName)); + var expression = TestExpression(state, module, selection); + return resolver.SetTypeName(expression, module); + } + } + + private VBAParser.ExpressionContext TestExpression(IParseTreeProvider parseTreeProvider, QualifiedModuleName module, Selection selection) + { + if (!(parseTreeProvider.GetParseTree(module, CodeKind.CodePaneCode) is ParserRuleContext context)) + { + return null; + } + + if (!context.GetSelection().Contains(selection)) + { + return null; + } + + return TestExpression(context, selection); + } + + private VBAParser.ExpressionContext TestExpression(ParserRuleContext context, Selection selection) + { + if (context == null) + { + return null; + } + + if (context is VBAParser.ExpressionContext expression) + { + return expression; + } + + if (context.children == null) + { + return null; + } + + foreach (var child in context.children) + { + if (child is ParserRuleContext childContext && childContext.GetSelection().Contains(selection)) + { + return TestExpression(childContext, selection); + } + } + + return null; + } + + private static ISetTypeResolver ExpressionResolverUnderTest(IDeclarationFinderProvider declarationFinderProvider) + { + return new SetTypeResolver(declarationFinderProvider); + } + } +} \ No newline at end of file diff --git a/RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs b/RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs index c2e1a3af37..add667e5fb 100644 --- a/RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs +++ b/RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs @@ -1,10 +1,14 @@ using System.Collections.Generic; using System.Linq; using System.Threading; +using Moq; using NUnit.Framework; using Rubberduck.CodeAnalysis.Inspections.Concrete; +using Rubberduck.Parsing.Grammar; using Rubberduck.Parsing.Inspections.Abstract; +using Rubberduck.Parsing.TypeResolvers; using Rubberduck.Parsing.VBA; +using Rubberduck.VBEditor; using Rubberduck.VBEditor.SafeComWrappers; using Rubberduck.VBEditor.SafeComWrappers.Abstract; using RubberduckTests.Mocks; @@ -464,24 +468,90 @@ End Sub Assert.AreEqual(1,inspectionResults.Count()); } + [Test] + [Category("Inspections")] + [TestCase("Class1", "TestProject.Class1", 0)] + [TestCase("Interface1", "TestProject.Class1", 0)] + [TestCase("Class1", "TestProject.Interface1", 0)] + [TestCase("Variant", "Whatever", 0)] //Tokens.Variant cannot be used here because it is not a constant expression. + [TestCase("Object", "Whatever", 0)] + [TestCase("Whatever", "Variant", 0)] + [TestCase("Whatever", "Object", 0)] + [TestCase("Class1", "TestProject.SomethingIncompatible", 1)] + [TestCase("Class1", "SomethingDifferent", 1)] + [TestCase("TestProject.Class1", "OtherProject.Class1", 1)] + [TestCase("TestProject.Interface1", "OtherProject.Class1", 1)] + [TestCase("TestProject.Class1", "OtherProject.Interface1", 1)] + [TestCase("Class1", "OtherProject.Class1", 1)] + [TestCase("Interface1", "OtherProject.Class1", 1)] + [TestCase("Class1", "OtherProject.Interface1", 1)] + public void MockedSetTypeEvaluatorTest(string lhsTypeName, string expressionFullTypeName, int expectedResultsCount) + { + const string interface1 = + @" +Private Sub Foo() +End Sub +"; + const string class1 = + @"Implements Interface1 + +Private Sub Interface1_Foo() +End Sub +"; + + var module1 = + $@" +Private Sub TestIt() + Dim cls As {lhsTypeName} + + Set cls = expression +End Sub +"; + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Interface1", ComponentType.ClassModule, interface1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeResolverMock = new Mock(); + setTypeResolverMock.Setup(m => + m.SetTypeName(It.IsAny(), It.IsAny())) + .Returns((VBAParser.ExpressionContext context, QualifiedModuleName qmn) => expressionFullTypeName); + + var inspectionResults = InspectionResults(vbe, setTypeResolverMock.Object).ToList(); + + Assert.AreEqual(expectedResultsCount, inspectionResults.Count); + } + private static IEnumerable InspectionResults(params (string moduleName, string content, ComponentType componentType)[] testModules) { var vbe = MockVbeBuilder.BuildFromModules(testModules).Object; return InspectionResults(vbe); } - private static IEnumerable InspectionResults(IVBE vbe) + private static IEnumerable InspectionResults(ISetTypeResolver setTypeResolver, params (string moduleName, string content, ComponentType componentType)[] testModules) + { + var vbe = MockVbeBuilder.BuildFromModules(testModules).Object; + return InspectionResults(vbe, setTypeResolver); + } + + private static IEnumerable InspectionResults(IVBE vbe, ISetTypeResolver setTypeResolver = null) { using (var state = MockParser.CreateAndParse(vbe)) { - var inspection = InspectionUnderTest(state); + var inspection = InspectionUnderTest(state, setTypeResolver); return inspection.GetInspectionResults(CancellationToken.None); } } - private static IInspection InspectionUnderTest(RubberduckParserState state) + private static IInspection InspectionUnderTest(RubberduckParserState state, ISetTypeResolver setTypeResolver = null) { - return new SetAssignmentWithIncompatibleObjectTypeInspection(state); + var setTypeResolverToUse = setTypeResolver ?? new SetTypeResolver(state); + return new SetAssignmentWithIncompatibleObjectTypeInspection(state, setTypeResolverToUse); } } } \ No newline at end of file From 47076a67ffb1d2bd7e85f6156d2ddca06a0c49a2 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Sun, 4 Aug 2019 22:04:22 +0200 Subject: [PATCH 03/22] Add support for (with) member access expressions to SetTypeResolver --- .../Rubberduck.CodeAnalysis.xml | 421 ++++++++++-------- .../TypeResolvers/SetTypeResolver.cs | 17 +- .../DeclarationCaching/DeclarationFinder.cs | 10 + .../SetTypeResolverTests.cs | 159 +++++++ 4 files changed, 425 insertions(+), 182 deletions(-) diff --git a/Rubberduck.CodeAnalysis/Rubberduck.CodeAnalysis.xml b/Rubberduck.CodeAnalysis/Rubberduck.CodeAnalysis.xml index e37d2b19c5..f597dbb8aa 100644 --- a/Rubberduck.CodeAnalysis/Rubberduck.CodeAnalysis.xml +++ b/Rubberduck.CodeAnalysis/Rubberduck.CodeAnalysis.xml @@ -46,7 +46,7 @@ 'While...Wend' loops were made obsolete when 'Do While...Loop' statements were introduced. 'While...Wend' loops cannot be exited early without a GoTo jump; 'Do...Loop' statements can be conditionally exited with 'Exit Do'. - + - + + + + Locates assignments to object variables for which the RHS does not have a compatible declared type. + + + The VBA compiler does not check whether different object types are compatible. Instead there is a runtime error whenever the types are incompatible. + + + + + + + + Default constructor required for XML serialization. @@ -144,13 +206,13 @@ Another good reason to avoid numeric suffixes: if the function is meant to be used as a UDF in a cell formula, the worksheet cell by the same name takes precedence and gets the reference, and the function is never invoked. - + - + - + - + - + - + @@ -209,7 +271,7 @@ Marking members as obsolete can help refactoring a legacy code base. This inspection is a tool that makes it easy to locate obsolete member calls. - + - + - + @@ -254,7 +316,7 @@ - + @@ -268,7 +330,7 @@ - + @@ -278,7 +340,7 @@ - + @@ -288,7 +350,7 @@ - + @@ -306,7 +368,7 @@ Mutating the inputs destroys the initial state, and makes the intent ambiguous: if the calling code is meant to be able to access the modified values, then the parameter should be passed ByRef; the ByVal modifier might be a bug. - + - + The first assignment is likely redundant, since it is being overwritten by the second. - + - + - + - + A Boolean expression never needs to be compared to a Boolean literal in a conditional expression. - + - + Declarations that are never used should be removed. - + - + These declarative statements make the first letter of identifiers determine the data type. - + Rubberduck annotations should not be specified more than once for a given module, member, variable, or expression. - + - + Case blocks in VBA do not "fall through"; an empty 'Case' block might be hiding a bug. - + - + Dead code should be removed. A loop without a body is usually redundant. - + - + - + - + Dead code should be removed. A loop without a body is usually redundant. - + - + Dead code should be removed. A loop without a body is usually redundant. - + - + Conditional expression is inverted; there would not be a need for an 'Else' block otherwise. - + - + - + - + Dead code should be removed. A loop without a body is usually redundant. - + - + - + - + - An early-bound, equivalent function likely exists in the object returned by the Application.WorksheetFunction property; - late-bound member calls will fail at run-time with error 438 if there is a typo (a typo fails to compile for an early-bound member call). - Late-bound worksheet functions will return a Variant/Error given invalid inputs; - the equivalent early-bound member calls raise a more VB-idiomatic runtime error given the same invalid inputs. - A Variant/Error value cannot be coerced into any other data type, be it for assignment or comparison. - Trying to compare or assign a Variant/Error to another data type will throw error 13 "type mismatch" at run-time. - Consider using the early-bound equivalent function instead. + An early-bound, equivalent function exists in the object returned by the Application.WorksheetFunction property; + late-bound member calls will fail at run-time with error 438 if there is a typo (a typo fails to compile for an early-bound member call); + given invalid inputs, these late-bound member calls return a Variant/Error value that cannot be coerced into another type. + The equivalent early-bound member calls raise a more VB-idiomatic, trappable runtime error given the same invalid inputs: + trying to compare or assign a Variant/Error to another data type will throw error 13 "type mismatch" at run-time. + A Variant/Error value cannot be coerced into any other data type, be it for assignment or comparison. + - + - + 15 Then ' throws error 1004 - ' won't run, error 1004 is thrown when "ABC" is processed by WorksheetFunction.Sum, before it returns. + If Application.WorksheetFunction.Sum(Array(1, 2, 3), 4, 5, "ABC") > 15 Then ' raises error 1004 + ' won't run, error 1004 is raised when "ABC" is processed by WorksheetFunction.Sum, before it returns. End If End Sub ]]> @@ -787,7 +849,7 @@ Range.Find methods return a Range object reference that refers to the cell containing the search string; this object reference will be Nothing if the search didn't turn up any results, and a member call against Nothing will raise run-time error 91. - + - + - + - + - + - + + - Inspection only evaluates hard-coded string literals; string-valued expressions evaluating into a sheet name are ignored. + For performance reasons, the inspection only evaluates hard-coded string literals; string-valued expressions evaluating into a sheet name are ignored. - + - + - + - + - + - + - + - + Rubberduck is correctly parsing an annotation, but that annotation is illegal in that context. - + - + - + - + Code should do what it says, and say what it does. Implicit default member calls generally do the opposite of that. - + - + - + - + All functions return something, whether a type is specified or not. The implicit default is 'Variant'. - + - + - + - + - + - + - + - + - + - + Some annotations require arguments; if the argument isn't specified, the annotation is nothing more than an obscure comment. - + - + - + - + - + - + - + - + - + - + - + - + - + - + When splitting a long list of parameters across multiple lines, care should be taken to avoid splitting a parameter declaration in two. - + - + Declaration statements should generally declare a single variable. - + - + Both 'Function' and 'Property Get' accessors should always return something. Omitting the return assignment is likely a bug. - + - + - + - + The 'Call' keyword is obsolete and redundant, since call statements are legal and generally more consistent without it. - + - + Modern VB comments use a single quote character (') to denote the beginning of a comment: the legacy 'Rem' syntax is obsolete. - + - + The legacy syntax is obsolete; prefer 'Err.Raise' instead. - + - + The legacy syntax is obsolete; use the 'Public' keyword instead. - + - + The legacy syntax is obsolete/redundant; prefer implicit Let-coercion instead. - + - + Type hints were made obsolete when declaration syntax introduced the 'As' keyword. Prefer explicit type names over type hint symbols. - + - + All errors are "local" - the keyword is redundant/confusing and should be removed. - + - + - + - + - + - + - + - + Declarations that are not used anywhere should probably be removed. - + Not all unused parameters can/should be removed: ignore any inspection results for event handler procedures and interface members that Rubberduck isn't recognizing as such. - - + + - + - + - + Not all unused procedures can/should be removed: ignore any inspection results for event handler procedures and interface members that Rubberduck isn't recognizing as such. - - + + - + - + - + - + - + - + - + - + - + - + - + - + - + While a great debugging tool, 'Stop' instructions should not be reachable in production code; this inspection makes it easy to locate them all. - + - + This inspection may produce false positives when the variable is an array, or if it's passed by reference (ByRef) to a procedure that assigns it. - + - + If this code compiles, then Option Explicit is omitted and compile-time validation is easily forfeited, even accidentally (e.g. typos). - + - + - + - + - + - + Not all unreachable 'Case' blocks may be flagged, depending on expression complexity. - + - + - + - + - + - + - + A variable can be declared and even assigned, but if its value is never referenced, it's effectively an unused variable. - + - + A variable declared without an explicit data type is implicitly a Variant/Empty until it is assigned. - + - + - + - + reference.Declaration) - .FirstOrDefault(declaration => declaration.IsObject || declaration.AsTypeName == Tokens.Variant); + .FirstOrDefault(declaration => declaration.IsObject + || declaration.AsTypeName == Tokens.Variant + || declaration.DeclarationType.HasFlag(DeclarationType.ClassModule)); + } + + private Declaration SetTypeDeterminingDeclarationOfExpression(VBAParser.UnrestrictedIdentifierContext identifier, QualifiedModuleName containingModule, DeclarationFinder finder) + { + return finder.IdentifierReferences(identifier, containingModule) + .Select(reference => reference.Declaration) + .FirstOrDefault(declaration => declaration.IsObject + || declaration.AsTypeName == Tokens.Variant + || declaration.DeclarationType.HasFlag(DeclarationType.ClassModule)); } private Declaration SetTypeDeterminingDeclarationOfInstance(QualifiedModuleName instance, DeclarationFinder finder) diff --git a/Rubberduck.Parsing/VBA/DeclarationCaching/DeclarationFinder.cs b/Rubberduck.Parsing/VBA/DeclarationCaching/DeclarationFinder.cs index 5cacd6569f..08e2bc54e3 100644 --- a/Rubberduck.Parsing/VBA/DeclarationCaching/DeclarationFinder.cs +++ b/Rubberduck.Parsing/VBA/DeclarationCaching/DeclarationFinder.cs @@ -1403,6 +1403,16 @@ public IEnumerable IdentifierReferences(VBAParser.Identifie .Where(identifierReference => identifierReference.IdentifierName.Equals(identifierContext.GetText())); } + /// + /// Gets all identifier references for an UnrestrictedIdentifierContext. + /// + public IEnumerable IdentifierReferences(VBAParser.UnrestrictedIdentifierContext identifierContext, QualifiedModuleName module) + { + var qualifiedSelection = new QualifiedSelection(module, identifierContext.GetSelection()); + return IdentifierReferences(qualifiedSelection) + .Where(identifierReference => identifierReference.IdentifierName.Equals(identifierContext.GetText())); + } + /// /// Gets all identifier references with the specified selection. /// diff --git a/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs index b6476ee963..ba32419fac 100644 --- a/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs +++ b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs @@ -149,6 +149,165 @@ End Sub Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); } + [Test] + [Category("ExpressionResolver")] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("TestProject.Class1", "TestProject.Class1")] + [TestCase("Variant", "Variant")] + [TestCase("Object", "Object")] + [TestCase("Long", null)] + public void MemberAccessExpression_SetTypeNameTests(string typeName, string expectedSetTypeName) + { + var class1 = + $@" +Public Property Get Foo() As {typeName} +End Property +"; + + var module1 = + @" +Private Sub Bar() + Dim cls As Class1 + Dim baz as Variant + Set baz = cls.Foo +End Sub +"; + + var expressionSelection = new Selection(5, 15, 5, 22); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Module1", expressionSelection); + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("TestProject.Class1", "TestProject.Class1")] + [TestCase("Variant", null)] + [TestCase("Object", null)] + [TestCase("Long", null)] + public void MemberAccessExpression_SetTypeDeclarationTests(string typeName, string expectedNameOfSetTypeDeclaration) + { + var class1 = + $@" +Public Property Get Foo() As {typeName} +End Property +"; + + var module1 = + @" +Private Sub Bar() + Dim cls As Class1 + Dim baz As Variant + Set baz = cls.Foo +End Sub +"; + + var expressionSelection = new Selection(5, 15, 5, 22); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Module1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("TestProject.Class1", "TestProject.Class1")] + [TestCase("Variant", "Variant")] + [TestCase("Object", "Object")] + [TestCase("Long", null)] + public void WithMemberAccessExpression_SetTypeNameTests(string typeName, string expectedSetTypeName) + { + var class1 = + $@" +Public Property Get Foo() As {typeName} +End Property +"; + + var module1 = + @" +Private Sub Bar() + With New Class1 + Dim baz as Variant + Set baz = .Foo + End With +End Sub +"; + + var expressionSelection = new Selection(5, 19, 5, 23); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Module1", expressionSelection); + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("TestProject.Class1", "TestProject.Class1")] + [TestCase("Variant", null)] + [TestCase("Object", null)] + [TestCase("Long", null)] + public void WithMemberAccessExpression_SetTypeDeclarationTests(string typeName, string expectedNameOfSetTypeDeclaration) + { + var class1 = + $@" +Public Property Get Foo() As {typeName} +End Property +"; + + var module1 = + @" +Private Sub Bar() + With New Class1 + Dim baz as Variant + Set baz = .Foo + End With +End Sub +"; + + var expressionSelection = new Selection(5, 19, 5, 23); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Module1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } private Declaration ExpressionTypeDeclaration(IVBE vbe, string componentName, Selection selection) { From 242cb42115bd60313d94c80c59024a1098466715 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Sun, 4 Aug 2019 23:06:24 +0200 Subject: [PATCH 04/22] Explicitly return NotAnObject from SetTypeReolver.SetTypeName for non-object expressions null is only returned in case we cannot resolve the Set type, primarily because of member accesses on objects of type Variant and Object. --- .../TypeResolvers/ISetTypeResolver.cs | 2 +- .../TypeResolvers/SetTypeResolver.cs | 54 ++++++++++++------- .../SetTypeResolverTests.cs | 6 +-- ...thIncompatibleObjectTypeInspectionTests.cs | 2 + 4 files changed, 40 insertions(+), 24 deletions(-) diff --git a/Rubberduck.Parsing/TypeResolvers/ISetTypeResolver.cs b/Rubberduck.Parsing/TypeResolvers/ISetTypeResolver.cs index 2a260a8d7a..606804d3c7 100644 --- a/Rubberduck.Parsing/TypeResolvers/ISetTypeResolver.cs +++ b/Rubberduck.Parsing/TypeResolvers/ISetTypeResolver.cs @@ -20,7 +20,7 @@ public interface ISetTypeResolver /// /// /// Qualified name of the Set type of the expression, if there is one, and - /// null, otherwise. + /// NotAnObject, otherwise. Returns null, if the resolution fails. /// string SetTypeName(VBAParser.ExpressionContext expression, QualifiedModuleName containingModule); } diff --git a/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs index b1634ba113..3f7d0e0fb6 100644 --- a/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs +++ b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs @@ -10,6 +10,9 @@ namespace Rubberduck.Parsing.TypeResolvers { public class SetTypeResolver : ISetTypeResolver { + public const string NotAnObject = "NotAnObject"; + + private readonly IDeclarationFinderProvider _declarationFinderProvider; public SetTypeResolver(IDeclarationFinderProvider declarationFinderProvider) @@ -21,7 +24,9 @@ public Declaration SetTypeDeclaration(VBAParser.ExpressionContext expression, Qu { var finder = _declarationFinderProvider.DeclarationFinder; var setTypeDeterminingDeclaration = SetTypeDeterminingDeclarationOfExpression(expression, containingModule, finder); - return SetTypeDeclaration(setTypeDeterminingDeclaration); + return setTypeDeterminingDeclaration.mightHaveSetType + ? SetTypeDeclaration(setTypeDeterminingDeclaration.declaration) + : null; } private Declaration SetTypeDeclaration(Declaration setTypeDeterminingDeclaration) @@ -36,7 +41,9 @@ public string SetTypeName(VBAParser.ExpressionContext expression, QualifiedModul { var finder = _declarationFinderProvider.DeclarationFinder; var setTypeDeterminingDeclaration = SetTypeDeterminingDeclarationOfExpression(expression, containingModule, finder); - return FullObjectTypeName(setTypeDeterminingDeclaration); + return setTypeDeterminingDeclaration.mightHaveSetType + ? FullObjectTypeName(setTypeDeterminingDeclaration.declaration) + : NotAnObject; } private string FullObjectTypeName(Declaration setTypeDeterminingDeclaration) @@ -58,17 +65,17 @@ private string FullObjectTypeName(Declaration setTypeDeterminingDeclaration) return setTypeDeterminingDeclaration.AsTypeName == Tokens.Variant ? setTypeDeterminingDeclaration.AsTypeName - : null; + : NotAnObject; } - private Declaration SetTypeDeterminingDeclarationOfExpression(VBAParser.ExpressionContext expression, QualifiedModuleName containingModule, DeclarationFinder finder) + private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfExpression(VBAParser.ExpressionContext expression, QualifiedModuleName containingModule, DeclarationFinder finder) { switch (expression) { case VBAParser.LExprContext lExpression: return SetTypeDeterminingDeclarationOfExpression(lExpression.lExpression(), containingModule, finder); case VBAParser.NewExprContext newExpression: - return null; //Not implemented yet, but it fails inspection tests on the wrong set assignment if we throw here. + return (null, true); //Not implemented yet, but it fails inspection tests on the wrong set assignment if we throw here. //throw new NotImplementedException(); case VBAParser.TypeofexprContext typeOfExpression: throw new NotImplementedException(); @@ -77,11 +84,11 @@ private Declaration SetTypeDeterminingDeclarationOfExpression(VBAParser.Expressi case VBAParser.BuiltInTypeExprContext builtInTypeExpression: throw new NotImplementedException(); default: - return null; + return (null, false); //All remaining expression types have no Set type. } } - private Declaration SetTypeDeterminingDeclarationOfExpression(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) + private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfExpression(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) { switch (lExpression) { @@ -102,31 +109,38 @@ private Declaration SetTypeDeterminingDeclarationOfExpression(VBAParser.LExpress case VBAParser.WhitespaceIndexExprContext whitespaceIndexExpression: throw new NotImplementedException(); default: - return null; + return (null, true); //We should already cover every case. Return the value indicating that we have no idea. } } - private Declaration SetTypeDeterminingDeclarationOfExpression(VBAParser.IdentifierContext identifier, QualifiedModuleName containingModule, DeclarationFinder finder) + private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfExpression(VBAParser.IdentifierContext identifier, QualifiedModuleName containingModule, DeclarationFinder finder) { - return finder.IdentifierReferences(identifier, containingModule) + var declaration = finder.IdentifierReferences(identifier, containingModule) .Select(reference => reference.Declaration) - .FirstOrDefault(declaration => declaration.IsObject - || declaration.AsTypeName == Tokens.Variant - || declaration.DeclarationType.HasFlag(DeclarationType.ClassModule)); + .FirstOrDefault(); + return (declaration, MightHaveSetType(declaration)); } - private Declaration SetTypeDeterminingDeclarationOfExpression(VBAParser.UnrestrictedIdentifierContext identifier, QualifiedModuleName containingModule, DeclarationFinder finder) + private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfExpression(VBAParser.UnrestrictedIdentifierContext identifier, QualifiedModuleName containingModule, DeclarationFinder finder) { - return finder.IdentifierReferences(identifier, containingModule) + var declaration = finder.IdentifierReferences(identifier, containingModule) .Select(reference => reference.Declaration) - .FirstOrDefault(declaration => declaration.IsObject - || declaration.AsTypeName == Tokens.Variant - || declaration.DeclarationType.HasFlag(DeclarationType.ClassModule)); + .FirstOrDefault(); + return (declaration, MightHaveSetType(declaration)); + } + + private static bool MightHaveSetType(Declaration declaration) + { + return declaration == null + || declaration.IsObject + || declaration.AsTypeName == Tokens.Variant + || declaration.DeclarationType.HasFlag(DeclarationType.ClassModule); } - private Declaration SetTypeDeterminingDeclarationOfInstance(QualifiedModuleName instance, DeclarationFinder finder) + private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfInstance(QualifiedModuleName instance, DeclarationFinder finder) { - return finder.Classes.FirstOrDefault(cls => cls.QualifiedModuleName.Equals(instance)); + var classDeclaration = finder.Classes.FirstOrDefault(cls => cls.QualifiedModuleName.Equals(instance)); + return (classDeclaration, true); } } } \ No newline at end of file diff --git a/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs index ba32419fac..3768049062 100644 --- a/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs +++ b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs @@ -23,7 +23,7 @@ public class SetTypeResolverTests [TestCase("TestProject.Class1", "TestProject.Class1")] [TestCase("Variant", "Variant")] [TestCase("Object", "Object")] - [TestCase("Long", null)] + [TestCase("Long", SetTypeResolver.NotAnObject)] public void SimpleNameExpression_SetTypeNameTests(string typeName, string expectedSetTypeName) { const string class1 = @@ -155,7 +155,7 @@ End Sub [TestCase("TestProject.Class1", "TestProject.Class1")] [TestCase("Variant", "Variant")] [TestCase("Object", "Object")] - [TestCase("Long", null)] + [TestCase("Long", SetTypeResolver.NotAnObject)] public void MemberAccessExpression_SetTypeNameTests(string typeName, string expectedSetTypeName) { var class1 = @@ -234,7 +234,7 @@ End Sub [TestCase("TestProject.Class1", "TestProject.Class1")] [TestCase("Variant", "Variant")] [TestCase("Object", "Object")] - [TestCase("Long", null)] + [TestCase("Long", SetTypeResolver.NotAnObject)] public void WithMemberAccessExpression_SetTypeNameTests(string typeName, string expectedSetTypeName) { var class1 = diff --git a/RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs b/RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs index add667e5fb..1a6ecdc3b2 100644 --- a/RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs +++ b/RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs @@ -485,6 +485,8 @@ End Sub [TestCase("Class1", "OtherProject.Class1", 1)] [TestCase("Interface1", "OtherProject.Class1", 1)] [TestCase("Class1", "OtherProject.Interface1", 1)] + [TestCase("Class1", SetTypeResolver.NotAnObject, 1)] //The RHS is not even an object. (Will show as type NotAnObject in the result.) + [TestCase("Class1", null, 0)] //We could not resolve the Set type, so we do not return a result. public void MockedSetTypeEvaluatorTest(string lhsTypeName, string expressionFullTypeName, int expectedResultsCount) { const string interface1 = From fd0a701a97ec9038e669dffbe6e3b3431f41f955 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Mon, 5 Aug 2019 02:15:25 +0200 Subject: [PATCH 05/22] Add support for all non lExpressions to SetTypeResolver This includes a workaround requires because built-in types are currently resolved as lExpressions, more precisely as simpleNameExpressions. --- .../TypeResolvers/SetTypeResolver.cs | 145 ++++++-- .../SetTypeResolverTests.cs | 324 +++++++++++++++++- 2 files changed, 435 insertions(+), 34 deletions(-) diff --git a/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs index 3f7d0e0fb6..c97bfe2b44 100644 --- a/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs +++ b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs @@ -1,4 +1,5 @@ using System; +using System.Collections.Generic; using System.Linq; using Rubberduck.Parsing.Grammar; using Rubberduck.Parsing.Symbols; @@ -21,12 +22,26 @@ public SetTypeResolver(IDeclarationFinderProvider declarationFinderProvider) } public Declaration SetTypeDeclaration(VBAParser.ExpressionContext expression, QualifiedModuleName containingModule) + { + switch (expression) + { + case VBAParser.LExprContext lExpression: + return SetTypeDeclaration(lExpression.lExpression(), containingModule); + case VBAParser.NewExprContext newExpression: + return SetTypeDeclaration(newExpression.expression(), containingModule); + case VBAParser.TypeofexprContext typeOfExpression: + return SetTypeDeclaration(typeOfExpression.expression(), containingModule); + default: + return null; //All remaining expression types either have no Set type or there is no declaration for it. + } + } + + private Declaration SetTypeDeclaration(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule) { var finder = _declarationFinderProvider.DeclarationFinder; - var setTypeDeterminingDeclaration = SetTypeDeterminingDeclarationOfExpression(expression, containingModule, finder); - return setTypeDeterminingDeclaration.mightHaveSetType - ? SetTypeDeclaration(setTypeDeterminingDeclaration.declaration) - : null; + var setTypeDeterminingDeclaration = + SetTypeDeterminingDeclarationOfExpression(lExpression, containingModule, finder); + return SetTypeDeclaration(setTypeDeterminingDeclaration.declaration); } private Declaration SetTypeDeclaration(Declaration setTypeDeterminingDeclaration) @@ -38,19 +53,73 @@ private Declaration SetTypeDeclaration(Declaration setTypeDeterminingDeclaration public string SetTypeName(VBAParser.ExpressionContext expression, QualifiedModuleName containingModule) + { + switch (expression) + { + case VBAParser.LExprContext lExpression: + return SetTypeName(lExpression.lExpression(), containingModule); + case VBAParser.NewExprContext newExpression: + return SetTypeName(newExpression.expression(), containingModule); + case VBAParser.TypeofexprContext typeOfExpression: + return SetTypeName(typeOfExpression.expression(), containingModule); + case VBAParser.LiteralExprContext literalExpression: + return SetTypeName(literalExpression.literalExpression()); + case VBAParser.BuiltInTypeExprContext builtInTypeExpression: + return SetTypeName(builtInTypeExpression.builtInType()); + default: + return NotAnObject; //All remaining expression types have no Set type. + } + } + + private string SetTypeName(VBAParser.LiteralExpressionContext literalExpression) + { + var literalIdentifier = literalExpression.literalIdentifier(); + + if (literalIdentifier?.objectLiteralIdentifier() != null) + { + return Tokens.Object; + } + + return NotAnObject; + } + + private string SetTypeName(VBAParser.BuiltInTypeContext builtInType) + { + if (builtInType.OBJECT() != null) + { + return Tokens.Object; + } + + var baseType = builtInType.baseType(); + + if (baseType.VARIANT() != null) + { + return Tokens.Variant; + } + + if (baseType.ANY() != null) + { + return Tokens.Any; + } + + return NotAnObject; + } + + private string SetTypeName(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule) { var finder = _declarationFinderProvider.DeclarationFinder; - var setTypeDeterminingDeclaration = SetTypeDeterminingDeclarationOfExpression(expression, containingModule, finder); + var setTypeDeterminingDeclaration = SetTypeDeterminingDeclarationOfExpression(lExpression, containingModule, finder); return setTypeDeterminingDeclaration.mightHaveSetType - ? FullObjectTypeName(setTypeDeterminingDeclaration.declaration) + ? FullObjectTypeName(setTypeDeterminingDeclaration.declaration, lExpression) : NotAnObject; } - private string FullObjectTypeName(Declaration setTypeDeterminingDeclaration) + private static string FullObjectTypeName(Declaration setTypeDeterminingDeclaration, VBAParser.LExpressionContext lExpression) { if (setTypeDeterminingDeclaration == null) { - return null; + //This is a workaround because built-in type expressions tent to get matched by simple name expressions instead. + return BuiltInObjectTypeNameFromUnresolvedlExpression(lExpression); } if (setTypeDeterminingDeclaration.DeclarationType.HasFlag(DeclarationType.ClassModule)) @@ -68,26 +137,56 @@ private string FullObjectTypeName(Declaration setTypeDeterminingDeclaration) : NotAnObject; } - private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfExpression(VBAParser.ExpressionContext expression, QualifiedModuleName containingModule, DeclarationFinder finder) + private static string BuiltInObjectTypeNameFromUnresolvedlExpression(VBAParser.LExpressionContext lExpression) { - switch (expression) + var expressionText = WithBracketsRemoved(lExpression.GetText()); + + if (_builtInObjectTypeNames.Contains(expressionText)) { - case VBAParser.LExprContext lExpression: - return SetTypeDeterminingDeclarationOfExpression(lExpression.lExpression(), containingModule, finder); - case VBAParser.NewExprContext newExpression: - return (null, true); //Not implemented yet, but it fails inspection tests on the wrong set assignment if we throw here. - //throw new NotImplementedException(); - case VBAParser.TypeofexprContext typeOfExpression: - throw new NotImplementedException(); - case VBAParser.LiteralExprContext literalExpression: - throw new NotImplementedException(); - case VBAParser.BuiltInTypeExprContext builtInTypeExpression: - throw new NotImplementedException(); - default: - return (null, false); //All remaining expression types have no Set type. + return expressionText; + } + + if (_builtInNonObjectTypeNames.Contains(expressionText)) + { + return NotAnObject; } + + return null; } + private static string WithBracketsRemoved(string input) + { + if (input.StartsWith("[") && input.EndsWith("]")) + { + return input.Substring(1, input.Length - 2); + } + + return input; + } + + private static List _builtInObjectTypeNames = new List + { + Tokens.Any, + Tokens.Variant, + Tokens.Object + }; + + private static List _builtInNonObjectTypeNames = new List + { + Tokens.Boolean, + Tokens.Byte, + Tokens.Currency, + Tokens.Date, + Tokens.Double, + Tokens.Integer, + Tokens.Long, + Tokens.LongLong, + Tokens.LongPtr, + Tokens.Single, + Tokens.String + }; + + private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfExpression(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) { switch (lExpression) diff --git a/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs index 3768049062..d84071267a 100644 --- a/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs +++ b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs @@ -309,6 +309,308 @@ End Sub Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); } + [Test] + [Category("ExpressionResolver")] + public void TypeOfExpression_SetTypeName_ReturnsSetTypeNameOfExpression() + { + var class1 = + @" +Public Property Get Foo() As Class2 +End Property +"; + var class2 = + @""; + + var module1 = + @" +Private Sub Bar() + Dim cls as Class1 + Dim baz as Variant + baz = TypeOf cls.Foo Is TestProject.Class1 +End Sub +"; + + var expressionSelection = new Selection(5, 11, 5, 25); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Class2", ComponentType.ClassModule, class2) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Module1", expressionSelection); + var expectedSetTypeName = "TestProject.Class2"; + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + public void TypeOfExpression_SetTypeDeclaration_ReturnsSetTypeDeclarationOfExpression() + { + var class1 = + @" +Public Property Get Foo() As Class2 +End Property +"; + var class2 = + @""; + + var module1 = + @" +Private Sub Bar() + Dim cls as Class1 + Dim baz as Variant + baz = TypeOf cls.Foo Is TestProject.Class1 +End Sub +"; + + var expressionSelection = new Selection(5, 11, 5, 25); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Class2", ComponentType.ClassModule, class2) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Module1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + var expectedNameOfSetTypeDeclaration = "TestProject.Class2"; + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("TestProject.Class1", "TestProject.Class1")] + public void NewExpression_SetTypeNameTests(string typeName, string expectedSetTypeName) + { + var class1 = + @" +Public Property Get Foo() As Variant +End Property +"; + + var module1 = + $@" +Private Sub Bar() + Dim baz as Variant + Set baz = New {typeName} +End Sub +"; + + var expressionSelection = new Selection(4, 15, 4, 20); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Module1", expressionSelection); + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("TestProject.Class1", "TestProject.Class1")] + public void NewExpression_SetTypeDeclarationTests(string typeName, string expectedNameOfSetTypeDeclaration) + { + var class1 = + @" +Public Property Get Foo() As Variant +End Property +"; + + var module1 = + $@" +Private Sub Bar() + Dim baz as Variant + Set baz = New {typeName} +End Sub +"; + + var expressionSelection = new Selection(4, 15, 4, 20); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Module1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Nothing", "Object")] + [TestCase("5", SetTypeResolver.NotAnObject)] + public void LiteralExpression_SetTypeNameTests(string literal, string expectedSetTypeName) + { + var class1 = + @" +Public Property Get Foo() As Variant +End Property +"; + + var module1 = + $@" +Private Sub Bar() + Dim baz as Variant + Set baz = {literal} +End Sub +"; + + var expressionSelection = new Selection(4, 15, 4, 16); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Module1", expressionSelection); + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Nothing", null)] + [TestCase("5", null)] + public void LiteralExpression_SetTypeDeclarationTests(string literal, string expectedNameOfSetTypeDeclaration) + { + var class1 = + @" +Public Property Get Foo() As Variant +End Property +"; + + var module1 = + $@" +Private Sub Bar() + Dim baz as Variant + Set baz = {literal} +End Sub +"; + + var expressionSelection = new Selection(4, 15, 4, 16); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Module1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Object", "Object")] + [TestCase("[Object]", "Object")] + [TestCase("Variant", "Variant")] + [TestCase("[Variant]", "Variant")] + [TestCase("Any", "Any")] + [TestCase("[Any]", "Any")] + [TestCase("Long", SetTypeResolver.NotAnObject)] + [TestCase("[Long]", SetTypeResolver.NotAnObject)] + public void TypeOfIsRHSExpression_SetTypeNameTests(string builtInType, string expectedSetTypeName) + { + var class1 = + @" +Public Property Get Foo() As Variant +End Property +"; + + var module1 = + $@" +Private Sub Bar() + Dim baz as Variant + Set baz = TypeOf baz Is {builtInType} +End Sub +"; + + var expressionSelection = new Selection(4, 30, 4, 31); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Module1", expressionSelection); + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Object", null)] + [TestCase("[Object]", null)] + [TestCase("Variant", null)] + [TestCase("[Variant]", null)] + [TestCase("Any", null)] + [TestCase("[Any]", null)] + [TestCase("Long", null)] + [TestCase("[Long]", null)] + public void TypeOfIsRHS_SetTypeDeclarationTests(string builtInType, string expectedNameOfSetTypeDeclaration) + { + var class1 = + @" +Public Property Get Foo() As Variant +End Property +"; + + var module1 = + $@" +Private Sub Bar() + Dim baz as Variant + Set baz = TypeOf baz Is {builtInType} +End Sub +"; + + var expressionSelection = new Selection(4, 29, 4, 30); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Module1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } + private Declaration ExpressionTypeDeclaration(IVBE vbe, string componentName, Selection selection) { using (var state = MockParser.CreateAndParse(vbe)) @@ -353,22 +655,22 @@ private VBAParser.ExpressionContext TestExpression(ParserRuleContext context, Se return null; } - if (context is VBAParser.ExpressionContext expression) - { - return expression; - } + var containingChild = context.children + .OfType() + .FirstOrDefault(childContext => childContext.GetSelection().Contains(selection)); + + var containedTestExpression = containingChild != null + ? TestExpression(containingChild, selection) + : null; - if (context.children == null) + if (containedTestExpression != null) { - return null; + return containedTestExpression; } - foreach (var child in context.children) + if (context is VBAParser.ExpressionContext expression) { - if (child is ParserRuleContext childContext && childContext.GetSelection().Contains(selection)) - { - return TestExpression(childContext, selection); - } + return expression; } return null; From 8dba19e70ce0e029849cccb1e3b2c63f130e3e0e Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Tue, 6 Aug 2019 01:09:49 +0200 Subject: [PATCH 06/22] Prefer builtInType over lExpr in expression in grammar Previously, everything matched by builtInTypeExpr was already consumed by lExpr. Since all built-in types are keywords, this should not cause problems in most cases. The only exception would be foreign identifiers whose name is a built-in type. (This should be very rare and is problematic anyway.) This change required patching up the resolver as well to deal with builtInTypes. --- .../Bindings/BuiltInTypeDefaultBinding.cs | 19 +++++++ .../Binding/DefaultBindingContext.cs | 2 +- .../Expressions/BuiltInTypeExpression.cs | 12 +++++ .../Binding/TypeBindingContext.cs | 23 +++----- Rubberduck.Parsing/Grammar/VBAParser.g4 | 3 +- .../TypeResolvers/SetTypeResolver.cs | 53 +------------------ .../BoundExpressionVisitor.cs | 5 +- .../SetTypeResolverTests.cs | 12 ++--- .../ObjectVariableNotSetInspectionTests.cs | 6 +-- .../QuickFixes/IgnoreOnceQuickFixTests.cs | 4 +- 10 files changed, 57 insertions(+), 82 deletions(-) create mode 100644 Rubberduck.Parsing/Binding/Bindings/BuiltInTypeDefaultBinding.cs create mode 100644 Rubberduck.Parsing/Binding/Expressions/BuiltInTypeExpression.cs diff --git a/Rubberduck.Parsing/Binding/Bindings/BuiltInTypeDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/BuiltInTypeDefaultBinding.cs new file mode 100644 index 0000000000..f849d2991c --- /dev/null +++ b/Rubberduck.Parsing/Binding/Bindings/BuiltInTypeDefaultBinding.cs @@ -0,0 +1,19 @@ +using Antlr4.Runtime; + +namespace Rubberduck.Parsing.Binding +{ + public sealed class BuiltInTypeDefaultBinding : IExpressionBinding + { + private readonly ParserRuleContext _context; + + public BuiltInTypeDefaultBinding(ParserRuleContext context) + { + _context = context; + } + + public IBoundExpression Resolve() + { + return new BuiltInTypeExpression(_context); + } + } +} \ No newline at end of file diff --git a/Rubberduck.Parsing/Binding/DefaultBindingContext.cs b/Rubberduck.Parsing/Binding/DefaultBindingContext.cs index b8911bbe6e..480d8a27c0 100644 --- a/Rubberduck.Parsing/Binding/DefaultBindingContext.cs +++ b/Rubberduck.Parsing/Binding/DefaultBindingContext.cs @@ -179,7 +179,7 @@ private IExpressionBinding Visit(Declaration module, Declaration parent, VBAPars private IExpressionBinding Visit(VBAParser.BuiltInTypeExprContext expression) { // Not actually an expression, but treated as one to allow for a faster parser. - return null; + return new BuiltInTypeDefaultBinding(expression); } private IExpressionBinding VisitType(Declaration module, Declaration parent, VBAParser.ExpressionContext expression, IBoundExpression withBlockVariable) diff --git a/Rubberduck.Parsing/Binding/Expressions/BuiltInTypeExpression.cs b/Rubberduck.Parsing/Binding/Expressions/BuiltInTypeExpression.cs new file mode 100644 index 0000000000..2acae8464a --- /dev/null +++ b/Rubberduck.Parsing/Binding/Expressions/BuiltInTypeExpression.cs @@ -0,0 +1,12 @@ +using Antlr4.Runtime; + +namespace Rubberduck.Parsing.Binding +{ + public sealed class BuiltInTypeExpression : BoundExpression + { + public BuiltInTypeExpression(ParserRuleContext context) + : base(null, ExpressionClassification.Type, context) + { + } + } +} \ No newline at end of file diff --git a/Rubberduck.Parsing/Binding/TypeBindingContext.cs b/Rubberduck.Parsing/Binding/TypeBindingContext.cs index 30e9cfcb4b..19ef9c0824 100644 --- a/Rubberduck.Parsing/Binding/TypeBindingContext.cs +++ b/Rubberduck.Parsing/Binding/TypeBindingContext.cs @@ -18,11 +18,7 @@ public TypeBindingContext(DeclarationFinder declarationFinder) public IBoundExpression Resolve(Declaration module, Declaration parent, IParseTree expression, IBoundExpression withBlockVariable, StatementResolutionContext statementContext) { IExpressionBinding bindingTree = BuildTree(module, parent, expression, withBlockVariable, statementContext); - if (bindingTree != null) - { - return bindingTree.Resolve(); - } - return null; + return bindingTree?.Resolve(); } public IExpressionBinding BuildTree(Declaration module, Declaration parent, IParseTree expression, IBoundExpression withBlockVariable, StatementResolutionContext statementContext) @@ -30,24 +26,19 @@ public IExpressionBinding BuildTree(Declaration module, Declaration parent, IPar switch (expression) { case VBAParser.LExprContext lExprContext: - return Visit(module, parent, lExprContext); + return Visit(module, parent, lExprContext.lExpression()); case VBAParser.CtLExprContext ctLExprContext: - return Visit(module, parent, ctLExprContext); + return Visit(module, parent, ctLExprContext.lExpression()); + case VBAParser.BuiltInTypeExprContext builtInTypeExprContext: + return Visit(builtInTypeExprContext.builtInType()); default: throw new NotSupportedException($"Unexpected context type {expression.GetType()}"); } } - private IExpressionBinding Visit(Declaration module, Declaration parent, VBAParser.LExprContext expression) + private IExpressionBinding Visit(VBAParser.BuiltInTypeContext builtInType) { - var lexpr = expression.lExpression(); - return Visit(module, parent, lexpr); - } - - private IExpressionBinding Visit(Declaration module, Declaration parent, VBAParser.CtLExprContext expression) - { - var lexpr = expression.lExpression(); - return Visit(module, parent, lexpr); + return new BuiltInTypeDefaultBinding(builtInType); } private IExpressionBinding Visit(Declaration module, Declaration parent, VBAParser.LExpressionContext expression) diff --git a/Rubberduck.Parsing/Grammar/VBAParser.g4 b/Rubberduck.Parsing/Grammar/VBAParser.g4 index b658d2e7c4..5ad52a0b4e 100644 --- a/Rubberduck.Parsing/Grammar/VBAParser.g4 +++ b/Rubberduck.Parsing/Grammar/VBAParser.g4 @@ -647,6 +647,7 @@ visibility : PRIVATE | PUBLIC | FRIEND | GLOBAL; // 5.6 Expressions expression : // Literal Expression has to come before lExpression, otherwise it'll be classified as simple name expression instead. + //The same holds for Built-in Type Expression. whiteSpace? LPAREN whiteSpace? expression whiteSpace? RPAREN # parenthesizedExpr | TYPEOF whiteSpace expression # typeofexpr // To make the grammar SLL, the type-of-is-expression is actually the child of an IS relational op. | HASH expression # markedFileNumberExpr // Added to support special forms such as Input(file1, #file1) @@ -666,8 +667,8 @@ expression : | expression whiteSpace? EQV whiteSpace? expression # logicalEqvOp | expression whiteSpace? IMP whiteSpace? expression # logicalImpOp | literalExpression # literalExpr - | lExpression # lExpr | builtInType # builtInTypeExpr + | lExpression # lExpr ; // 5.6.5 Literal Expressions diff --git a/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs index c97bfe2b44..b4927314a2 100644 --- a/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs +++ b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs @@ -118,8 +118,7 @@ private static string FullObjectTypeName(Declaration setTypeDeterminingDeclarati { if (setTypeDeterminingDeclaration == null) { - //This is a workaround because built-in type expressions tent to get matched by simple name expressions instead. - return BuiltInObjectTypeNameFromUnresolvedlExpression(lExpression); + return null; } if (setTypeDeterminingDeclaration.DeclarationType.HasFlag(DeclarationType.ClassModule)) @@ -137,56 +136,6 @@ private static string FullObjectTypeName(Declaration setTypeDeterminingDeclarati : NotAnObject; } - private static string BuiltInObjectTypeNameFromUnresolvedlExpression(VBAParser.LExpressionContext lExpression) - { - var expressionText = WithBracketsRemoved(lExpression.GetText()); - - if (_builtInObjectTypeNames.Contains(expressionText)) - { - return expressionText; - } - - if (_builtInNonObjectTypeNames.Contains(expressionText)) - { - return NotAnObject; - } - - return null; - } - - private static string WithBracketsRemoved(string input) - { - if (input.StartsWith("[") && input.EndsWith("]")) - { - return input.Substring(1, input.Length - 2); - } - - return input; - } - - private static List _builtInObjectTypeNames = new List - { - Tokens.Any, - Tokens.Variant, - Tokens.Object - }; - - private static List _builtInNonObjectTypeNames = new List - { - Tokens.Boolean, - Tokens.Byte, - Tokens.Currency, - Tokens.Date, - Tokens.Double, - Tokens.Integer, - Tokens.Long, - Tokens.LongLong, - Tokens.LongPtr, - Tokens.Single, - Tokens.String - }; - - private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfExpression(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) { switch (lExpression) diff --git a/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs b/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs index a3482b0931..0f6dfeec88 100644 --- a/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs +++ b/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs @@ -75,7 +75,10 @@ public BoundExpressionVisitor(DeclarationFinder declarationFinder) case ResolutionFailedExpression resolutionFailedExpression: Visit(resolutionFailedExpression, module, scope, parent); break; - default: throw new NotSupportedException($"Unexpected bound expression type {boundExpression.GetType()}"); + case BuiltInTypeExpression builtInTypeExpression: + break; + default: + throw new NotSupportedException($"Unexpected bound expression type {boundExpression.GetType()}"); } } diff --git a/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs index d84071267a..1cab18f223 100644 --- a/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs +++ b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs @@ -538,7 +538,7 @@ End Sub [TestCase("[Any]", "Any")] [TestCase("Long", SetTypeResolver.NotAnObject)] [TestCase("[Long]", SetTypeResolver.NotAnObject)] - public void TypeOfIsRHSExpression_SetTypeNameTests(string builtInType, string expectedSetTypeName) + public void BuiltInTypeExpression_SetTypeNameTests(string builtInType, string expectedSetTypeName) { var class1 = @" @@ -550,11 +550,11 @@ End Property $@" Private Sub Bar() Dim baz as Variant - Set baz = TypeOf baz Is {builtInType} + baz = TypeOf baz Is {builtInType} End Sub "; - var expressionSelection = new Selection(4, 30, 4, 31); + var expressionSelection = new Selection(4, 25, 4, 26); var vbe = new MockVbeBuilder() .ProjectBuilder("TestProject", ProjectProtection.Unprotected) @@ -579,7 +579,7 @@ End Sub [TestCase("[Any]", null)] [TestCase("Long", null)] [TestCase("[Long]", null)] - public void TypeOfIsRHS_SetTypeDeclarationTests(string builtInType, string expectedNameOfSetTypeDeclaration) + public void BuiltInTypeExpression_SetTypeDeclarationTests(string builtInType, string expectedNameOfSetTypeDeclaration) { var class1 = @" @@ -591,11 +591,11 @@ End Property $@" Private Sub Bar() Dim baz as Variant - Set baz = TypeOf baz Is {builtInType} + baz = TypeOf baz Is {builtInType} End Sub "; - var expressionSelection = new Selection(4, 29, 4, 30); + var expressionSelection = new Selection(4, 25, 4, 26); var vbe = new MockVbeBuilder() .ProjectBuilder("TestProject", ProjectProtection.Unprotected) diff --git a/RubberduckTests/Inspections/ObjectVariableNotSetInspectionTests.cs b/RubberduckTests/Inspections/ObjectVariableNotSetInspectionTests.cs index 8263a6d243..fb532c6e30 100644 --- a/RubberduckTests/Inspections/ObjectVariableNotSetInspectionTests.cs +++ b/RubberduckTests/Inspections/ObjectVariableNotSetInspectionTests.cs @@ -33,7 +33,7 @@ public void ObjectVariableNotSet_AlsoAssignedToNothing_ReturnsNoResult() @" Private Sub DoSomething() Dim target As Object - Set target = New Object + Set target = New Class1 target.DoSomething Set target = Nothing End Sub @@ -85,7 +85,7 @@ public void ObjectVariableNotSet_GivenPropertySet_WithoutSet_ReturnsResult() End Property Private Sub DoSomething() - Foo = New Object + Foo = New Class1 End Sub "; AssertInputCodeYieldsExpectedInspectionResultCount(input, expectResultCount); @@ -102,7 +102,7 @@ public void ObjectVariableNotSet_GivenPropertySet_WithSet_ReturnsNoResult() End Property Private Sub DoSomething() - Set Foo = New Object + Set Foo = New Class1 End Sub "; AssertInputCodeYieldsExpectedInspectionResultCount(input, expectResultCount); diff --git a/RubberduckTests/QuickFixes/IgnoreOnceQuickFixTests.cs b/RubberduckTests/QuickFixes/IgnoreOnceQuickFixTests.cs index a9cc443150..25a710eff1 100644 --- a/RubberduckTests/QuickFixes/IgnoreOnceQuickFixTests.cs +++ b/RubberduckTests/QuickFixes/IgnoreOnceQuickFixTests.cs @@ -392,7 +392,7 @@ public void ObjectVariableNotSet_IgnoreQuickFixWorks() Private Sub DoSomething() Dim target As Object - target = New Object + target = New Class1 target.Value = ""forgot something?"" @@ -403,7 +403,7 @@ public void ObjectVariableNotSet_IgnoreQuickFixWorks() Dim target As Object '@Ignore ObjectVariableNotSet - target = New Object + target = New Class1 target.Value = ""forgot something?"" From ae99ed2a66796a29f91b04257cac6cae9b9d2f24 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Thu, 8 Aug 2019 00:52:41 +0200 Subject: [PATCH 07/22] Attach references to the called default member to the exclamation mark in (with) dictionary access expressions --- .../DictionaryAccessDefaultBinding.cs | 194 +++++++++++++++++ .../Binding/Bindings/IndexDefaultBinding.cs | 20 -- .../Binding/DefaultBindingContext.cs | 25 ++- .../Expressions/DictionaryAccessExpression.cs | 37 ++++ .../Binding/Expressions/IndexExpression.cs | 8 +- Rubberduck.Parsing/Grammar/VBAParser.g4 | 7 +- .../Symbols/IdentifierReferenceResolver.cs | 19 +- .../BoundExpressionVisitor.cs | 72 +++++-- RubberduckTests/Grammar/ResolverTests.cs | 201 +++++++++++++++--- 9 files changed, 492 insertions(+), 91 deletions(-) create mode 100644 Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs create mode 100644 Rubberduck.Parsing/Binding/Expressions/DictionaryAccessExpression.cs diff --git a/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs new file mode 100644 index 0000000000..61c409010d --- /dev/null +++ b/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs @@ -0,0 +1,194 @@ +using System; +using Rubberduck.Parsing.Symbols; +using System.Linq; +using Antlr4.Runtime; +using Antlr4.Runtime.Atn; +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.VBA.DeclarationCaching; + +namespace Rubberduck.Parsing.Binding +{ + public sealed class DictionaryAccessDefaultBinding : IExpressionBinding + { + private readonly ParserRuleContext _expression; + private readonly IExpressionBinding _lExpressionBinding; + private IBoundExpression _lExpression; + private readonly ArgumentList _argumentList; + + private const int DEFAULT_MEMBER_RECURSION_LIMIT = 32; + private int _defaultMemberRecursionLimitCounter = 0; + + public DictionaryAccessDefaultBinding( + ParserRuleContext expression, + IExpressionBinding lExpressionBinding, + ArgumentList argumentList) + : this( + expression, + (IBoundExpression) null, + argumentList) + { + _lExpressionBinding = lExpressionBinding; + } + + public DictionaryAccessDefaultBinding( + ParserRuleContext expression, + IBoundExpression lExpression, + ArgumentList argumentList) + { + _expression = expression; + _lExpression = lExpression; + _argumentList = argumentList; + } + + private void ResolveArgumentList(Declaration calledProcedure) + { + foreach (var argument in _argumentList.Arguments) + { + argument.Resolve(calledProcedure); + } + } + + public IBoundExpression Resolve() + { + if (_lExpressionBinding != null) + { + _lExpression = _lExpressionBinding.Resolve(); + } + + if (_lExpression.Classification == ExpressionClassification.ResolutionFailed) + { + ResolveArgumentList(null); + return CreateFailedExpression(_lExpression); + } + + var lDeclaration = _lExpression.ReferencedDeclaration; + + if (_lExpression.Classification == ExpressionClassification.Unbound) + { + /* + is classified as an unbound member. In this case, the dictionary access expression + is classified as an unbound member with a declared type of Variant, referencing with no member name. + */ + ResolveArgumentList(lDeclaration); + return new DictionaryAccessExpression(null, ExpressionClassification.Unbound, _expression, _lExpression, _argumentList); + } + + if (lDeclaration == null) + { + ResolveArgumentList(null); + return CreateFailedExpression(_lExpression); + } + + var asTypeName = lDeclaration.AsTypeName; + var asTypeDeclaration = lDeclaration.AsTypeDeclaration; + + return ResolveViaDefaultMember(_lExpression, asTypeName, asTypeDeclaration); + } + + private IBoundExpression CreateFailedExpression(IBoundExpression lExpression) + { + var failedExpr = new ResolutionFailedExpression(); + failedExpr.AddSuccessfullyResolvedExpression(lExpression); + foreach (var arg in _argumentList.Arguments) + { + failedExpr.AddSuccessfullyResolvedExpression(arg.Expression); + } + + return failedExpr; + } + + private IBoundExpression ResolveViaDefaultMember(IBoundExpression lExpression, string asTypeName, Declaration asTypeDeclaration) + { + if (Tokens.Variant.Equals(asTypeName, StringComparison.InvariantCultureIgnoreCase) + || Tokens.Object.Equals(asTypeName, StringComparison.InvariantCultureIgnoreCase)) + { + /* + The declared type of is Object or Variant. + In this case, the dictionary access expression is classified as an unbound member with + a declared type of Variant, referencing with no member name. + */ + ResolveArgumentList(null); + return new DictionaryAccessExpression(null, ExpressionClassification.Unbound, _expression, lExpression, _argumentList); + } + + /* + The declared type of is a specific class, which has a public default Property + Get, Property Let, function or subroutine. + */ + var defaultMember = (asTypeDeclaration as ClassModuleDeclaration)?.DefaultMember; + if (defaultMember == null + || !IsPropertyGetLetFunctionProcedure(defaultMember) + || !IsPublic(defaultMember)) + { + ResolveArgumentList(null); + return CreateFailedExpression(lExpression); + } + + var defaultMemberClassification = DefaultMemberClassification(defaultMember); + + var parameters = ((IParameterizedDeclaration) defaultMember).Parameters.ToList(); + + switch (parameters.Count(param => !param.IsOptional)) + { + case 1 when Tokens.String.Equals(parameters.First(param => !param.IsOptional).AsTypeName, StringComparison.InvariantCultureIgnoreCase): + /* + This default member’s parameter list is compatible with . In this case, the + dictionary access expression references this default member and takes on its classification and + declared type. + */ + ResolveArgumentList(defaultMember); + return new DictionaryAccessExpression(defaultMember, defaultMemberClassification, _expression, lExpression, _argumentList); + case 0 when DEFAULT_MEMBER_RECURSION_LIMIT > _defaultMemberRecursionLimitCounter: + { + /* + This default member cannot accept any parameters. In this case, the static analysis restarts + recursively, as if this default member was specified instead for with the + same . + */ + _defaultMemberRecursionLimitCounter++; + + var defaultMemberAsLExpression = new SimpleNameExpression(defaultMember, defaultMemberClassification, _expression); + var defaultMemberAsTypeName = defaultMember.AsTypeName; + var defaultMemberAsTypeDeclaration = defaultMember.AsTypeDeclaration; + + return ResolveViaDefaultMember(defaultMemberAsLExpression, defaultMemberAsTypeName,defaultMemberAsTypeDeclaration); + } + } + + ResolveArgumentList(null); + return CreateFailedExpression(lExpression); + } + + private static bool IsPropertyGetLetFunctionProcedure(Declaration declaration) + { + var declarationType = declaration.DeclarationType; + return declarationType == DeclarationType.PropertyGet + || declarationType == DeclarationType.PropertyLet + || declarationType == DeclarationType.Function + || declarationType == DeclarationType.Procedure; + } + + private static bool IsPublic(Declaration declaration) + { + var accessibility = declaration.Accessibility; + return accessibility == Accessibility.Global + || accessibility == Accessibility.Implicit + || accessibility == Accessibility.Public; + } + + private ExpressionClassification DefaultMemberClassification(Declaration defaultMember) + { + if (defaultMember.DeclarationType.HasFlag(DeclarationType.Property)) + { + return ExpressionClassification.Property; + } + + if (defaultMember.DeclarationType == DeclarationType.Procedure) + { + return ExpressionClassification.Subroutine; + } + + return ExpressionClassification.Function; + } + } +} \ No newline at end of file diff --git a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs index 23dfddee24..941b7aafe4 100644 --- a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs +++ b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs @@ -7,10 +7,6 @@ namespace Rubberduck.Parsing.Binding { public sealed class IndexDefaultBinding : IExpressionBinding { - private readonly DeclarationFinder _declarationFinder; - private readonly Declaration _project; - private readonly Declaration _module; - private readonly Declaration _parent; private readonly ParserRuleContext _expression; private readonly IExpressionBinding _lExpressionBinding; private IBoundExpression _lExpression; @@ -20,18 +16,10 @@ public sealed class IndexDefaultBinding : IExpressionBinding private int _defaultMemberRecursionLimitCounter = 0; public IndexDefaultBinding( - DeclarationFinder declarationFinder, - Declaration project, - Declaration module, - Declaration parent, ParserRuleContext expression, IExpressionBinding lExpressionBinding, ArgumentList argumentList) : this( - declarationFinder, - project, - module, - parent, expression, (IBoundExpression)null, argumentList) @@ -40,18 +28,10 @@ public sealed class IndexDefaultBinding : IExpressionBinding } public IndexDefaultBinding( - DeclarationFinder declarationFinder, - Declaration project, - Declaration module, - Declaration parent, ParserRuleContext expression, IBoundExpression lExpression, ArgumentList argumentList) { - _declarationFinder = declarationFinder; - _project = project; - _module = module; - _parent = parent; _expression = expression; _lExpression = lExpression; _argumentList = argumentList; diff --git a/Rubberduck.Parsing/Binding/DefaultBindingContext.cs b/Rubberduck.Parsing/Binding/DefaultBindingContext.cs index 480d8a27c0..44ed1e11b9 100644 --- a/Rubberduck.Parsing/Binding/DefaultBindingContext.cs +++ b/Rubberduck.Parsing/Binding/DefaultBindingContext.cs @@ -60,13 +60,12 @@ private IExpressionBinding Visit(Declaration module, Declaration parent, VBAPars { return lExpressionBinding is IndexDefaultBinding indexDefaultBinding ? indexDefaultBinding - : new IndexDefaultBinding(_declarationFinder, Declaration.GetProjectParent(parent), module, parent, - expression.lExpression(), lExpressionBinding, new ArgumentList()); + : new IndexDefaultBinding(expression.lExpression(), lExpressionBinding, new ArgumentList()); } var argList = VisitArgumentList(module, parent, expression.argumentList(), withBlockVariable); SetLeftMatch(lExpressionBinding, argList.Arguments.Count); - return new IndexDefaultBinding(_declarationFinder, Declaration.GetProjectParent(parent), module, parent, expression.lExpression(), lExpressionBinding, argList); + return new IndexDefaultBinding(expression.lExpression(), lExpressionBinding, argList); } private static void SetLeftMatch(IExpressionBinding binding, int argumentCount) @@ -210,7 +209,7 @@ private IExpressionBinding Visit(Declaration module, Declaration parent, VBAPars var lExpressionBinding = Visit(module, parent, lExpression, withBlockVariable, StatementResolutionContext.Undefined); var argumentListBinding = VisitArgumentList(module, parent, expression.argumentList(), withBlockVariable); SetLeftMatch(lExpressionBinding, argumentListBinding.Arguments.Count); - return new IndexDefaultBinding(_declarationFinder, Declaration.GetProjectParent(parent), module, parent, expression, lExpressionBinding, argumentListBinding); + return new IndexDefaultBinding(expression, lExpressionBinding, argumentListBinding); } private IExpressionBinding Visit(Declaration module, Declaration parent, VBAParser.WhitespaceIndexExprContext expression, IBoundExpression withBlockVariable) @@ -219,7 +218,7 @@ private IExpressionBinding Visit(Declaration module, Declaration parent, VBAPars var lExpressionBinding = Visit(module, parent, lExpression, withBlockVariable, StatementResolutionContext.Undefined); var argumentListBinding = VisitArgumentList(module, parent, expression.argumentList(), withBlockVariable); SetLeftMatch(lExpressionBinding, argumentListBinding.Arguments.Count); - return new IndexDefaultBinding(_declarationFinder, Declaration.GetProjectParent(parent), module, parent, expression, lExpressionBinding, argumentListBinding); + return new IndexDefaultBinding(expression, lExpressionBinding, argumentListBinding); } private ArgumentList VisitArgumentList(Declaration module, Declaration parent, VBAParser.ArgumentListContext argumentList, IBoundExpression withBlockVariable) @@ -301,31 +300,35 @@ private IExpressionBinding Visit(Declaration module, Declaration parent, VBAPars { var lExpression = expression.lExpression(); var lExpressionBinding = Visit(module, parent, lExpression, withBlockVariable, StatementResolutionContext.Undefined); - return VisitDictionaryAccessExpression(module, parent, expression, expression.unrestrictedIdentifier(), lExpressionBinding); + return VisitDictionaryAccessExpression(expression, expression.unrestrictedIdentifier(), lExpressionBinding); } - private IExpressionBinding VisitDictionaryAccessExpression(Declaration module, Declaration parent, ParserRuleContext expression, ParserRuleContext nameContext, IExpressionBinding lExpressionBinding) + private IExpressionBinding VisitDictionaryAccessExpression(ParserRuleContext expression, ParserRuleContext nameContext, IExpressionBinding lExpressionBinding) { /* A dictionary access expression is syntactically translated into an index expression with the same expression for and an argument list with a single positional argument with a declared type of String and a value equal to the name value of . + + Still, we have a specific binding for it in order to attach a reference to the called default member to the exclamation mark. */ var fakeArgList = new ArgumentList(); fakeArgList.AddArgument(new ArgumentListArgument(new LiteralDefaultBinding(nameContext), ArgumentListArgumentType.Positional)); - return new IndexDefaultBinding(_declarationFinder, Declaration.GetProjectParent(parent), module, parent, expression, lExpressionBinding, fakeArgList); + return new DictionaryAccessDefaultBinding(expression, lExpressionBinding, fakeArgList); } - private IExpressionBinding VisitDictionaryAccessExpression(Declaration module, Declaration parent, ParserRuleContext expression, ParserRuleContext nameContext, IBoundExpression lExpression) + private IExpressionBinding VisitDictionaryAccessExpression(ParserRuleContext expression, ParserRuleContext nameContext, IBoundExpression lExpression) { /* A dictionary access expression is syntactically translated into an index expression with the same expression for and an argument list with a single positional argument with a declared type of String and a value equal to the name value of . + + Still, we have a specific binding for it in order to attach a reference to the called default member to the exclamation mark. */ var fakeArgList = new ArgumentList(); fakeArgList.AddArgument(new ArgumentListArgument(new LiteralDefaultBinding(nameContext), ArgumentListArgumentType.Positional)); - return new IndexDefaultBinding(_declarationFinder, Declaration.GetProjectParent(parent), module, parent, expression, lExpression, fakeArgList); + return new DictionaryAccessDefaultBinding(expression, lExpression, fakeArgList); } private IExpressionBinding Visit(Declaration module, Declaration parent, VBAParser.WithMemberAccessExprContext expression, IBoundExpression withBlockVariable, StatementResolutionContext statementContext) @@ -341,7 +344,7 @@ private IExpressionBinding Visit(Declaration module, Declaration parent, VBAPars the innermost enclosing With block variable was specified for . If there is no enclosing With block, the is invalid. */ - return VisitDictionaryAccessExpression(module, parent, expression, expression.unrestrictedIdentifier(), withBlockVariable); + return VisitDictionaryAccessExpression(expression, expression.unrestrictedIdentifier(), withBlockVariable); } private IExpressionBinding Visit(Declaration module, Declaration parent, VBAParser.ParenthesizedExprContext expression, IBoundExpression withBlockVariable) diff --git a/Rubberduck.Parsing/Binding/Expressions/DictionaryAccessExpression.cs b/Rubberduck.Parsing/Binding/Expressions/DictionaryAccessExpression.cs new file mode 100644 index 0000000000..b8669e67f7 --- /dev/null +++ b/Rubberduck.Parsing/Binding/Expressions/DictionaryAccessExpression.cs @@ -0,0 +1,37 @@ +using Antlr4.Runtime; +using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Symbols; + +namespace Rubberduck.Parsing.Binding +{ + public sealed class DictionaryAccessExpression : BoundExpression + { + public DictionaryAccessExpression( + Declaration referencedDeclaration, + ExpressionClassification classification, + ParserRuleContext context, + IBoundExpression lExpression, + ArgumentList argumentList) + : base(referencedDeclaration, classification, context) + { + LExpression = lExpression; + ArgumentList = argumentList; + } + + public IBoundExpression LExpression { get; } + public ArgumentList ArgumentList { get; } + + public ParserRuleContext DefaultMemberContext + { + get + { + if (Context is VBAParser.DictionaryAccessExprContext dictionaryAccess) + { + return dictionaryAccess.dictionaryAccess(); + } + + return ((VBAParser.WithDictionaryAccessExprContext) Context).dictionaryAccess(); + } + } + } +} \ No newline at end of file diff --git a/Rubberduck.Parsing/Binding/Expressions/IndexExpression.cs b/Rubberduck.Parsing/Binding/Expressions/IndexExpression.cs index befd9d274e..7c54eef28a 100644 --- a/Rubberduck.Parsing/Binding/Expressions/IndexExpression.cs +++ b/Rubberduck.Parsing/Binding/Expressions/IndexExpression.cs @@ -10,14 +10,20 @@ public sealed class IndexExpression : BoundExpression ExpressionClassification classification, ParserRuleContext context, IBoundExpression lExpression, - ArgumentList argumentList) + ArgumentList argumentList, + bool isArrayAccess = false, + bool isDefaultMemberAccess = false) : base(referencedDeclaration, classification, context) { LExpression = lExpression; ArgumentList = argumentList; + IsArrayAccess = isArrayAccess; + IsDefaultMemberAccess = isDefaultMemberAccess; } public IBoundExpression LExpression { get; } public ArgumentList ArgumentList { get; } + public bool IsArrayAccess { get; } + public bool IsDefaultMemberAccess { get; } } } diff --git a/Rubberduck.Parsing/Grammar/VBAParser.g4 b/Rubberduck.Parsing/Grammar/VBAParser.g4 index 5ad52a0b4e..0e4cfca99c 100644 --- a/Rubberduck.Parsing/Grammar/VBAParser.g4 +++ b/Rubberduck.Parsing/Grammar/VBAParser.g4 @@ -687,14 +687,17 @@ variantLiteralIdentifier : EMPTY | NULL; lExpression : lExpression LPAREN whiteSpace? argumentList? whiteSpace? RPAREN # indexExpr | lExpression mandatoryLineContinuation? DOT mandatoryLineContinuation? unrestrictedIdentifier # memberAccessExpr - | lExpression mandatoryLineContinuation? EXCLAMATIONPOINT mandatoryLineContinuation? unrestrictedIdentifier # dictionaryAccessExpr + | lExpression mandatoryLineContinuation? dictionaryAccess mandatoryLineContinuation? unrestrictedIdentifier # dictionaryAccessExpr | ME # instanceExpr | identifier # simpleNameExpr | DOT mandatoryLineContinuation? unrestrictedIdentifier # withMemberAccessExpr - | EXCLAMATIONPOINT mandatoryLineContinuation? unrestrictedIdentifier # withDictionaryAccessExpr + | dictionaryAccess mandatoryLineContinuation? unrestrictedIdentifier # withDictionaryAccessExpr | lExpression mandatoryLineContinuation whiteSpace? LPAREN whiteSpace? argumentList? whiteSpace? RPAREN # whitespaceIndexExpr ; +//This is a hack to allow attaching identifier references for default members to the exclaramtion mark. +dictionaryAccess : EXCLAMATIONPOINT; + // 3.3.5.3 Special Identifier Forms builtInType : baseType diff --git a/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs b/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs index 90384c429d..a16b3b52bb 100644 --- a/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs +++ b/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs @@ -193,18 +193,13 @@ private IEnumerable FindIdentifierAnnotations(QualifiedModuleName m } } - IParameterizedDeclaration defaultMember = null; - if (boundExpression.ReferencedDeclaration != null - && boundExpression.ReferencedDeclaration.DeclarationType != DeclarationType.Project - && boundExpression.ReferencedDeclaration.AsTypeDeclaration != null) + var reallyIsAssignmentTarget = isAssignmentTarget && isSetAssignment; + if (isAssignmentTarget && !isSetAssignment) { - var module = boundExpression.ReferencedDeclaration.AsTypeDeclaration; - var members = _declarationFinder.Members(module); - defaultMember = (IParameterizedDeclaration) members.FirstOrDefault(member => - member is IParameterizedDeclaration && member.Attributes.HasDefaultMemberAttribute() - && (isAssignmentTarget - ? member.DeclarationType.HasFlag(DeclarationType.Procedure) - : member.DeclarationType.HasFlag(DeclarationType.Function))); + var defaultMember = (boundExpression.ReferencedDeclaration?.AsTypeDeclaration as ClassModuleDeclaration)?.DefaultMember; + //This is a best guess; if the asType is Variant, we have no idea. + reallyIsAssignmentTarget = defaultMember == null + || ((IParameterizedDeclaration) defaultMember).Parameters.All(param => param.IsOptional); } _boundExpressionVisitor.AddIdentifierReferences( @@ -212,7 +207,7 @@ private IEnumerable FindIdentifierAnnotations(QualifiedModuleName m _qualifiedModuleName, _currentScope, _currentParent, - isAssignmentTarget && (defaultMember == null || isSetAssignment || defaultMember.Parameters.All(param => param.IsOptional)), + reallyIsAssignmentTarget, hasExplicitLetStatement, isSetAssignment); } diff --git a/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs b/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs index 0f6dfeec88..6dce8c71cc 100644 --- a/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs +++ b/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs @@ -69,6 +69,9 @@ public BoundExpressionVisitor(DeclarationFinder declarationFinder) case InstanceExpression instanceExpression: Visit(instanceExpression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); break; + case DictionaryAccessExpression dictionaryAccessExpression: + Visit(dictionaryAccessExpression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); + break; case TypeOfIsExpression typeOfIsExpression: Visit(typeOfIsExpression, module, scope, parent); break; @@ -186,23 +189,19 @@ private IEnumerable FindIdentifierAnnotations(QualifiedModuleName m && expression.ReferencedDeclaration != null && !ReferenceEquals(expression.LExpression.ReferencedDeclaration, expression.ReferencedDeclaration)) { - // Referenced declaration could also be null if e.g. it's an array and the array is a "base type" such as String. - if (expression.ReferencedDeclaration != null) - { - var callSiteContext = expression.LExpression.Context; - var identifier = expression.LExpression.Context.GetText(); - var callee = expression.ReferencedDeclaration; - expression.ReferencedDeclaration.AddReference( - module, - scope, - parent, - callSiteContext, - identifier, - callee, - callSiteContext.GetSelection(), - FindIdentifierAnnotations(module, callSiteContext.GetSelection().StartLine), - isSetAssignment); - } + var callSiteContext = expression.LExpression.Context; + var identifier = expression.LExpression.Context.GetText(); + var callee = expression.ReferencedDeclaration; + expression.ReferencedDeclaration.AddReference( + module, + scope, + parent, + callSiteContext, + identifier, + callee, + callSiteContext.GetSelection(), + FindIdentifierAnnotations(module, callSiteContext.GetSelection().StartLine), + isSetAssignment); } // Argument List not affected by being unbound. foreach (var argument in expression.ArgumentList.Arguments) @@ -218,6 +217,45 @@ private IEnumerable FindIdentifierAnnotations(QualifiedModuleName m } } + private void Visit( + DictionaryAccessExpression expression, + QualifiedModuleName module, + Declaration scope, + Declaration parent, + bool isAssignmentTarget, + bool hasExplicitLetStatement, + bool isSetAssignment) + { + Visit(expression.LExpression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); + + if (expression.Classification != ExpressionClassification.Unbound + && expression.ReferencedDeclaration != null) + { + var callSiteContext = expression.DefaultMemberContext; + var identifier = expression.ReferencedDeclaration.IdentifierName; + var callee = expression.ReferencedDeclaration; + expression.ReferencedDeclaration.AddReference( + module, + scope, + parent, + callSiteContext, + identifier, + callee, + callSiteContext.GetSelection(), + FindIdentifierAnnotations(module, callSiteContext.GetSelection().StartLine), + isSetAssignment); + } + // Argument List not affected by being unbound. + foreach (var argument in expression.ArgumentList.Arguments) + { + if (argument.Expression != null) + { + Visit(argument.Expression, module, scope, parent); + } + //Dictionary access arguments cannot be named. + } + } + private void Visit( NewExpression expression, QualifiedModuleName module, diff --git a/RubberduckTests/Grammar/ResolverTests.cs b/RubberduckTests/Grammar/ResolverTests.cs index 79697c89be..ec10e62dfd 100644 --- a/RubberduckTests/Grammar/ResolverTests.cs +++ b/RubberduckTests/Grammar/ResolverTests.cs @@ -18,7 +18,12 @@ public class ResolverTests private RubberduckParserState Resolve(string code, bool loadStdLib = false, ComponentType moduleType = ComponentType.StandardModule) { var vbe = MockVbeBuilder.BuildFromSingleModule(code, moduleType, out var component, Selection.Empty, loadStdLib); - var parser = MockParser.Create(vbe.Object); + return Resolve(vbe.Object); + } + + private RubberduckParserState Resolve(IVBE vbe) + { + var parser = MockParser.Create(vbe); var state = parser.State; parser.Parse(new CancellationTokenSource()); @@ -47,20 +52,7 @@ private RubberduckParserState Resolve(params string[] classes) builder.AddProject(project); var vbe = builder.Build(); - var parser = MockParser.Create(vbe.Object); - var state = parser.State; - parser.Parse(new CancellationTokenSource()); - - if (state.Status == ParserState.ResolverError) - { - Assert.Fail("Parser state should be 'Ready', but returns '{0}'.", state.Status); - } - if (state.Status != ParserState.Ready) - { - Assert.Inconclusive("Parser state should be 'Ready', but returns '{0}'.", state.Status); - } - - return state; + return Resolve(vbe.Object); } private RubberduckParserState Resolve(params Tuple[] components) @@ -75,20 +67,8 @@ private RubberduckParserState Resolve(params Tuple[] comp var project = projectBuilder.Build(); builder.AddProject(project); var vbe = builder.Build(); - var parser = MockParser.Create(vbe.Object); - var state = parser.State; - parser.Parse(new CancellationTokenSource()); - - if (state.Status == ParserState.ResolverError) - { - Assert.Fail("Parser state should be 'Ready', but returns '{0}'.", state.Status); - } - if (state.Status != ParserState.Ready) - { - Assert.Inconclusive("Parser state should be 'Ready', but returns '{0}'.", state.Status); - } - return state; + return Resolve(vbe.Object); } [Category("Grammar")] @@ -3002,5 +2982,170 @@ End Sub Assert.AreEqual(expectedDescription, actualDescription); } } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void DictionaryAccessExpressionHasReferenceToDefaultMemberAtExclamationMark() + { + var classCode = @" +Public Function Foo(bar As String) As Class1 +Attribute Foo.VB_UserMemId = 0 + Set Foo = New Class1 +End Function +"; + + var moduleCode = @" +Private Function Foo() As Class1 + Dim cls As new Class1 + Set Foo = cls!newClassObject +End Function +"; + + var vbe = MockVbeBuilder.BuildFromModules( + ("Class1", classCode, ComponentType.ClassModule), + ("Module1", moduleCode, ComponentType.StandardModule)); + + var selection = new Selection(4, 18, 4, 19); + + using (var state = Resolve(vbe.Object)) + { + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "Module1"); + var qualifiedSelection = new QualifiedSelection(module, selection); + var reference = state.DeclarationFinder.IdentifierReferences(qualifiedSelection).First(); + var referencedDeclaration = reference.Declaration; + + var expectedReferencedDeclarationName = "Class1.Foo"; + var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; + + Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + } + } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void ChainedDictionaryAccessExpressionHasReferenceToDefaultMemberAtExclamationMark() + { + var classCode = @" +Public Function Foo(bar As String) As Class1 +Attribute Foo.VB_UserMemId = 0 + Set Foo = New Class1 +End Function +"; + + var moduleCode = @" +Private Function Foo() As Class1 + Dim cls As new Class1 + Set Foo = cls!newClassObject!whatever +End Function +"; + + var vbe = MockVbeBuilder.BuildFromModules( + ("Class1", classCode, ComponentType.ClassModule), + ("Module1", moduleCode, ComponentType.StandardModule)); + + var selection = new Selection(4, 33, 4, 34); + + using (var state = Resolve(vbe.Object)) + { + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "Module1"); + var qualifiedSelection = new QualifiedSelection(module, selection); + var reference = state.DeclarationFinder.IdentifierReferences(qualifiedSelection).First(); + var referencedDeclaration = reference.Declaration; + + var expectedReferencedDeclarationName = "Class1.Foo"; + var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; + + Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + } + } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void RecursiveDictionaryAccessExpressionHasReferenceToFinalDefaultMemberAtExclamationMark() + { + var classCode = @" +Public Function Foo(bar As String) As Class1 +Attribute Foo.VB_UserMemId = 0 + Set Foo = New Class1 +End Function +"; + + var otherClassCode = @" +Public Function Baz() As Class1 +Attribute Baz.VB_UserMemId = 0 + Set Baz = New Class1 +End Function +"; + + var moduleCode = @" +Private Function Foo() As Class1 + Dim cls As new Class2 + Set Foo = cls!newClassObject +End Function +"; + + var vbe = MockVbeBuilder.BuildFromModules( + ("Class1", classCode, ComponentType.ClassModule), + ("Class2", otherClassCode, ComponentType.ClassModule), + ("Module1", moduleCode, ComponentType.StandardModule)); + + var selection = new Selection(4, 18, 4, 19); + + using (var state = Resolve(vbe.Object)) + { + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "Module1"); + var qualifiedSelection = new QualifiedSelection(module, selection); + var reference = state.DeclarationFinder.IdentifierReferences(qualifiedSelection).First(); + var referencedDeclaration = reference.Declaration; + + var expectedReferencedDeclarationName = "Class1.Foo"; + var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; + + Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + } + } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void WithDictionaryAccessExpressionHasReferenceToDefaultMemberAtExclamationMark() + { + var classCode = @" +Public Function Foo(bar As String) As Class1 +Attribute Foo.VB_UserMemId = 0 + Set Foo = New Class1 +End Function +"; + + var moduleCode = @" +Private Function Foo() As Class1 + With New Class1 + Set Foo = !newClassObject + End With +End Function +"; + + var vbe = MockVbeBuilder.BuildFromModules( + ("Class1", classCode, ComponentType.ClassModule), + ("Module1", moduleCode, ComponentType.StandardModule)); + + var selection = new Selection(4, 19, 4, 20); + + using (var state = Resolve(vbe.Object)) + { + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "Module1"); + var qualifiedSelection = new QualifiedSelection(module, selection); + var reference = state.DeclarationFinder.IdentifierReferences(qualifiedSelection).First(); + var referencedDeclaration = reference.Declaration; + + var expectedReferencedDeclarationName = "Class1.Foo"; + var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; + + Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + } + } } } From d9e66798b9a4d1fbb21af49507be2d7284dbd195 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Thu, 8 Aug 2019 01:13:10 +0200 Subject: [PATCH 08/22] Fix #5069 --- .../Symbols/IdentifierReferenceResolver.cs | 21 +++++++++++++++---- RubberduckTests/Grammar/ResolverTests.cs | 20 ++++++++++++++++++ 2 files changed, 37 insertions(+), 4 deletions(-) diff --git a/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs b/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs index a16b3b52bb..8a994d2c70 100644 --- a/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs +++ b/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs @@ -257,12 +257,25 @@ public void Resolve(VBAParser.RedimStmtContext context) { // We treat redim statements as index expressions to make it SLL. var lExpr = ((VBAParser.LExprContext)redimVariableDeclaration.expression()).lExpression(); - var indexExpr = (VBAParser.IndexExprContext)lExpr; - // The lexpression is the array that is being resized. + + VBAParser.LExpressionContext indexedExpression; + VBAParser.ArgumentListContext argumentList; + if (lExpr is VBAParser.IndexExprContext indexExpr) + { + indexedExpression = indexExpr.lExpression(); + argumentList = indexExpr.argumentList(); + } + else + { + var whitespaceIndexExpr = (VBAParser.WhitespaceIndexExprContext) lExpr; + indexedExpression = whitespaceIndexExpr.lExpression(); + argumentList = whitespaceIndexExpr.argumentList(); + + } + // The indexedExpression is the array that is being resized. // We can't treat it as a normal index expression because the semantics are different. // It's not actually a function call but a special statement. - ResolveDefault(indexExpr.lExpression()); - var argumentList = indexExpr.argumentList(); + ResolveDefault(indexedExpression); if (argumentList.argument() != null) { foreach (var positionalArgument in argumentList.argument()) diff --git a/RubberduckTests/Grammar/ResolverTests.cs b/RubberduckTests/Grammar/ResolverTests.cs index ec10e62dfd..5cc3fa54f9 100644 --- a/RubberduckTests/Grammar/ResolverTests.cs +++ b/RubberduckTests/Grammar/ResolverTests.cs @@ -3147,5 +3147,25 @@ End Function Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); } } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + //See issue #5069 at https://github.com/rubberduck-vba/Rubberduck/issues/5069 + public void LineContinuedReDimResolvesSuccessfully() + { + var moduleCode = @" +Private Function Foo() As Class1 + Dim arr() As String + ReDim arr _ + (0 To 1) +End Function +"; + + using (var state = Resolve(moduleCode)) + { + //This test only tests that we do not get a resolver error. + } + } } } From 57fd753103101a551c9cd2f5906f7c4c8c8f0c6d Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Thu, 8 Aug 2019 19:00:28 +0200 Subject: [PATCH 09/22] Fix resolution of dictionary access expression for default members with compatible parameter list with only optional arguments --- .../DictionaryAccessDefaultBinding.cs | 34 +++++++++++-------- 1 file changed, 20 insertions(+), 14 deletions(-) diff --git a/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs index 61c409010d..8be1060a72 100644 --- a/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs +++ b/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs @@ -128,31 +128,37 @@ private IBoundExpression ResolveViaDefaultMember(IBoundExpression lExpression, s var parameters = ((IParameterizedDeclaration) defaultMember).Parameters.ToList(); - switch (parameters.Count(param => !param.IsOptional)) + if (parameters.Count > 0 + && parameters.Count(param => !param.IsOptional) <= 1 + && Tokens.String.Equals(parameters[0].AsTypeName, StringComparison.InvariantCultureIgnoreCase)) { - case 1 when Tokens.String.Equals(parameters.First(param => !param.IsOptional).AsTypeName, StringComparison.InvariantCultureIgnoreCase): - /* + /* This default member’s parameter list is compatible with . In this case, the dictionary access expression references this default member and takes on its classification and declared type. */ - ResolveArgumentList(defaultMember); - return new DictionaryAccessExpression(defaultMember, defaultMemberClassification, _expression, lExpression, _argumentList); - case 0 when DEFAULT_MEMBER_RECURSION_LIMIT > _defaultMemberRecursionLimitCounter: - { - /* + ResolveArgumentList(defaultMember); + return new DictionaryAccessExpression(defaultMember, defaultMemberClassification, _expression, + lExpression, _argumentList); + } + + if (parameters.Count(param => !param.IsOptional) == 0 + && DEFAULT_MEMBER_RECURSION_LIMIT > _defaultMemberRecursionLimitCounter) + { + /* This default member cannot accept any parameters. In this case, the static analysis restarts recursively, as if this default member was specified instead for with the same . */ - _defaultMemberRecursionLimitCounter++; + _defaultMemberRecursionLimitCounter++; - var defaultMemberAsLExpression = new SimpleNameExpression(defaultMember, defaultMemberClassification, _expression); - var defaultMemberAsTypeName = defaultMember.AsTypeName; - var defaultMemberAsTypeDeclaration = defaultMember.AsTypeDeclaration; + var defaultMemberAsLExpression = + new SimpleNameExpression(defaultMember, defaultMemberClassification, _expression); + var defaultMemberAsTypeName = defaultMember.AsTypeName; + var defaultMemberAsTypeDeclaration = defaultMember.AsTypeDeclaration; - return ResolveViaDefaultMember(defaultMemberAsLExpression, defaultMemberAsTypeName,defaultMemberAsTypeDeclaration); - } + return ResolveViaDefaultMember(defaultMemberAsLExpression, defaultMemberAsTypeName, + defaultMemberAsTypeDeclaration); } ResolveArgumentList(null); From 44d53c29bb6e9055fb840c894b9191ffc6c38629 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Fri, 9 Aug 2019 00:12:51 +0200 Subject: [PATCH 10/22] Add support for (with) dictionary access expressions to the Set type resolver --- .../TypeResolvers/SetTypeResolver.cs | 13 +- .../BoundExpressionVisitor.cs | 8 +- .../SetTypeResolverTests.cs | 186 ++++++++++++++++++ 3 files changed, 201 insertions(+), 6 deletions(-) diff --git a/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs index b4927314a2..84837d84eb 100644 --- a/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs +++ b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs @@ -151,9 +151,9 @@ private static string FullObjectTypeName(Declaration setTypeDeterminingDeclarati case VBAParser.WithMemberAccessExprContext withMemberAccessExpression: return SetTypeDeterminingDeclarationOfExpression(withMemberAccessExpression.unrestrictedIdentifier(), containingModule, finder); case VBAParser.DictionaryAccessExprContext dictionaryAccessExpression: - throw new NotImplementedException(); + return SetTypeDeterminingDeclarationOfExpression(dictionaryAccessExpression.dictionaryAccess(), containingModule, finder); case VBAParser.WithDictionaryAccessExprContext withDictionaryAccessExpression: - throw new NotImplementedException(); + return SetTypeDeterminingDeclarationOfExpression(withDictionaryAccessExpression.dictionaryAccess(), containingModule, finder); case VBAParser.WhitespaceIndexExprContext whitespaceIndexExpression: throw new NotImplementedException(); default: @@ -177,6 +177,15 @@ private static string FullObjectTypeName(Declaration setTypeDeterminingDeclarati return (declaration, MightHaveSetType(declaration)); } + private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfExpression(VBAParser.DictionaryAccessContext dictionaryAccess, QualifiedModuleName containingModule, DeclarationFinder finder) + { + var qualifiedSelection = new QualifiedSelection(containingModule, dictionaryAccess.GetSelection()); + var declaration = finder.IdentifierReferences(qualifiedSelection) + .Select(reference => reference.Declaration) + .FirstOrDefault(); + return (declaration, MightHaveSetType(declaration)); + } + private static bool MightHaveSetType(Declaration declaration) { return declaration == null diff --git a/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs b/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs index 6dce8c71cc..6594ac2cd0 100644 --- a/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs +++ b/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs @@ -48,8 +48,8 @@ public BoundExpressionVisitor(DeclarationFinder declarationFinder) case MemberAccessExpression memberAccessExpression: Visit(memberAccessExpression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); break; - case IndexExpression failedExpression: - Visit(failedExpression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); + case IndexExpression indexExpression: + Visit(indexExpression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); break; case ParenthesizedExpression parenthesizedExpression: Visit(parenthesizedExpression, module, scope, parent); @@ -63,8 +63,8 @@ public BoundExpressionVisitor(DeclarationFinder declarationFinder) case UnaryOpExpression unaryOpExpression: Visit(unaryOpExpression, module, scope, parent); break; - case NewExpression failedExpression: - Visit(failedExpression, module, scope, parent); + case NewExpression newExpression: + Visit(newExpression, module, scope, parent); break; case InstanceExpression instanceExpression: Visit(instanceExpression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); diff --git a/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs index 1cab18f223..75b12c63fe 100644 --- a/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs +++ b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs @@ -611,6 +611,192 @@ End Sub Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); } + [Test] + [Category("ExpressionResolver")] + [TestCase("Object", "Object", null)] + [TestCase("Class1", "Object", "Object")] + [TestCase("Variant", "Variant", null)] + [TestCase("Class1", "Variant", "Variant")] + [TestCase("Object", "Class1", null)] + [TestCase("Variant", "Class1", null)] + [TestCase("Class1", "Class1", "TestProject.Class1")] + [TestCase("Class1", "Long", SetTypeResolver.NotAnObject)] + [TestCase("Object", "Long", null)] + [TestCase("Variant", "Long", null)] + public void DictionaryAccessExpression_SetTypeNameTests(string accessedTypeName, string typeName, string expectedSetTypeName) + { + var class1 = + $@" +Public Function Foo(baz As String) As {typeName} +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var module1 = + $@" +Private Sub Bar() + Dim cls As {accessedTypeName} + Dim baz As Variant + Set baz = cls!whatever +End Sub +"; + + var expressionSelection = new Selection(5, 15, 5, 27); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Module1", expressionSelection); + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Object", "Object", null)] + [TestCase("Class1", "Object", null)] + [TestCase("Variant", "Variant", null)] + [TestCase("Class1", "Variant", null)] + [TestCase("Object", "Class1", null)] + [TestCase("Variant", "Class1", null)] + [TestCase("Class1", "Class1", "TestProject.Class1")] + [TestCase("Class1", "Long", null)] + [TestCase("Object", "Long", null)] + [TestCase("Variant", "Long", null)] + public void DictionaryAccessExpression_SetTypeDeclarationTests(string accessedTypeName, string typeName, string expectedNameOfSetTypeDeclaration) + { + var class1 = + $@" +Public Function Foo(baz As String) As {typeName} +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var module1 = + $@" +Private Sub Bar() + Dim cls As {accessedTypeName} + Dim baz As Variant + Set baz = cls!whatever +End Sub +"; + + var expressionSelection = new Selection(5, 15, 5, 27); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Module1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Object", "Object", null)] + [TestCase("Class1", "Object", "Object")] + [TestCase("Variant", "Variant", null)] + [TestCase("Class1", "Variant", "Variant")] + [TestCase("Object", "Class1", null)] + [TestCase("Variant", "Class1", null)] + [TestCase("Class1", "Class1", "TestProject.Class1")] + [TestCase("Class1", "Long", SetTypeResolver.NotAnObject)] + [TestCase("Object", "Long", null)] + [TestCase("Variant", "Long", null)] + public void WithDictionaryAccessExpression_SetTypeNameTests(string accessedTypeName, string typeName, string expectedSetTypeName) + { + var class1 = + $@" +Public Function Foo(baz As String) As {typeName} +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var module1 = + $@" +Private Sub Bar() + Dim cls As {accessedTypeName} + Dim baz As Variant + With cls + Set baz = !whatever + End With +End Sub +"; + + var expressionSelection = new Selection(6, 19, 6, 28); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Module1", expressionSelection); + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Object", "Object", null)] + [TestCase("Class1", "Object", null)] + [TestCase("Variant", "Variant", null)] + [TestCase("Class1", "Variant", null)] + [TestCase("Object", "Class1", null)] + [TestCase("Variant", "Class1", null)] + [TestCase("Class1", "Class1", "TestProject.Class1")] + [TestCase("Class1", "Long", null)] + [TestCase("Object", "Long", null)] + [TestCase("Variant", "Long", null)] + public void WithDictionaryAccessExpression_SetTypeDeclarationTests(string accessedTypeName, string typeName, string expectedNameOfSetTypeDeclaration) + { + var class1 = + $@" +Public Function Foo(baz As String) As {typeName} +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var module1 = + $@" +Private Sub Bar() + Dim cls As {accessedTypeName} + Dim baz As Variant + With cls + Set baz = !whatever + End With +End Sub +"; + + var expressionSelection = new Selection(6, 19, 6, 28); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Module1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } + private Declaration ExpressionTypeDeclaration(IVBE vbe, string componentName, Selection selection) { using (var state = MockParser.CreateAndParse(vbe)) From 8148307d3640f2d39f74c76a33a376478757487f Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Sat, 10 Aug 2019 02:30:24 +0200 Subject: [PATCH 11/22] Add IsDefaultMemberAccess to IdentifierReference Also cleans up NonReturningFunctionInspection and makes Selection honor the contract of IComparable. --- .../Concrete/MissingAttributeInspection.cs | 4 +- .../NonReturningFunctionInspection.cs | 33 +++++---- .../DictionaryAccessDefaultBinding.cs | 3 +- .../Binding/Bindings/IndexDefaultBinding.cs | 7 +- Rubberduck.Parsing/Symbols/Declaration.cs | 6 +- .../Symbols/IdentifierReference.cs | 6 +- .../DeclarationCaching/DeclarationFinder.cs | 20 ++++++ .../BoundExpressionVisitor.cs | 8 ++- Rubberduck.VBEEditor/Selection.cs | 37 +++++++--- RubberduckTests/Grammar/ResolverTests.cs | 72 +++++++++++++++++++ 10 files changed, 162 insertions(+), 34 deletions(-) diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/MissingAttributeInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/MissingAttributeInspection.cs index 9ca9b41cc1..a740fe1aca 100644 --- a/Rubberduck.CodeAnalysis/Inspections/Concrete/MissingAttributeInspection.cs +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/MissingAttributeInspection.cs @@ -1,6 +1,7 @@ using System.Collections.Generic; using System.Linq; using Rubberduck.Inspections.Abstract; +using Rubberduck.Inspections.Inspections.Extensions; using Rubberduck.Inspections.Results; using Rubberduck.Parsing; using Rubberduck.Parsing.Annotations; @@ -49,7 +50,8 @@ protected override IEnumerable DoGetInspectionResults() var declarationsWithAttributeAnnotations = State.DeclarationFinder.AllUserDeclarations .Where(declaration => declaration.Annotations.Any(annotation => annotation.AnnotationType.HasFlag(AnnotationType.Attribute))); var results = new List(); - foreach (var declaration in declarationsWithAttributeAnnotations.Where(decl => decl.QualifiedModuleName.ComponentType != ComponentType.Document)) + foreach (var declaration in declarationsWithAttributeAnnotations.Where(decl => decl.QualifiedModuleName.ComponentType != ComponentType.Document + && !decl.IsIgnoringInspectionResultFor(AnnotationName))) { foreach(var annotation in declaration.Annotations.OfType()) { diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/NonReturningFunctionInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/NonReturningFunctionInspection.cs index 33fa285b3f..8f9eb6a14d 100644 --- a/Rubberduck.CodeAnalysis/Inspections/Concrete/NonReturningFunctionInspection.cs +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/NonReturningFunctionInspection.cs @@ -1,6 +1,7 @@ using System.Collections.Generic; using System.Linq; using Rubberduck.Inspections.Abstract; +using Rubberduck.Inspections.Inspections.Extensions; using Rubberduck.Inspections.Results; using Rubberduck.Parsing; using Rubberduck.Parsing.Grammar; @@ -8,6 +9,7 @@ using Rubberduck.Resources.Inspections; using Rubberduck.Parsing.Symbols; using Rubberduck.Parsing.VBA; +using Rubberduck.Parsing.VBA.Extensions; namespace Rubberduck.Inspections.Concrete { @@ -48,30 +50,31 @@ public NonReturningFunctionInspection(RubberduckParserState state) protected override IEnumerable DoGetInspectionResults() { - var declarations = UserDeclarations.ToList(); + var interfaceMembers = State.DeclarationFinder.FindAllInterfaceMembers().ToHashSet(); - var interfaceMembers = State.DeclarationFinder.FindAllInterfaceMembers(); + var functions = State.DeclarationFinder.UserDeclarations(DeclarationType.Function) + .Where(declaration => !interfaceMembers.Contains(declaration)); - var functions = declarations - .Where(declaration => ReturningMemberTypes.Contains(declaration.DeclarationType) - && !interfaceMembers.Contains(declaration)).ToList(); - - var unassigned = (from function in functions - let isUdt = IsReturningUserDefinedType(function) - let inScopeRefs = function.References.Where(r => r.ParentScoping.Equals(function)) - where (!isUdt && (!inScopeRefs.Any(r => r.IsAssignment) && - !inScopeRefs.Any(reference => IsAssignedByRefArgument(function, reference)))) - || (isUdt && !IsUserDefinedTypeAssigned(function)) - select function) - .ToList(); + var unassigned = functions.Where(function => IsReturningUserDefinedType(function) + && !IsUserDefinedTypeAssigned(function) + || !IsReturningUserDefinedType(function) + && !IsAssigned(function)); return unassigned + .Where(declaration => !declaration.IsIgnoringInspectionResultFor(AnnotationName)) .Select(issue => new DeclarationInspectionResult(this, string.Format(InspectionResults.NonReturningFunctionInspection, issue.IdentifierName), issue)); } + private bool IsAssigned(Declaration function) + { + var inScopeIdentifierReferences = function.References.Where(r => r.ParentScoping.Equals(function)); + return inScopeIdentifierReferences.Any(reference => reference.IsAssignment + || IsAssignedByRefArgument(function, reference)); + } + private bool IsAssignedByRefArgument(Declaration enclosingProcedure, IdentifierReference reference) { var argExpression = reference.Context.GetAncestor(); @@ -83,7 +86,7 @@ private bool IsAssignedByRefArgument(Declaration enclosingProcedure, IdentifierR && parameter.References.Any(r => r.IsAssignment); } - private bool IsReturningUserDefinedType(Declaration member) + private static bool IsReturningUserDefinedType(Declaration member) { return member.AsTypeDeclaration != null && member.AsTypeDeclaration.DeclarationType == DeclarationType.UserDefinedType; diff --git a/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs index 8be1060a72..5da942a8ab 100644 --- a/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs +++ b/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs @@ -130,7 +130,8 @@ private IBoundExpression ResolveViaDefaultMember(IBoundExpression lExpression, s if (parameters.Count > 0 && parameters.Count(param => !param.IsOptional) <= 1 - && Tokens.String.Equals(parameters[0].AsTypeName, StringComparison.InvariantCultureIgnoreCase)) + && (Tokens.String.Equals(parameters[0].AsTypeName, StringComparison.InvariantCultureIgnoreCase) + || Tokens.Variant.Equals(parameters[0].AsTypeName, StringComparison.InvariantCultureIgnoreCase))) { /* This default member’s parameter list is compatible with . In this case, the diff --git a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs index 941b7aafe4..fc2551c226 100644 --- a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs +++ b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs @@ -203,9 +203,12 @@ declared type. TODO: Primitive argument compatibility checking for now. */ - if (((IParameterizedDeclaration)defaultMember).Parameters.Count() == _argumentList.Arguments.Count) + var parameters = ((IParameterizedDeclaration) defaultMember).Parameters.ToList(); + if ((parameters.Count >= _argumentList.Arguments.Count + || parameters.Any(parameter => parameter.IsParamArray)) + && parameters.Count(parameter => !parameter.IsOptional) <= _argumentList.Arguments.Count) { - return new IndexExpression(defaultMember, lExpression.Classification, _expression, lExpression, _argumentList); + return new IndexExpression(defaultMember, lExpression.Classification, _expression, _lExpression, _argumentList, isDefaultMemberAccess: true); } /** diff --git a/Rubberduck.Parsing/Symbols/Declaration.cs b/Rubberduck.Parsing/Symbols/Declaration.cs index 86f2d42e9a..dd08ead365 100644 --- a/Rubberduck.Parsing/Symbols/Declaration.cs +++ b/Rubberduck.Parsing/Symbols/Declaration.cs @@ -359,7 +359,8 @@ public virtual bool IsObject IEnumerable annotations, bool isAssignmentTarget = false, bool hasExplicitLetStatement = false, - bool isSetAssigned = false + bool isSetAssigned = false, + bool isDefaultMemberAccess = false ) { var oldReference = _references.FirstOrDefault(r => @@ -386,7 +387,8 @@ public virtual bool IsObject isAssignmentTarget, hasExplicitLetStatement, annotations, - isSetAssigned); + isSetAssigned, + isDefaultMemberAccess); _references.AddOrUpdate(newReference, 1, (key, value) => 1); } diff --git a/Rubberduck.Parsing/Symbols/IdentifierReference.cs b/Rubberduck.Parsing/Symbols/IdentifierReference.cs index bf6e4b4174..ecf9361fcd 100644 --- a/Rubberduck.Parsing/Symbols/IdentifierReference.cs +++ b/Rubberduck.Parsing/Symbols/IdentifierReference.cs @@ -23,7 +23,8 @@ public class IdentifierReference : IEquatable bool isAssignmentTarget = false, bool hasExplicitLetStatement = false, IEnumerable annotations = null, - bool isSetAssigned = false) + bool isSetAssigned = false, + bool isDefaultMemberAccess = false) { ParentScoping = parentScopingDeclaration; ParentNonScoping = parentNonScopingDeclaration; @@ -35,6 +36,7 @@ public class IdentifierReference : IEquatable HasExplicitLetStatement = hasExplicitLetStatement; IsAssignment = isAssignmentTarget; IsSetAssignment = isSetAssigned; + IsDefaultMemberAccess = isDefaultMemberAccess; Annotations = annotations ?? new List(); } @@ -60,6 +62,8 @@ public class IdentifierReference : IEquatable public bool IsSetAssignment { get; } + public bool IsDefaultMemberAccess { get; } + public ParserRuleContext Context { get; } public Declaration Declaration { get; } diff --git a/Rubberduck.Parsing/VBA/DeclarationCaching/DeclarationFinder.cs b/Rubberduck.Parsing/VBA/DeclarationCaching/DeclarationFinder.cs index 08e2bc54e3..acca6cba9f 100644 --- a/Rubberduck.Parsing/VBA/DeclarationCaching/DeclarationFinder.cs +++ b/Rubberduck.Parsing/VBA/DeclarationCaching/DeclarationFinder.cs @@ -1423,6 +1423,26 @@ public IEnumerable IdentifierReferences(QualifiedSelection : Enumerable.Empty(); } + /// + /// Gets all identifier references within a qualified selection, ordered by selection (start position, then length) + /// + public IEnumerable ContainedIdentifierReferences(QualifiedSelection qualifiedSelection) + { + return IdentifierReferences(qualifiedSelection.QualifiedName) + .Where(reference => qualifiedSelection.Selection.Contains(reference.Selection)) + .OrderBy(reference => reference.Selection); + } + + /// + /// Gets all identifier references containing a qualified selection, ordered by selection (start position, then length) + /// + public IEnumerable ContainingIdentifierReferences(QualifiedSelection qualifiedSelection) + { + return IdentifierReferences(qualifiedSelection.QualifiedName) + .Where(reference => reference.Selection.Contains(qualifiedSelection.Selection)) + .OrderBy(reference => reference.Selection); + } + /// /// Gets all identifier references in the specified member. /// diff --git a/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs b/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs index 6594ac2cd0..7cb57d5ad0 100644 --- a/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs +++ b/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs @@ -1,6 +1,7 @@ using System; using System.Collections.Generic; using System.Linq; +using Antlr4.Runtime; using Rubberduck.Parsing.Annotations; using Rubberduck.Parsing.Binding; using Rubberduck.Parsing.Grammar; @@ -185,6 +186,7 @@ private IEnumerable FindIdentifierAnnotations(QualifiedModuleName m // add an identifier reference to, that's why we pass on the isassignment/hasexplicitletstatement values. Visit(expression.LExpression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); + //Generate reference in case this is a default member access. if (expression.Classification != ExpressionClassification.Unbound && expression.ReferencedDeclaration != null && !ReferenceEquals(expression.LExpression.ReferencedDeclaration, expression.ReferencedDeclaration)) @@ -201,7 +203,8 @@ private IEnumerable FindIdentifierAnnotations(QualifiedModuleName m callee, callSiteContext.GetSelection(), FindIdentifierAnnotations(module, callSiteContext.GetSelection().StartLine), - isSetAssignment); + isSetAssignment, + isDefaultMemberAccess: true); } // Argument List not affected by being unbound. foreach (var argument in expression.ArgumentList.Arguments) @@ -243,7 +246,8 @@ private IEnumerable FindIdentifierAnnotations(QualifiedModuleName m callee, callSiteContext.GetSelection(), FindIdentifierAnnotations(module, callSiteContext.GetSelection().StartLine), - isSetAssignment); + isSetAssignment, + isDefaultMemberAccess: true); } // Argument List not affected by being unbound. foreach (var argument in expression.ArgumentList.Arguments) diff --git a/Rubberduck.VBEEditor/Selection.cs b/Rubberduck.VBEEditor/Selection.cs index 1923b39726..ff5af5bcae 100644 --- a/Rubberduck.VBEEditor/Selection.cs +++ b/Rubberduck.VBEEditor/Selection.cs @@ -102,10 +102,13 @@ public Selection Offset(Selection offset) public bool Equals(Selection other) { - return other.StartLine == StartLine - && other.EndLine == EndLine - && other.StartColumn == StartColumn - && other.EndColumn == EndColumn; + return IsSamePosition(other.StartLine, other.StartColumn, StartLine, StartColumn) + && IsSamePosition(other.EndLine, other.EndColumn, EndLine, EndColumn); + } + + private static bool IsSamePosition(int line1, int column1, int line2, int column2) + { + return line1 == line2 && column1 == column2; } public int CompareTo(Selection other) @@ -141,16 +144,30 @@ public override string ToString() public static bool operator >(Selection selection1, Selection selection2) { - return selection1.StartLine > selection2.StartLine || - selection1.StartLine == selection2.StartLine && - selection1.StartColumn > selection2.StartColumn; + return IsGreaterPosition(selection1.StartLine, selection1.StartColumn, selection2.StartLine, selection2.StartColumn) + || IsSamePosition(selection1.StartLine, selection1.StartColumn, selection2.StartLine, selection2.StartColumn) + && IsGreaterPosition(selection1.EndLine, selection1.EndColumn, selection2.EndLine, selection2.EndColumn); + } + + private static bool IsGreaterPosition(int line1, int column1, int line2, int column2) + { + return line1 > line2 + || line1 == line2 + && column1 > column2; } public static bool operator <(Selection selection1, Selection selection2) { - return selection1.StartLine < selection2.StartLine || - selection1.StartLine == selection2.StartLine && - selection1.StartColumn < selection2.StartColumn; + return IsLesserPosition(selection1.StartLine, selection1.StartColumn, selection2.StartLine, selection2.StartColumn) + || IsSamePosition(selection1.StartLine, selection1.StartColumn, selection2.StartLine, selection2.StartColumn) + && IsLesserPosition(selection1.EndLine, selection1.EndColumn, selection2.EndLine, selection2.EndColumn); + } + + private static bool IsLesserPosition(int line1, int column1, int line2, int column2) + { + return line1 < line2 + || line1 == line2 + && column1 < column2; } public static bool operator >=(Selection selection1, Selection selection2) diff --git a/RubberduckTests/Grammar/ResolverTests.cs b/RubberduckTests/Grammar/ResolverTests.cs index 5cc3fa54f9..3d39695f16 100644 --- a/RubberduckTests/Grammar/ResolverTests.cs +++ b/RubberduckTests/Grammar/ResolverTests.cs @@ -3019,6 +3019,7 @@ End Function var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + Assert.IsTrue(reference.IsDefaultMemberAccess); } } @@ -3058,6 +3059,7 @@ End Function var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + Assert.IsTrue(reference.IsDefaultMemberAccess); } } @@ -3105,6 +3107,7 @@ End Function var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + Assert.IsTrue(reference.IsDefaultMemberAccess); } } @@ -3145,6 +3148,7 @@ End Function var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + Assert.IsTrue(reference.IsDefaultMemberAccess); } } @@ -3167,5 +3171,73 @@ End Function //This test only tests that we do not get a resolver error. } } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void IndexExpressionOnMemberAccessYieldsCorrectIdentifierReference() + { + var code = @" +Public Function Foo(baz As String) As String +End Function + +Public Function Bar() As String + Bar = Foo(""Barrier"") +End Function +"; + var selection = new Selection(6, 11, 6, 14); + + using (var state = Resolve(code)) + { + var module = state.DeclarationFinder.UserDeclarations(DeclarationType.ProceduralModule).Single().QualifiedModuleName; + var qualifiedSelection = new QualifiedSelection(module, selection); + var reference = state.DeclarationFinder.IdentifierReferences(qualifiedSelection).First(); + + var expectedIdentifierName = "Foo"; + var actualIdentifierName = reference.IdentifierName; + Assert.AreEqual(expectedIdentifierName, actualIdentifierName); + } + } + + + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void IndexExpressionWithDefaultMemberAccessHasReferenceToDefaultMember() + { + var classCode = @" +Public Function Foo(index As Long) As String +Attribute Foo.VB_UserMemId = 0 + Set Foo = ""Hello"" +End Function +"; + + var moduleCode = @" +Private Function Foo() As String + Dim cls As new Class1 + Foo = cls(0) +End Function +"; + + var vbe = MockVbeBuilder.BuildFromModules( + ("Class1", classCode, ComponentType.ClassModule), + ("Module1", moduleCode, ComponentType.StandardModule)); + + var selection = new Selection(4, 13, 4, 13); + + using (var state = Resolve(vbe.Object)) + { + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "Module1"); + var qualifiedSelection = new QualifiedSelection(module, selection); + var defaultMamberReference = state.DeclarationFinder.ContainingIdentifierReferences(qualifiedSelection).Last(reference => reference.IsDefaultMemberAccess); + var referencedDeclaration = defaultMamberReference.Declaration; + + var expectedReferencedDeclarationName = "Class1.Foo"; + var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; + + Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + } + } } } From d46f190e075158b9270a8c9056c12f3334500ad7 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Sat, 10 Aug 2019 14:12:49 +0200 Subject: [PATCH 12/22] Add support for index expressions to SetTypeResolver --- .../Binding/Bindings/IndexDefaultBinding.cs | 41 +- .../TypeResolvers/SetTypeResolver.cs | 82 +++- .../SetTypeResolverTests.cs | 433 ++++++++++++++++++ 3 files changed, 539 insertions(+), 17 deletions(-) diff --git a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs index fc2551c226..c0d5866099 100644 --- a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs +++ b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs @@ -1,6 +1,8 @@ -using Antlr4.Runtime; +using System; +using Antlr4.Runtime; using Rubberduck.Parsing.Symbols; using System.Linq; +using Rubberduck.Parsing.Grammar; using Rubberduck.Parsing.VBA.DeclarationCaching; namespace Rubberduck.Parsing.Binding @@ -171,11 +173,11 @@ private IBoundExpression ResolveDefaultMember(IBoundExpression lExpression, stri a declared type of Variant, referencing with no member name. */ if ( - asTypeName != null - && (asTypeName.ToUpperInvariant() == "VARIANT" || asTypeName.ToUpperInvariant() == "OBJECT") + (Tokens.Variant.Equals(asTypeName, StringComparison.InvariantCultureIgnoreCase) + || Tokens.Object.Equals(asTypeName, StringComparison.InvariantCultureIgnoreCase)) && !_argumentList.HasNamedArguments) { - return new IndexExpression(null, ExpressionClassification.Unbound, _expression, lExpression, _argumentList); + return new IndexExpression(null, ExpressionClassification.Unbound, _expression, lExpression, _argumentList, isDefaultMemberAccess: true); } /* The declared type of is a specific class, which has a public default Property @@ -184,16 +186,8 @@ private IBoundExpression ResolveDefaultMember(IBoundExpression lExpression, stri if (asTypeDeclaration is ClassModuleDeclaration classModule && classModule.DefaultMember is Declaration defaultMember) { - bool isPropertyGetLetFunctionProcedure = - defaultMember.DeclarationType == DeclarationType.PropertyGet - || defaultMember.DeclarationType == DeclarationType.PropertyLet - || defaultMember.DeclarationType == DeclarationType.Function - || defaultMember.DeclarationType == DeclarationType.Procedure; - bool isPublic = - defaultMember.Accessibility == Accessibility.Global - || defaultMember.Accessibility == Accessibility.Implicit - || defaultMember.Accessibility == Accessibility.Public; - if (isPropertyGetLetFunctionProcedure && isPublic) + if (IsPropertyGetLetFunctionProcedure(defaultMember) + && IsPublic(defaultMember)) { /* @@ -216,7 +210,7 @@ declared type. recursively, as if this default member was specified instead for with the same . */ - if (((IParameterizedDeclaration)defaultMember).Parameters.Count() == 0) + if (parameters.Count(parameter => !parameter.IsOptional) == 0) { // Recursion limit reached, abort. if (DEFAULT_MEMBER_RECURSION_LIMIT == _defaultMemberRecursionLimitCounter) @@ -245,6 +239,23 @@ declared type. return null; } + private static bool IsPropertyGetLetFunctionProcedure(Declaration declaration) + { + var declarationType = declaration.DeclarationType; + return declarationType == DeclarationType.PropertyGet + || declarationType == DeclarationType.PropertyLet + || declarationType == DeclarationType.Function + || declarationType == DeclarationType.Procedure; + } + + private static bool IsPublic(Declaration declaration) + { + var accessibility = declaration.Accessibility; + return accessibility == Accessibility.Global + || accessibility == Accessibility.Implicit + || accessibility == Accessibility.Public; + } + private IBoundExpression ResolveLExpressionDeclaredTypeIsArray(IBoundExpression lExpression, Declaration asTypeDeclaration) { /* diff --git a/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs index 84837d84eb..60ecc6ec34 100644 --- a/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs +++ b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs @@ -145,7 +145,7 @@ private static string FullObjectTypeName(Declaration setTypeDeterminingDeclarati case VBAParser.InstanceExprContext instanceExpression: return SetTypeDeterminingDeclarationOfInstance(containingModule, finder); case VBAParser.IndexExprContext indexExpression: - throw new NotImplementedException(); + return SetTypeDeterminingDeclarationOfIndexExpression(indexExpression.lExpression(), containingModule, finder); case VBAParser.MemberAccessExprContext memberAccessExpression: return SetTypeDeterminingDeclarationOfExpression(memberAccessExpression.unrestrictedIdentifier(), containingModule, finder); case VBAParser.WithMemberAccessExprContext withMemberAccessExpression: @@ -155,12 +155,66 @@ private static string FullObjectTypeName(Declaration setTypeDeterminingDeclarati case VBAParser.WithDictionaryAccessExprContext withDictionaryAccessExpression: return SetTypeDeterminingDeclarationOfExpression(withDictionaryAccessExpression.dictionaryAccess(), containingModule, finder); case VBAParser.WhitespaceIndexExprContext whitespaceIndexExpression: - throw new NotImplementedException(); + return SetTypeDeterminingDeclarationOfIndexExpression(whitespaceIndexExpression.lExpression(), containingModule, finder); default: return (null, true); //We should already cover every case. Return the value indicating that we have no idea. } } + private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfIndexExpression(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) + { + var declaration = ResolveIndexExpressionAsMethod(lExpression, containingModule, finder) + ?? ResolveIndexExpressionAsDefaultMemberAccess(lExpression, containingModule, finder); + + if (declaration != null) + { + return (declaration, MightHaveSetType(declaration)); + } + + return ResolveIndexExpressionAsArrayAccess(lExpression, containingModule, finder); + } + + private Declaration ResolveIndexExpressionAsMethod(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) + { + //For functions and properties, the identifier will be at the end of the lExpression. + var qualifiedSelection = new QualifiedSelection(containingModule, lExpression.GetSelection().Collapse()); + var candidate = finder + .ContainingIdentifierReferences(qualifiedSelection) + .LastOrDefault() + ?.Declaration; + return candidate?.DeclarationType.HasFlag(DeclarationType.Member) ?? false + ? candidate + : null; + } + + private (Declaration declaration, bool mightHaveSetType) ResolveIndexExpressionAsArrayAccess(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) + { + var (potentialArrayDeclaration, lExpressionMightHaveSetType) = SetTypeDeterminingDeclarationOfExpression(lExpression, containingModule, finder); + + if (potentialArrayDeclaration == null) + { + return (null, lExpressionMightHaveSetType); + } + + if (!potentialArrayDeclaration.IsArray) + { + //This is not an array access. So, we have no idea. + return (null, true); + } + + return (potentialArrayDeclaration, MightHaveSetTypeOnArrayAccess(potentialArrayDeclaration)); + } + + private Declaration ResolveIndexExpressionAsDefaultMemberAccess(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) + { + // A default member access references the entire lExpression. + var qualifiedSelection = new QualifiedSelection(containingModule, lExpression.GetSelection()); + return finder + .IdentifierReferences(qualifiedSelection) + .FirstOrDefault(reference => reference.IsDefaultMemberAccess) + ?.Declaration; + } + private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfExpression(VBAParser.IdentifierContext identifier, QualifiedModuleName containingModule, DeclarationFinder finder) { var declaration = finder.IdentifierReferences(identifier, containingModule) @@ -194,6 +248,30 @@ private static bool MightHaveSetType(Declaration declaration) || declaration.DeclarationType.HasFlag(DeclarationType.ClassModule); } + private static bool MightHaveSetTypeOnArrayAccess(Declaration declaration) + { + return declaration == null + || IsObjectArray(declaration) + || declaration.AsTypeName == Tokens.Variant; + } + + private static bool IsObjectArray(Declaration declaration) + { + if (!declaration.IsArray) + { + return false; + } + + if (declaration.AsTypeName == Tokens.Object || + (declaration.AsTypeDeclaration?.DeclarationType.HasFlag(DeclarationType.ClassModule) ?? false)) + { + return true; + } + + return false; + } + + private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfInstance(QualifiedModuleName instance, DeclarationFinder finder) { var classDeclaration = finder.Classes.FirstOrDefault(cls => cls.QualifiedModuleName.Equals(instance)); diff --git a/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs index 75b12c63fe..869e79baf3 100644 --- a/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs +++ b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs @@ -797,6 +797,439 @@ End Sub Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); } + [Test] + [Category("ExpressionResolver")] + [TestCase("Object", "Object", null)] + [TestCase("Class1", "Object", "Object")] + [TestCase("Variant", "Variant", null)] + [TestCase("Class1", "Variant", "Variant")] + [TestCase("Object", "Class1", null)] + [TestCase("Variant", "Class1", null)] + [TestCase("Class1", "Class1", "TestProject.Class1")] + [TestCase("Class1", "Long", SetTypeResolver.NotAnObject)] + [TestCase("Object", "Long", null)] + [TestCase("Variant", "Long", null)] + public void DefaultMemberIndexExpression_SetTypeNameTests(string accessedTypeName, string typeName, string expectedSetTypeName) + { + var class1 = + $@" +Public Function Foo(baz As Long) As {typeName} +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var module1 = + $@" +Private Sub Bar() + Dim cls As {accessedTypeName} + Dim baz As Variant + Set baz = cls(42) +End Sub +"; + + var expressionSelection = new Selection(5, 15, 5, 22); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Module1", expressionSelection); + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Object", "Object", null)] + [TestCase("Class1", "Object", null)] + [TestCase("Variant", "Variant", null)] + [TestCase("Class1", "Variant", null)] + [TestCase("Object", "Class1", null)] + [TestCase("Variant", "Class1", null)] + [TestCase("Class1", "Class1", "TestProject.Class1")] + [TestCase("Class1", "Long", null)] + [TestCase("Object", "Long", null)] + [TestCase("Variant", "Long", null)] + public void DefaultMemberIndexExpression_SetTypeDeclarationTests(string accessedTypeName, string typeName, string expectedNameOfSetTypeDeclaration) + { + var class1 = + $@" +Public Function Foo(baz As Long) As {typeName} +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var module1 = + $@" +Private Sub Bar() + Dim cls As {accessedTypeName} + Dim baz As Variant + Set baz = cls(42) +End Sub +"; + + var expressionSelection = new Selection(5, 15, 5, 22); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Module1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Object", "Object")] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("Variant", "Variant")] + [TestCase("Long", SetTypeResolver.NotAnObject)] + public void FunctionIndexExpression_SetTypeNameTests(string typeName, string expectedSetTypeName) + { + var class1 = + @" +Public Function Foo(baz As Long) As Variant +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var module1 = + $@" +Private Sub Bar() + Dim baz As Variant + Set baz = Foo(42) +End Sub + +Private Function Foo(baz As Long) As {typeName} +End Function +"; + + var expressionSelection = new Selection(4, 15, 4, 22); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Module1", expressionSelection); + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + [Category("ExpressionResolver")] + [TestCase("Object", null)] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("Variant", null)] + [TestCase("Long", null)] + public void FunctionIndexExpression_SetTypeDeclarationTests(string typeName, string expectedNameOfSetTypeDeclaration) + { + var class1 = + @" +Public Function Foo(baz As Long) As Variant +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var module1 = + $@" +Private Sub Bar() + Dim baz As Variant + Set baz = Foo(42) +End Sub + +Private Function Foo(baz As Long) As {typeName} +End Function +"; + + var expressionSelection = new Selection(4, 15, 4, 22); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Module1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Object", "Object")] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("Variant", "Variant")] + [TestCase("Long", SetTypeResolver.NotAnObject)] + public void ArrayIndexExpression_SetTypeNameTests(string typeName, string expectedSetTypeName) + { + var class1 = + @" +Public Function Foo(baz As Long) As Variant +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var module1 = + $@" +Private Sub Bar() + Dim arr(0 To 123) As {typeName} + Dim baz As Variant + Set baz = arr(42) +End Sub +"; + + var expressionSelection = new Selection(5, 15, 5, 22); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Module1", expressionSelection); + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + [Category("ExpressionResolver")] + [TestCase("Object", null)] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("Variant", null)] + [TestCase("Long", null)] + public void ArrayIndexExpression_SetTypeDeclarationTests(string typeName, string expectedNameOfSetTypeDeclaration) + { + var class1 = + @" +Public Function Foo(baz As Long) As Variant +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var module1 = + $@" +Private Sub Bar() + Dim arr(0 To 123) As {typeName} + Dim baz As Variant + Set baz = arr(42) +End Sub +"; + + var expressionSelection = new Selection(5, 15, 5, 22); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Module1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Object", "Object", null)] + [TestCase("Class1", "Object", "Object")] + [TestCase("Variant", "Variant", null)] + [TestCase("Class1", "Variant", "Variant")] + [TestCase("Object", "Class1", null)] + [TestCase("Variant", "Class1", null)] + [TestCase("Class1", "Class1", "TestProject.Class1")] + [TestCase("Class1", "Long", SetTypeResolver.NotAnObject)] + [TestCase("Object", "Long", null)] + [TestCase("Variant", "Long", null)] + public void DefaultMemberWhitespaceIndexExpression_SetTypeNameTests(string accessedTypeName, string typeName, string expectedSetTypeName) + { + var class1 = + $@" +Public Function Foo(baz As Long) As {typeName} +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var module1 = + $@" +Private Sub Bar() + Dim cls As {accessedTypeName} + Dim baz As Variant + Set baz = cls _ + (42) +End Sub +"; + + var expressionSelection = new Selection(5, 15, 6, 6); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Module1", expressionSelection); + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Object", "Object", null)] + [TestCase("Class1", "Object", null)] + [TestCase("Variant", "Variant", null)] + [TestCase("Class1", "Variant", null)] + [TestCase("Object", "Class1", null)] + [TestCase("Variant", "Class1", null)] + [TestCase("Class1", "Class1", "TestProject.Class1")] + [TestCase("Class1", "Long", null)] + [TestCase("Object", "Long", null)] + [TestCase("Variant", "Long", null)] + public void DefaultMemberWhitespaceIndexExpression_SetTypeDeclarationTests(string accessedTypeName, string typeName, string expectedNameOfSetTypeDeclaration) + { + var class1 = + $@" +Public Function Foo(baz As Long) As {typeName} +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var module1 = + $@" +Private Sub Bar() + Dim cls As {accessedTypeName} + Dim baz As Variant + Set baz = cls _ + (42) +End Sub +"; + + var expressionSelection = new Selection(5, 15, 6, 6); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Module1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Object", "Object")] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("Variant", "Variant")] + [TestCase("Long", SetTypeResolver.NotAnObject)] + public void FunctionWhitespaceIndexExpression_SetTypeNameTests(string typeName, string expectedSetTypeName) + { + var class1 = + @" +Public Function Foo(baz As Long) As Variant +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var module1 = + $@" +Private Sub Bar() + Dim baz As Variant + Set baz = Foo _ + (42) +End Sub + +Private Function Foo(baz As Long) As {typeName} +End Function +"; + + var expressionSelection = new Selection(4, 15, 5, 6); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var actualSetTypeName = ExpressionTypeName(vbe, "Module1", expressionSelection); + + Assert.AreEqual(expectedSetTypeName, actualSetTypeName); + } + + [Test] + [Category("ExpressionResolver")] + [Category("ExpressionResolver")] + [TestCase("Object", null)] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("Variant", null)] + [TestCase("Long", null)] + public void FunctionWhitespaceIndexExpression_SetTypeDeclarationTests(string typeName, string expectedNameOfSetTypeDeclaration) + { + var class1 = + @" +Public Function Foo(baz As Long) As Variant +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var module1 = + $@" +Private Sub Bar() + Dim baz As Variant + Set baz = Foo(42) +End Sub + +Private Function Foo(baz As Long) As {typeName} +End Function +"; + + var expressionSelection = new Selection(4, 15, 4, 22); + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeDeclaration = ExpressionTypeDeclaration(vbe, "Module1", expressionSelection); + var actualNameOfSetTypeDeclaration = setTypeDeclaration?.QualifiedModuleName.ToString(); + + Assert.AreEqual(expectedNameOfSetTypeDeclaration, actualNameOfSetTypeDeclaration); + } + private Declaration ExpressionTypeDeclaration(IVBE vbe, string componentName, Selection selection) { using (var state = MockParser.CreateAndParse(vbe)) From d0241434524bd235673eb577c621d575879119c4 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Tue, 13 Aug 2019 01:52:06 +0200 Subject: [PATCH 13/22] Introduce references for array accesses These reference the entire index expression and have the new flag IsArrayAccess set to true. To resolve everything correctly, the entire IndexDefaultBinding got an overhaul. Also replaces the tests of ImplicitDefaultMemberAssignmentInspection since they previously only passed because the resolution of the assignment target was wrong. --- .../DictionaryAccessDefaultBinding.cs | 46 +-- .../Binding/Bindings/IndexDefaultBinding.cs | 304 ++++++++++-------- Rubberduck.Parsing/Symbols/Declaration.cs | 17 +- .../Symbols/IdentifierReference.cs | 6 +- .../Symbols/IdentifierReferenceResolver.cs | 5 +- .../TypeResolvers/SetTypeResolver.cs | 87 +++-- .../BoundExpressionVisitor.cs | 110 +++++-- RubberduckTests/Grammar/ResolverTests.cs | 75 ++++- ...tDefaultMemberAssignmentInspectionTests.cs | 147 +++++---- 9 files changed, 471 insertions(+), 326 deletions(-) diff --git a/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs index 5da942a8ab..8382ceb50c 100644 --- a/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs +++ b/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs @@ -1,10 +1,9 @@ using System; +using System.Collections.Generic; using Rubberduck.Parsing.Symbols; using System.Linq; using Antlr4.Runtime; -using Antlr4.Runtime.Atn; using Rubberduck.Parsing.Grammar; -using Rubberduck.Parsing.VBA.DeclarationCaching; namespace Rubberduck.Parsing.Binding { @@ -16,7 +15,6 @@ public sealed class DictionaryAccessDefaultBinding : IExpressionBinding private readonly ArgumentList _argumentList; private const int DEFAULT_MEMBER_RECURSION_LIMIT = 32; - private int _defaultMemberRecursionLimitCounter = 0; public DictionaryAccessDefaultBinding( ParserRuleContext expression, @@ -97,7 +95,7 @@ private IBoundExpression CreateFailedExpression(IBoundExpression lExpression) return failedExpr; } - private IBoundExpression ResolveViaDefaultMember(IBoundExpression lExpression, string asTypeName, Declaration asTypeDeclaration) + private IBoundExpression ResolveViaDefaultMember(IBoundExpression lExpression, string asTypeName, Declaration asTypeDeclaration, int recursionDepth = 0) { if (Tokens.Variant.Equals(asTypeName, StringComparison.InvariantCultureIgnoreCase) || Tokens.Object.Equals(asTypeName, StringComparison.InvariantCultureIgnoreCase)) @@ -128,10 +126,7 @@ private IBoundExpression ResolveViaDefaultMember(IBoundExpression lExpression, s var parameters = ((IParameterizedDeclaration) defaultMember).Parameters.ToList(); - if (parameters.Count > 0 - && parameters.Count(param => !param.IsOptional) <= 1 - && (Tokens.String.Equals(parameters[0].AsTypeName, StringComparison.InvariantCultureIgnoreCase) - || Tokens.Variant.Equals(parameters[0].AsTypeName, StringComparison.InvariantCultureIgnoreCase))) + if (IsCompatibleWithOneStringArgument(parameters)) { /* This default member’s parameter list is compatible with . In this case, the @@ -139,33 +134,46 @@ private IBoundExpression ResolveViaDefaultMember(IBoundExpression lExpression, s declared type. */ ResolveArgumentList(defaultMember); - return new DictionaryAccessExpression(defaultMember, defaultMemberClassification, _expression, - lExpression, _argumentList); + return new DictionaryAccessExpression(defaultMember, defaultMemberClassification, _expression, lExpression, _argumentList); } if (parameters.Count(param => !param.IsOptional) == 0 - && DEFAULT_MEMBER_RECURSION_LIMIT > _defaultMemberRecursionLimitCounter) + && DEFAULT_MEMBER_RECURSION_LIMIT > recursionDepth) { /* This default member cannot accept any parameters. In this case, the static analysis restarts recursively, as if this default member was specified instead for with the same . */ - _defaultMemberRecursionLimitCounter++; - var defaultMemberAsLExpression = - new SimpleNameExpression(defaultMember, defaultMemberClassification, _expression); - var defaultMemberAsTypeName = defaultMember.AsTypeName; - var defaultMemberAsTypeDeclaration = defaultMember.AsTypeDeclaration; - - return ResolveViaDefaultMember(defaultMemberAsLExpression, defaultMemberAsTypeName, - defaultMemberAsTypeDeclaration); + return ResolveRecursiveDefaultMember(defaultMember, defaultMemberClassification, recursionDepth); } ResolveArgumentList(null); return CreateFailedExpression(lExpression); } + private static bool IsCompatibleWithOneStringArgument(List parameters) + { + return parameters.Count > 0 + && parameters.Count(param => !param.IsOptional) <= 1 + && (Tokens.String.Equals(parameters[0].AsTypeName, StringComparison.InvariantCultureIgnoreCase) + || Tokens.Variant.Equals(parameters[0].AsTypeName, StringComparison.InvariantCultureIgnoreCase)); + } + + private IBoundExpression ResolveRecursiveDefaultMember(Declaration defaultMember, ExpressionClassification defaultMemberClassification, int recursionDepth) + { + var defaultMemberAsLExpression = new SimpleNameExpression(defaultMember, defaultMemberClassification, _expression); + var defaultMemberAsTypeName = defaultMember.AsTypeName; + var defaultMemberAsTypeDeclaration = defaultMember.AsTypeDeclaration; + + return ResolveViaDefaultMember( + defaultMemberAsLExpression, + defaultMemberAsTypeName, + defaultMemberAsTypeDeclaration, + recursionDepth + 1); + } + private static bool IsPropertyGetLetFunctionProcedure(Declaration declaration) { var declarationType = declaration.DeclarationType; diff --git a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs index c0d5866099..20f616d714 100644 --- a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs +++ b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs @@ -1,9 +1,9 @@ using System; +using System.Collections.Generic; using Antlr4.Runtime; using Rubberduck.Parsing.Symbols; using System.Linq; using Rubberduck.Parsing.Grammar; -using Rubberduck.Parsing.VBA.DeclarationCaching; namespace Rubberduck.Parsing.Binding { @@ -15,7 +15,6 @@ public sealed class IndexDefaultBinding : IExpressionBinding private readonly ArgumentList _argumentList; private const int DEFAULT_MEMBER_RECURSION_LIMIT = 32; - private int _defaultMemberRecursionLimitCounter = 0; public IndexDefaultBinding( ParserRuleContext expression, @@ -64,33 +63,46 @@ public IBoundExpression Resolve() return Resolve(_lExpression); } - private IBoundExpression Resolve(IBoundExpression lExpression) + private IBoundExpression Resolve(IBoundExpression lExpression, int defaultMemberResolutionRecursionDepth = 0) { - IBoundExpression boundExpression = null; if (lExpression.Classification == ExpressionClassification.ResolutionFailed) { return CreateFailedExpression(lExpression); } - boundExpression = ResolveLExpressionIsVariablePropertyFunctionNoParameters(lExpression); - if (boundExpression != null) + + if (lExpression.Classification == ExpressionClassification.Unbound) { - return boundExpression; + return ResolveLExpressionIsUnbound(lExpression); } - boundExpression = ResolveLExpressionIsIndexExpression(lExpression); - if (boundExpression != null) + + if (lExpression is IndexExpression indexExpression + && _argumentList.HasArguments + && lExpression.ReferencedDeclaration != null) { - return boundExpression; + var doubleIndexExpression = ResolveLExpressionIsIndexExpression(indexExpression, defaultMemberResolutionRecursionDepth); + if (doubleIndexExpression != null) + { + return doubleIndexExpression; + } } - boundExpression = ResolveLExpressionIsPropertyFunctionSubroutine(lExpression); - if (boundExpression != null) + + if (IsVariablePropertyFunctionWithoutParameters(lExpression) + && lExpression.ReferencedDeclaration != null) { - return boundExpression; + var parameterlessLExpressionAccess = ResolveLExpressionIsVariablePropertyFunctionNoParameters(lExpression, defaultMemberResolutionRecursionDepth); + if (parameterlessLExpressionAccess != null) + { + return parameterlessLExpressionAccess; + } } - boundExpression = ResolveLExpressionIsUnbound(lExpression); - if (boundExpression != null) + + if (lExpression.Classification == ExpressionClassification.Property + || lExpression.Classification == ExpressionClassification.Function + || lExpression.Classification == ExpressionClassification.Subroutine) { - return boundExpression; + return ResolveLExpressionIsPropertyFunctionSubroutine(lExpression); } + return CreateFailedExpression(lExpression); } @@ -105,68 +117,76 @@ private IBoundExpression CreateFailedExpression(IBoundExpression lExpression) return failedExpr; } - private IBoundExpression ResolveLExpressionIsVariablePropertyFunctionNoParameters(IBoundExpression lExpression) + private IBoundExpression ResolveLExpressionIsVariablePropertyFunctionNoParameters(IBoundExpression lExpression, int defaultMemberResolutionRecursionDepth) { /* - is classified as a variable, or is classified as a property or function - with a parameter list that cannot accept any parameters and an that is not - empty, and one of the following is true (see below): + is classified as a variable, or is classified as a property or function + with a parameter list that cannot accept any parameters and an that is not + empty, and one of the following is true (see below): + + There are no parameters to the lExpression. So, this is either an array access or a default member call. */ - bool isVariable = lExpression.Classification == ExpressionClassification.Variable; - bool propertyWithoutParameters = lExpression.Classification == ExpressionClassification.Property && !((IParameterizedDeclaration)lExpression.ReferencedDeclaration).Parameters.Any(); - bool functionWithoutParameters = lExpression.Classification == ExpressionClassification.Function && !((IParameterizedDeclaration)lExpression.ReferencedDeclaration).Parameters.Any(); - if (lExpression.ReferencedDeclaration != null && (isVariable || ((propertyWithoutParameters || functionWithoutParameters) && _argumentList.HasArguments))) + + var indexedDeclaration = lExpression.ReferencedDeclaration; + if (indexedDeclaration == null) { - IBoundExpression boundExpression = null; - var asTypeName = lExpression.ReferencedDeclaration.AsTypeName; - var asTypeDeclaration = lExpression.ReferencedDeclaration.AsTypeDeclaration; - boundExpression = ResolveDefaultMember(lExpression, asTypeName, asTypeDeclaration); - if (boundExpression != null) - { - return boundExpression; - } - boundExpression = ResolveLExpressionDeclaredTypeIsArray(lExpression, asTypeDeclaration); - if (boundExpression != null) - { - return boundExpression; - } - return boundExpression; + return null; + } + + if (indexedDeclaration.IsArray) + { + return ResolveLExpressionDeclaredTypeIsArray(lExpression); + } + + var asTypeName = indexedDeclaration.AsTypeName; + var asTypeDeclaration = indexedDeclaration.AsTypeDeclaration; + + return ResolveDefaultMember(lExpression, asTypeName, asTypeDeclaration, defaultMemberResolutionRecursionDepth); + } + + private static bool IsVariablePropertyFunctionWithoutParameters(IBoundExpression lExpression) + { + switch(lExpression.Classification) + { + case ExpressionClassification.Variable: + return true; + case ExpressionClassification.Function: + case ExpressionClassification.Property: + return !((IParameterizedDeclaration)lExpression.ReferencedDeclaration).Parameters.Any(); + default: + return false; } - return null; } - private IBoundExpression ResolveLExpressionIsIndexExpression(IBoundExpression lExpression) + private IBoundExpression ResolveLExpressionIsIndexExpression(IndexExpression indexExpression, int defaultMemberResolutionRecursionDepth = 0) { /* is classified as an index expression and the argument list is not empty. Thus, me must be dealing with a default member access or an array access. */ - if (lExpression is IndexExpression && _argumentList.HasArguments && lExpression.ReferencedDeclaration != null) + + var indexedDeclaration = indexExpression.ReferencedDeclaration; + if (indexedDeclaration == null) { - IBoundExpression boundExpression = null; - var asTypeName = lExpression.ReferencedDeclaration.AsTypeName; - var asTypeDeclaration = lExpression.ReferencedDeclaration.AsTypeDeclaration; - boundExpression = ResolveDefaultMember(lExpression, asTypeName, asTypeDeclaration); - if (boundExpression != null) - { - return boundExpression; - } - boundExpression = ResolveLExpressionDeclaredTypeIsArray(lExpression, asTypeDeclaration); - if (boundExpression != null) - { - return boundExpression; - } - return boundExpression; + return null; } - return null; - } - private IBoundExpression ResolveDefaultMember(IBoundExpression lExpression, string asTypeName, Declaration asTypeDeclaration) - { - if (lExpression.ReferencedDeclaration.IsArray) + //The result of an array access is never an array. Any double array access requires either a default member access in between + //or an array assigned to a Variant, the access to which is counted as an unbound member access and, thus, is resolved correctly + //via the default member path. + if (indexedDeclaration.IsArray && !indexExpression.IsArrayAccess) { - return null; + return ResolveLExpressionDeclaredTypeIsArray(indexExpression); } + + var asTypeName = indexedDeclaration.AsTypeName; + var asTypeDeclaration = indexedDeclaration.AsTypeDeclaration; + + return ResolveDefaultMember(indexExpression, asTypeName, asTypeDeclaration, defaultMemberResolutionRecursionDepth); + } + + private IBoundExpression ResolveDefaultMember(IBoundExpression lExpression, string asTypeName, Declaration asTypeDeclaration, int defaultMemberResolutionRecursionDepth) + { /* The declared type of is Object or Variant, and contains no named arguments. In this case, the index expression is classified as an unbound member with @@ -184,61 +204,68 @@ private IBoundExpression ResolveDefaultMember(IBoundExpression lExpression, stri Get, Property Let, function or subroutine, and one of the following is true: */ if (asTypeDeclaration is ClassModuleDeclaration classModule - && classModule.DefaultMember is Declaration defaultMember) + && classModule.DefaultMember is Declaration defaultMember + && IsPropertyGetLetFunctionProcedure(defaultMember) + && IsPublic(defaultMember)) { - if (IsPropertyGetLetFunctionProcedure(defaultMember) - && IsPublic(defaultMember)) + var defaultMemberClassification = DefaultMemberExpressionClassification(defaultMember); + + /* + This default member’s parameter list is compatible with . In this case, the + index expression references this default member and takes on its classification and + declared type. + + TODO: Improve argument compatibility check. + */ + var parameters = ((IParameterizedDeclaration) defaultMember).Parameters.ToList(); + if (ArgumentListIsCompatible(parameters, _argumentList)) { + return new IndexExpression(defaultMember, defaultMemberClassification, _expression, _lExpression, _argumentList, isDefaultMemberAccess: true); + } - /* - This default member’s parameter list is compatible with . In this case, the - index expression references this default member and takes on its classification and - declared type. - - TODO: Primitive argument compatibility checking for now. - */ - var parameters = ((IParameterizedDeclaration) defaultMember).Parameters.ToList(); - if ((parameters.Count >= _argumentList.Arguments.Count - || parameters.Any(parameter => parameter.IsParamArray)) - && parameters.Count(parameter => !parameter.IsOptional) <= _argumentList.Arguments.Count) - { - return new IndexExpression(defaultMember, lExpression.Classification, _expression, _lExpression, _argumentList, isDefaultMemberAccess: true); - } - - /** - This default member cannot accept any parameters. In this case, the static analysis restarts - recursively, as if this default member was specified instead for with the - same . - */ - if (parameters.Count(parameter => !parameter.IsOptional) == 0) - { - // Recursion limit reached, abort. - if (DEFAULT_MEMBER_RECURSION_LIMIT == _defaultMemberRecursionLimitCounter) - { - return null; - } - _defaultMemberRecursionLimitCounter++; - ExpressionClassification classification; - if (defaultMember.DeclarationType.HasFlag(DeclarationType.Property)) - { - classification = ExpressionClassification.Property; - } - else if (defaultMember.DeclarationType == DeclarationType.Procedure) - { - classification = ExpressionClassification.Subroutine; - } - else - { - classification = ExpressionClassification.Function; - } - var defaultMemberAsLExpression = new SimpleNameExpression(defaultMember, classification, _expression); - return Resolve(defaultMemberAsLExpression); - } + /** + This default member can accept no parameters. In this case, the static analysis restarts + recursively, as if this default member was specified instead for with the + same . + */ + if (parameters.Count(parameter => !parameter.IsOptional) == 0 + && DEFAULT_MEMBER_RECURSION_LIMIT > defaultMemberResolutionRecursionDepth) + { + return ResolveRecursiveDefaultMember(defaultMember, defaultMemberClassification, defaultMemberResolutionRecursionDepth); } } + return null; } + private static bool ArgumentListIsCompatible(ICollection parameters, ArgumentList argumentList) + { + return (parameters.Count >= argumentList.Arguments.Count + || parameters.Any(parameter => parameter.IsParamArray)) + && parameters.Count(parameter => !parameter.IsOptional) <= argumentList.Arguments.Count; + } + + private IBoundExpression ResolveRecursiveDefaultMember(Declaration defaultMember, ExpressionClassification defaultMemberClassification, int defaultMemberResolutionRecursionDepth) + { + var defaultMemberAsLExpression = new SimpleNameExpression(defaultMember, defaultMemberClassification, _expression); + return Resolve(defaultMemberAsLExpression, defaultMemberResolutionRecursionDepth + 1); + } + + private static ExpressionClassification DefaultMemberExpressionClassification(Declaration defaultMember) + { + if (defaultMember.DeclarationType.HasFlag(DeclarationType.Property)) + { + return ExpressionClassification.Property; + } + + if (defaultMember.DeclarationType == DeclarationType.Procedure) + { + return ExpressionClassification.Subroutine; + } + + return ExpressionClassification.Function; + } + private static bool IsPropertyGetLetFunctionProcedure(Declaration declaration) { var declarationType = declaration.DeclarationType; @@ -256,39 +283,44 @@ private static bool IsPublic(Declaration declaration) || accessibility == Accessibility.Public; } - private IBoundExpression ResolveLExpressionDeclaredTypeIsArray(IBoundExpression lExpression, Declaration asTypeDeclaration) + private IBoundExpression ResolveLExpressionDeclaredTypeIsArray(IBoundExpression lExpression) { + var indexedDeclaration = lExpression.ReferencedDeclaration; + if (!indexedDeclaration?.IsArray ?? false) + { + return null; + } + /* The declared type of is an array type, an empty argument list has not already been specified for it, and one of the following is true: */ - if (lExpression.ReferencedDeclaration.IsArray) + + if (!_argumentList.HasArguments) { /* represents an empty argument list. In this case, the index expression takes on the classification and declared type of and references the same array. */ - if (!_argumentList.HasArguments) - { - return new IndexExpression(asTypeDeclaration, lExpression.Classification, _expression, lExpression, _argumentList); - } - else - { - /* - represents an argument list with a number of positional arguments equal - to the rank of the array, and with no named arguments. In this case, the index expression - references an individual element of the array, is classified as a variable and has the - declared type of the array’s element type. - - TODO: Implement compatibility checking / amend the grammar - */ - if (!_argumentList.HasNamedArguments) - { - return new IndexExpression(asTypeDeclaration, ExpressionClassification.Variable, _expression, lExpression, _argumentList); - } - } + + return new IndexExpression(indexedDeclaration, lExpression.Classification, _expression, lExpression, _argumentList); } + + if (!_argumentList.HasNamedArguments) + { + /* + represents an argument list with a number of positional arguments equal + to the rank of the array, and with no named arguments. In this case, the index expression + references an individual element of the array, is classified as a variable and has the + declared type of the array’s element type. + + TODO: Implement compatibility checking / amend the grammar + */ + + return new IndexExpression(indexedDeclaration, ExpressionClassification.Variable, _expression, lExpression, _argumentList, isArrayAccess: true); + } + return null; } @@ -305,13 +337,7 @@ private IBoundExpression ResolveLExpressionIsPropertyFunctionSubroutine(IBoundEx Note: We assume compatibility through enforcement by the VBE. */ - if (lExpression.Classification == ExpressionClassification.Property - || lExpression.Classification == ExpressionClassification.Function - || lExpression.Classification == ExpressionClassification.Subroutine) - { - return new IndexExpression(lExpression.ReferencedDeclaration, lExpression.Classification, _expression, lExpression, _argumentList); - } - return null; + return new IndexExpression(lExpression.ReferencedDeclaration, lExpression.Classification, _expression, lExpression, _argumentList); } private IBoundExpression ResolveLExpressionIsUnbound(IBoundExpression lExpression) @@ -320,11 +346,7 @@ private IBoundExpression ResolveLExpressionIsUnbound(IBoundExpression lExpressio is classified as an unbound member. In this case, the index expression references , is classified as an unbound member and its declared type is Variant. */ - if (lExpression.Classification == ExpressionClassification.Unbound) - { - return new IndexExpression(lExpression.ReferencedDeclaration, ExpressionClassification.Unbound, _expression, lExpression, _argumentList); - } - return null; + return new IndexExpression(lExpression.ReferencedDeclaration, ExpressionClassification.Unbound, _expression, lExpression, _argumentList); } } } diff --git a/Rubberduck.Parsing/Symbols/Declaration.cs b/Rubberduck.Parsing/Symbols/Declaration.cs index dd08ead365..84cd9d0751 100644 --- a/Rubberduck.Parsing/Symbols/Declaration.cs +++ b/Rubberduck.Parsing/Symbols/Declaration.cs @@ -329,18 +329,21 @@ private static string CorrectlyFormatedDescription(string literalDescription) /// public bool IsEnumeratorMember => _attributes.Any(a => a.Name.EndsWith("VB_UserMemId") && a.Values.Contains("-4")); - public virtual bool IsObject + public virtual bool IsObject => !IsArray && IsObjectOrObjectArray; + + public virtual bool IsObjectArray => IsArray && IsObjectOrObjectArray; + + private bool IsObjectOrObjectArray { get { - if (AsTypeName == Tokens.Object || - (AsTypeDeclaration?.DeclarationType.HasFlag(DeclarationType.ClassModule) ?? false)) + if (AsTypeName == Tokens.Object + || (AsTypeDeclaration?.DeclarationType.HasFlag(DeclarationType.ClassModule) ?? false)) { return true; } var isIntrinsic = AsTypeIsBaseType - || IsArray || (AsTypeDeclaration?.DeclarationType.HasFlag(DeclarationType.UserDefinedType) ?? false) || (AsTypeDeclaration?.DeclarationType.HasFlag(DeclarationType.Enumeration) ?? false); @@ -360,7 +363,8 @@ public virtual bool IsObject bool isAssignmentTarget = false, bool hasExplicitLetStatement = false, bool isSetAssigned = false, - bool isDefaultMemberAccess = false + bool isDefaultMemberAccess = false, + bool isArrayAccess = false ) { var oldReference = _references.FirstOrDefault(r => @@ -388,7 +392,8 @@ public virtual bool IsObject hasExplicitLetStatement, annotations, isSetAssigned, - isDefaultMemberAccess); + isDefaultMemberAccess, + isArrayAccess); _references.AddOrUpdate(newReference, 1, (key, value) => 1); } diff --git a/Rubberduck.Parsing/Symbols/IdentifierReference.cs b/Rubberduck.Parsing/Symbols/IdentifierReference.cs index ecf9361fcd..182ad90e59 100644 --- a/Rubberduck.Parsing/Symbols/IdentifierReference.cs +++ b/Rubberduck.Parsing/Symbols/IdentifierReference.cs @@ -24,7 +24,8 @@ public class IdentifierReference : IEquatable bool hasExplicitLetStatement = false, IEnumerable annotations = null, bool isSetAssigned = false, - bool isDefaultMemberAccess = false) + bool isDefaultMemberAccess = false, + bool isArrayAccess = false) { ParentScoping = parentScopingDeclaration; ParentNonScoping = parentNonScopingDeclaration; @@ -37,6 +38,7 @@ public class IdentifierReference : IEquatable IsAssignment = isAssignmentTarget; IsSetAssignment = isSetAssigned; IsDefaultMemberAccess = isDefaultMemberAccess; + IsArrayAccess = isArrayAccess; Annotations = annotations ?? new List(); } @@ -64,6 +66,8 @@ public class IdentifierReference : IEquatable public bool IsDefaultMemberAccess { get; } + public bool IsArrayAccess { get; } + public ParserRuleContext Context { get; } public Declaration Declaration { get; } diff --git a/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs b/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs index 8a994d2c70..d9dd4ca491 100644 --- a/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs +++ b/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs @@ -193,13 +193,14 @@ private IEnumerable FindIdentifierAnnotations(QualifiedModuleName m } } + //TODO: Find out what this is about. var reallyIsAssignmentTarget = isAssignmentTarget && isSetAssignment; if (isAssignmentTarget && !isSetAssignment) { var defaultMember = (boundExpression.ReferencedDeclaration?.AsTypeDeclaration as ClassModuleDeclaration)?.DefaultMember; - //This is a best guess; if the asType is Variant, we have no idea. reallyIsAssignmentTarget = defaultMember == null - || ((IParameterizedDeclaration) defaultMember).Parameters.All(param => param.IsOptional); + || ((IParameterizedDeclaration) defaultMember).Parameters.All(param => param.IsOptional) + || defaultMember.DeclarationType == DeclarationType.PropertyLet && ((IParameterizedDeclaration)defaultMember).Parameters.Count(param => !param.IsOptional) == 1; } _boundExpressionVisitor.AddIdentifierReferences( diff --git a/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs index 60ecc6ec34..2c5ea01b8d 100644 --- a/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs +++ b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs @@ -1,5 +1,4 @@ using System; -using System.Collections.Generic; using System.Linq; using Rubberduck.Parsing.Grammar; using Rubberduck.Parsing.Symbols; @@ -126,7 +125,7 @@ private static string FullObjectTypeName(Declaration setTypeDeterminingDeclarati return setTypeDeterminingDeclaration.QualifiedModuleName.ToString(); } - if (setTypeDeterminingDeclaration.IsObject) + if (setTypeDeterminingDeclaration.IsObject || setTypeDeterminingDeclaration.IsObjectArray) { return setTypeDeterminingDeclaration.FullAsTypeName; } @@ -145,7 +144,7 @@ private static string FullObjectTypeName(Declaration setTypeDeterminingDeclarati case VBAParser.InstanceExprContext instanceExpression: return SetTypeDeterminingDeclarationOfInstance(containingModule, finder); case VBAParser.IndexExprContext indexExpression: - return SetTypeDeterminingDeclarationOfIndexExpression(indexExpression.lExpression(), containingModule, finder); + return SetTypeDeterminingDeclarationOfIndexExpression(indexExpression, containingModule, finder); case VBAParser.MemberAccessExprContext memberAccessExpression: return SetTypeDeterminingDeclarationOfExpression(memberAccessExpression.unrestrictedIdentifier(), containingModule, finder); case VBAParser.WithMemberAccessExprContext withMemberAccessExpression: @@ -155,29 +154,41 @@ private static string FullObjectTypeName(Declaration setTypeDeterminingDeclarati case VBAParser.WithDictionaryAccessExprContext withDictionaryAccessExpression: return SetTypeDeterminingDeclarationOfExpression(withDictionaryAccessExpression.dictionaryAccess(), containingModule, finder); case VBAParser.WhitespaceIndexExprContext whitespaceIndexExpression: - return SetTypeDeterminingDeclarationOfIndexExpression(whitespaceIndexExpression.lExpression(), containingModule, finder); + return SetTypeDeterminingDeclarationOfIndexExpression(whitespaceIndexExpression, containingModule, finder); default: return (null, true); //We should already cover every case. Return the value indicating that we have no idea. } } - private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfIndexExpression(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) + private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfIndexExpression(VBAParser.LExpressionContext indexExpr, QualifiedModuleName containingModule, DeclarationFinder finder) { - var declaration = ResolveIndexExpressionAsMethod(lExpression, containingModule, finder) - ?? ResolveIndexExpressionAsDefaultMemberAccess(lExpression, containingModule, finder); + var lExpressionOfIndexExpression = indexExpr is VBAParser.IndexExprContext indexExpression + ? indexExpression.lExpression() + : (indexExpr as VBAParser.WhitespaceIndexExprContext)?.lExpression(); + + if (lExpressionOfIndexExpression == null) + { + throw new NotSupportedException("Called index expression resolution on expression, which is neither a properly built indexExpr nor a properly built whitespaceIndexExpr."); + } + + var declaration = ResolveIndexExpressionAsMethod(lExpressionOfIndexExpression, containingModule, finder) + ?? ResolveIndexExpressionAsDefaultMemberAccess(lExpressionOfIndexExpression, containingModule, finder); if (declaration != null) { return (declaration, MightHaveSetType(declaration)); } - return ResolveIndexExpressionAsArrayAccess(lExpression, containingModule, finder); + //Passing the indexExpr itself is correct. + var arrayDeclaration = ResolveIndexExpressionAsArrayAccess(indexExpr, containingModule, finder); + + return (arrayDeclaration, MightHaveSetTypeOnArrayAccess(arrayDeclaration)); } - private Declaration ResolveIndexExpressionAsMethod(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) + private Declaration ResolveIndexExpressionAsMethod(VBAParser.LExpressionContext lExpressionOfIndexExpression, QualifiedModuleName containingModule, DeclarationFinder finder) { //For functions and properties, the identifier will be at the end of the lExpression. - var qualifiedSelection = new QualifiedSelection(containingModule, lExpression.GetSelection().Collapse()); + var qualifiedSelection = new QualifiedSelection(containingModule, lExpressionOfIndexExpression.GetSelection().Collapse()); var candidate = finder .ContainingIdentifierReferences(qualifiedSelection) .LastOrDefault() @@ -187,33 +198,26 @@ private Declaration ResolveIndexExpressionAsMethod(VBAParser.LExpressionContext : null; } - private (Declaration declaration, bool mightHaveSetType) ResolveIndexExpressionAsArrayAccess(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) - { - var (potentialArrayDeclaration, lExpressionMightHaveSetType) = SetTypeDeterminingDeclarationOfExpression(lExpression, containingModule, finder); - - if (potentialArrayDeclaration == null) - { - return (null, lExpressionMightHaveSetType); - } - - if (!potentialArrayDeclaration.IsArray) - { - //This is not an array access. So, we have no idea. - return (null, true); - } - - return (potentialArrayDeclaration, MightHaveSetTypeOnArrayAccess(potentialArrayDeclaration)); - } - - private Declaration ResolveIndexExpressionAsDefaultMemberAccess(VBAParser.LExpressionContext lExpression, QualifiedModuleName containingModule, DeclarationFinder finder) + private Declaration ResolveIndexExpressionAsDefaultMemberAccess(VBAParser.LExpressionContext lExpressionOfIndexExpression, QualifiedModuleName containingModule, DeclarationFinder finder) { // A default member access references the entire lExpression. - var qualifiedSelection = new QualifiedSelection(containingModule, lExpression.GetSelection()); + var qualifiedSelection = new QualifiedSelection(containingModule, lExpressionOfIndexExpression.GetSelection()); return finder .IdentifierReferences(qualifiedSelection) .FirstOrDefault(reference => reference.IsDefaultMemberAccess) ?.Declaration; } + + //Please note that the lExpression is the (whitespace) index expression itself and not the lExpression it contains. + private Declaration ResolveIndexExpressionAsArrayAccess(VBAParser.LExpressionContext actualIndexExpr, QualifiedModuleName containingModule, DeclarationFinder finder) + { + // A n array access references the entire (whitespace)indexExpr. + var qualifiedSelection = new QualifiedSelection(containingModule, actualIndexExpr.GetSelection()); + return finder + .IdentifierReferences(qualifiedSelection) + .FirstOrDefault(reference => reference.IsArrayAccess) + ?.Declaration; + } private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfExpression(VBAParser.IdentifierContext identifier, QualifiedModuleName containingModule, DeclarationFinder finder) { @@ -244,34 +248,17 @@ private static bool MightHaveSetType(Declaration declaration) { return declaration == null || declaration.IsObject - || declaration.AsTypeName == Tokens.Variant + || Tokens.Variant.Equals( declaration.AsTypeName, StringComparison.InvariantCultureIgnoreCase) || declaration.DeclarationType.HasFlag(DeclarationType.ClassModule); } private static bool MightHaveSetTypeOnArrayAccess(Declaration declaration) { return declaration == null - || IsObjectArray(declaration) - || declaration.AsTypeName == Tokens.Variant; + || declaration.IsObjectArray + || Tokens.Variant.Equals(declaration.AsTypeName, StringComparison.InvariantCultureIgnoreCase); } - private static bool IsObjectArray(Declaration declaration) - { - if (!declaration.IsArray) - { - return false; - } - - if (declaration.AsTypeName == Tokens.Object || - (declaration.AsTypeDeclaration?.DeclarationType.HasFlag(DeclarationType.ClassModule) ?? false)) - { - return true; - } - - return false; - } - - private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfInstance(QualifiedModuleName instance, DeclarationFinder finder) { var classDeclaration = finder.Classes.FirstOrDefault(cls => cls.QualifiedModuleName.Equals(instance)); diff --git a/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs b/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs index 7cb57d5ad0..82e137559d 100644 --- a/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs +++ b/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs @@ -1,10 +1,8 @@ using System; using System.Collections.Generic; using System.Linq; -using Antlr4.Runtime; using Rubberduck.Parsing.Annotations; using Rubberduck.Parsing.Binding; -using Rubberduck.Parsing.Grammar; using Rubberduck.Parsing.Symbols; using Rubberduck.Parsing.VBA.DeclarationCaching; using Rubberduck.VBEditor; @@ -108,14 +106,6 @@ public BoundExpressionVisitor(DeclarationFinder declarationFinder) bool hasExplicitLetStatement, bool isSetAssignment) { - if (isAssignmentTarget && expression.Context.Parent is VBAParser.IndexExprContext && !expression.ReferencedDeclaration.IsArray) - { - // 'SomeDictionary' is not the assignment target in 'SomeDictionary("key") = 42' - // ..but we want to treat array index assignment as assignment to the array itself. - isAssignmentTarget = false; - isSetAssignment = false; - } - var callSiteContext = expression.Context; var identifier = expression.Context.GetText(); var callee = expression.ReferencedDeclaration; @@ -182,31 +172,31 @@ private IEnumerable FindIdentifierAnnotations(QualifiedModuleName m bool hasExplicitLetStatement, bool isSetAssignment) { - // Index expressions are a bit special in that they could refer to elements of an array, what apparently we don't want to - // add an identifier reference to, that's why we pass on the isassignment/hasexplicitletstatement values. - Visit(expression.LExpression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); + if (expression.IsDefaultMemberAccess) + { + Visit(expression.LExpression, module, scope, parent); - //Generate reference in case this is a default member access. - if (expression.Classification != ExpressionClassification.Unbound - && expression.ReferencedDeclaration != null - && !ReferenceEquals(expression.LExpression.ReferencedDeclaration, expression.ReferencedDeclaration)) + if (expression.Classification != ExpressionClassification.Unbound + && expression.ReferencedDeclaration != null) + { + AddDefaultMemberReference(expression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); + } + } + else if (expression.Classification != ExpressionClassification.Unbound + && expression.IsArrayAccess + && expression.ReferencedDeclaration != null) { - var callSiteContext = expression.LExpression.Context; - var identifier = expression.LExpression.Context.GetText(); - var callee = expression.ReferencedDeclaration; - expression.ReferencedDeclaration.AddReference( - module, - scope, - parent, - callSiteContext, - identifier, - callee, - callSiteContext.GetSelection(), - FindIdentifierAnnotations(module, callSiteContext.GetSelection().StartLine), - isSetAssignment, - isDefaultMemberAccess: true); + Visit(expression.LExpression, module, scope, parent); + AddArrayAccessReference(expression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); } - // Argument List not affected by being unbound. + else + { + // Index expressions are a bit special in that they can refer to parameterized properties and functions. + // In that case, the reference goes to the property or function. So, we pass on the assignment flags. + Visit(expression.LExpression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); + } + + // Argument lists are not affected by the resolution of the target of the index expression. foreach (var argument in expression.ArgumentList.Arguments) { if (argument.Expression != null) @@ -220,6 +210,60 @@ private IEnumerable FindIdentifierAnnotations(QualifiedModuleName m } } + private void AddArrayAccessReference( + IndexExpression expression, + QualifiedModuleName module, + Declaration scope, + Declaration parent, + bool isAssignmentTarget, + bool hasExplicitLetStatement, + bool isSetAssignment) + { + var callSiteContext = expression.Context; + var identifier = expression.Context.GetText(); + var callee = expression.ReferencedDeclaration; + expression.ReferencedDeclaration.AddReference( + module, + scope, + parent, + callSiteContext, + identifier, + callee, + callSiteContext.GetSelection(), + FindIdentifierAnnotations(module, callSiteContext.GetSelection().StartLine), + isAssignmentTarget, + hasExplicitLetStatement, + isSetAssignment, + isArrayAccess: true); + } + + private void AddDefaultMemberReference( + IndexExpression expression, + QualifiedModuleName module, + Declaration scope, + Declaration parent, + bool isAssignmentTarget, + bool isSetAssignment, + bool hasExplicitLetStatement) + { + var callSiteContext = expression.LExpression.Context; + var identifier = expression.LExpression.Context.GetText(); + var callee = expression.ReferencedDeclaration; + expression.ReferencedDeclaration.AddReference( + module, + scope, + parent, + callSiteContext, + identifier, + callee, + callSiteContext.GetSelection(), + FindIdentifierAnnotations(module, callSiteContext.GetSelection().StartLine), + isAssignmentTarget, + hasExplicitLetStatement, + isSetAssignment, + isDefaultMemberAccess: true); + } + private void Visit( DictionaryAccessExpression expression, QualifiedModuleName module, @@ -246,6 +290,8 @@ private IEnumerable FindIdentifierAnnotations(QualifiedModuleName m callee, callSiteContext.GetSelection(), FindIdentifierAnnotations(module, callSiteContext.GetSelection().StartLine), + isAssignmentTarget, + hasExplicitLetStatement, isSetAssignment, isDefaultMemberAccess: true); } diff --git a/RubberduckTests/Grammar/ResolverTests.cs b/RubberduckTests/Grammar/ResolverTests.cs index 3d39695f16..c356aa5de2 100644 --- a/RubberduckTests/Grammar/ResolverTests.cs +++ b/RubberduckTests/Grammar/ResolverTests.cs @@ -967,7 +967,7 @@ End Sub [Category("Grammar")] [Category("Resolver")] [Test] - public void ArraySubscriptAccess_IsReferenceToArrayDeclaration() + public void ArraySubscriptAccess_IsReferenceToArrayOnceAsAccessAndOnceDirectlyDeclaration() { var code = @" Public Sub DoSomething(ParamArray values()) @@ -985,10 +985,13 @@ End Sub && item.IdentifierName == "values" && item.IsArray); - Assert.IsNotNull(declaration.References.SingleOrDefault(item => + var arrayReferences = declaration.References.Where(item => item.ParentScoping.DeclarationType == DeclarationType.Procedure && item.ParentScoping.IdentifierName == "DoSomething" - && !item.IsAssignment)); + && !item.IsAssignment).ToList(); + + Assert.AreEqual(1, arrayReferences.Count(reference => reference.IsArrayAccess)); + Assert.AreEqual(1, arrayReferences.Count(reference => !reference.IsArrayAccess)); } } @@ -1011,7 +1014,33 @@ End Sub item.DeclarationType == DeclarationType.Variable && item.IdentifierName == "foo"); - Assert.IsNotNull(declaration.References.SingleOrDefault(item => + Assert.AreEqual(1,declaration.References.Count(item => + item.ParentScoping.DeclarationType == DeclarationType.Procedure + && item.ParentScoping.IdentifierName == "DoSomething" + && item.IsAssignment)); + } + } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void SubscriptWrite_HasNonAssignmentReferenceToObjectDeclaration() + { + var code = @" +Public Sub DoSomething() + Dim foo As Object + Set foo = CreateObject(""Scripting.Dictionary"") + foo(""key"") = 42 +End Sub +"; + using (var state = Resolve(code)) + { + + var declaration = state.AllUserDeclarations.Single(item => + item.DeclarationType == DeclarationType.Variable + && item.IdentifierName == "foo"); + + Assert.AreEqual(1, declaration.References.Count(item => item.ParentScoping.DeclarationType == DeclarationType.Procedure && item.ParentScoping.IdentifierName == "DoSomething" && !item.IsAssignment)); @@ -1335,7 +1364,8 @@ End Sub && item.IsArray && item.ParentScopeDeclaration.IdentifierName == "DoSomething"); - Assert.IsNotNull(declaration.References.SingleOrDefault(item => !item.IsAssignment)); + Assert.AreEqual(1, declaration.References.Count(item => !item.IsAssignment && item.IsArrayAccess)); + Assert.AreEqual(1, declaration.References.Count(item => !item.IsAssignment && !item.IsArrayAccess)); } } @@ -3199,8 +3229,6 @@ End Function } } - - [Category("Grammar")] [Category("Resolver")] [Test] @@ -3230,8 +3258,8 @@ End Function { var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "Module1"); var qualifiedSelection = new QualifiedSelection(module, selection); - var defaultMamberReference = state.DeclarationFinder.ContainingIdentifierReferences(qualifiedSelection).Last(reference => reference.IsDefaultMemberAccess); - var referencedDeclaration = defaultMamberReference.Declaration; + var memberReference = state.DeclarationFinder.ContainingIdentifierReferences(qualifiedSelection).Last(reference => reference.IsDefaultMemberAccess); + var referencedDeclaration = memberReference.Declaration; var expectedReferencedDeclarationName = "Class1.Foo"; var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; @@ -3239,5 +3267,34 @@ End Function Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); } } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void ArrayAccessExpressionHasReferenceOnWholeExpression() + { + var moduleCode = @" +Private Sub Foo() + Dim bar(0 To 1) As Long + bar(0) = 23 +End Sub +"; + + var selection = new Selection(4, 5, 4, 11); + + using (var state = Resolve(moduleCode)) + { + var module = state.DeclarationFinder.AllModules.Single(qmn => qmn.ComponentType == ComponentType.StandardModule); + var qualifiedSelection = new QualifiedSelection(module, selection); + var reference = state.DeclarationFinder.IdentifierReferences(qualifiedSelection).First(); + + var expectedReferenceText = "bar(0)"; + var actualReferenceText = reference.IdentifierName; + + Assert.AreEqual(expectedReferenceText, actualReferenceText); + Assert.IsTrue(reference.IsArrayAccess); + Assert.IsTrue(reference.IsAssignment); + } + } } } diff --git a/RubberduckTests/Inspections/ImplicitDefaultMemberAssignmentInspectionTests.cs b/RubberduckTests/Inspections/ImplicitDefaultMemberAssignmentInspectionTests.cs index 5fa9d87b20..f3a664f7ed 100644 --- a/RubberduckTests/Inspections/ImplicitDefaultMemberAssignmentInspectionTests.cs +++ b/RubberduckTests/Inspections/ImplicitDefaultMemberAssignmentInspectionTests.cs @@ -1,11 +1,9 @@ -using System; -using System.Collections.Generic; +using System.Collections.Generic; using System.Linq; -using System.Text; using System.Threading; -using System.Threading.Tasks; using NUnit.Framework; using Rubberduck.Inspections.Concrete; +using Rubberduck.Parsing.Inspections.Abstract; using Rubberduck.Parsing.VBA; using Rubberduck.VBEditor.SafeComWrappers; using RubberduckTests.Mocks; @@ -19,90 +17,86 @@ public class ImplicitDefaultMemberAssignmentInspectionTests [Category("Inspections")] public void ImplicitDefaultMemberAssignment_ReturnsResult() { - const string inputCode = -@"Public Sub Foo(bar As Range) - With bar - .Cells(1, 1) = 42 - End With -End Sub + const string defaultMemberClassCode = @" +Public Property Let Foo(bar As Long) +Attribute Foo.VB_UserMemId = 0 +End Property "; - var builder = new MockVbeBuilder(); - var project = builder.ProjectBuilder("TestProject1", "TestProject1", ProjectProtection.Unprotected) - .AddComponent("Module1", ComponentType.StandardModule, inputCode) - .AddReference("Excel", MockVbeBuilder.LibraryPathMsExcel, 1, 8, true) - .Build(); - var vbe = builder.AddProject(project).Build(); - - var parser = MockParser.Create(vbe.Object); - using (var state = parser.State) - { - parser.Parse(new CancellationTokenSource()); - if (state.Status >= ParserState.Error) - { - Assert.Inconclusive("Parser Error"); - } + const string inputCode = @" +Public Sub Foo() + Dim bar As Class1 + bar = 42 +End Sub +"; - var inspection = new ImplicitDefaultMemberAssignmentInspection(state); - var inspectionResults = inspection.GetInspectionResults(CancellationToken.None); + var inspectionResults = GetInspectionResults(defaultMemberClassCode, inputCode); - Assert.AreEqual(1, inspectionResults.Count()); - } + Assert.AreEqual(1, inspectionResults.Count()); } [Test] [Category("Inspections")] public void ImplicitDefaultMemberAssignment_IgnoredDoesNotReturnResult() { - const string inputCode = -@"Public Sub Foo(bar As Range) - With bar - '@Ignore ImplicitDefaultMemberAssignment - .Cells(1, 1) = 42 - End With + const string defaultMemberClassCode = @" +Public Property Let Foo(bar As Long) +Attribute Foo.VB_UserMemId = 0 +End Property +"; + + const string inputCode = @" +Public Sub Foo(bar As Class1) + '@Ignore ImplicitDefaultMemberAssignment + bar = 42 End Sub "; - var builder = new MockVbeBuilder(); - var project = builder.ProjectBuilder("TestProject1", "TestProject1", ProjectProtection.Unprotected) - .AddComponent("Module1", ComponentType.StandardModule, inputCode) - .AddReference("Excel", MockVbeBuilder.LibraryPathMsExcel, 1, 8, true) - .Build(); - var vbe = builder.AddProject(project).Build(); - - using (var state = MockParser.CreateAndParse(vbe.Object)) - { - var inspection = new ImplicitDefaultMemberAssignmentInspection(state); - var inspectionResults = inspection.GetInspectionResults(CancellationToken.None); - Assert.AreEqual(0, inspectionResults.Count()); - } + var inspectionResults = GetInspectionResults(defaultMemberClassCode, inputCode); + + Assert.AreEqual(0, inspectionResults.Count()); } [Test] [Category("Inspections")] public void ImplicitDefaultMemberAssignment_ExplicitCallDoesNotReturnResult() { - const string inputCode = -@"Public Sub Foo(bar As Range) - With bar - .Cells(1, 1).Value = 42 - End With + const string defaultMemberClassCode = @" +Public Property Let Foo(bar As Long) +Attribute Foo.VB_UserMemId = 0 +End Property +"; + + const string inputCode = @" +Public Sub Foo(bar As Class1) + bar.Foo = 42 End Sub "; - var builder = new MockVbeBuilder(); - var project = builder.ProjectBuilder("TestProject1", "TestProject1", ProjectProtection.Unprotected) - .AddComponent("Module1", ComponentType.StandardModule, inputCode) - .AddReference("Excel", MockVbeBuilder.LibraryPathMsExcel, 1, 8, true) - .Build(); - var vbe = builder.AddProject(project).Build(); - - using (var state = MockParser.CreateAndParse(vbe.Object)) - { - var inspection = new ImplicitDefaultMemberAssignmentInspection(state); - var inspectionResults = inspection.GetInspectionResults(CancellationToken.None); - Assert.AreEqual(0, inspectionResults.Count()); - } + var inspectionResults = GetInspectionResults(defaultMemberClassCode, inputCode); + + Assert.AreEqual(0, inspectionResults.Count()); + } + + [Test] + [Category("Inspections")] + public void ImplicitDefaultMemberAssignment_ExplicitLetDoesNotReturnResult() + { + const string defaultMemberClassCode = @" +Public Property Let Foo(bar As Long) +Attribute Foo.VB_UserMemId = 0 +End Property +"; + + const string inputCode = @" +Public Sub Foo(bar As Class1) + Let bar = 42 +End Sub +"; + + var inspectionResults = GetInspectionResults(defaultMemberClassCode, inputCode); + + Assert.AreEqual(0, inspectionResults.Count()); } [Test] @@ -114,5 +108,26 @@ public void InspectionName() Assert.AreEqual(inspectionName, inspection.Name); } + + private IEnumerable GetInspectionResults(string defaultMemberClassCode, string moduleCode) + { + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, defaultMemberClassCode) + .AddComponent("Module1", ComponentType.StandardModule, moduleCode) + .AddProjectToVbeBuilder() + .Build() + .Object; + using (var state = MockParser.CreateAndParse(vbe)) + { + var inspection = InspectionUnderTest(state); + return inspection.GetInspectionResults(CancellationToken.None); + } + } + + private IInspection InspectionUnderTest(RubberduckParserState state) + { + return new ImplicitDefaultMemberAssignmentInspection(state); + } } } From 6348fff00fbfed6b0be486e27fa6f02038a46aeb Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Wed, 14 Aug 2019 00:24:10 +0200 Subject: [PATCH 14/22] Move band-aid for AssignmentToByValParameterInspection from resolver to the inspection itself This also makes the ImplicitDefaultMemberAssignmentInspection work correctly without tweaks to the resolver.. --- .../AssignedByValParameterInspection.cs | 31 ++++++++++++++++- .../Symbols/IdentifierReferenceResolver.cs | 12 +------ .../AssignedByValParameterInspectionTests.cs | 34 +++++++++++++++++++ 3 files changed, 65 insertions(+), 12 deletions(-) diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/AssignedByValParameterInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/AssignedByValParameterInspection.cs index 8ac979dc82..ddd7af55ce 100644 --- a/Rubberduck.CodeAnalysis/Inspections/Concrete/AssignedByValParameterInspection.cs +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/AssignedByValParameterInspection.cs @@ -48,12 +48,41 @@ protected override IEnumerable DoGetInspectionResults() .Cast() .Where(item => !item.IsByRef && !item.IsIgnoringInspectionResultFor(AnnotationName) - && item.References.Any(reference => reference.IsAssignment)); + && item.References.Any(IsAssignmentToDeclaration)); return parameters .Select(param => new DeclarationInspectionResult(this, string.Format(InspectionResults.AssignedByValParameterInspection, param.IdentifierName), param)); } + + private static bool IsAssignmentToDeclaration(IdentifierReference reference) + { + if (!reference.IsAssignment) + { + return false; + } + + if (reference.IsSetAssignment) + { + return true; + } + + var declaration = reference.Declaration; + if (declaration == null) + { + return false; + } + + if (declaration.IsObject) + { + //This can only be legal with a default member access. + return false; + } + + //This is not perfect in case the referenced declaration is an unbound Variant. + //In that case, a default member access might occur after the run-time resolution. + return true; + } } } diff --git a/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs b/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs index d9dd4ca491..e293c935b6 100644 --- a/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs +++ b/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs @@ -193,22 +193,12 @@ private IEnumerable FindIdentifierAnnotations(QualifiedModuleName m } } - //TODO: Find out what this is about. - var reallyIsAssignmentTarget = isAssignmentTarget && isSetAssignment; - if (isAssignmentTarget && !isSetAssignment) - { - var defaultMember = (boundExpression.ReferencedDeclaration?.AsTypeDeclaration as ClassModuleDeclaration)?.DefaultMember; - reallyIsAssignmentTarget = defaultMember == null - || ((IParameterizedDeclaration) defaultMember).Parameters.All(param => param.IsOptional) - || defaultMember.DeclarationType == DeclarationType.PropertyLet && ((IParameterizedDeclaration)defaultMember).Parameters.Count(param => !param.IsOptional) == 1; - } - _boundExpressionVisitor.AddIdentifierReferences( boundExpression, _qualifiedModuleName, _currentScope, _currentParent, - reallyIsAssignmentTarget, + isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); } diff --git a/RubberduckTests/Inspections/AssignedByValParameterInspectionTests.cs b/RubberduckTests/Inspections/AssignedByValParameterInspectionTests.cs index 6a25d92477..cea5c81fdd 100644 --- a/RubberduckTests/Inspections/AssignedByValParameterInspectionTests.cs +++ b/RubberduckTests/Inspections/AssignedByValParameterInspectionTests.cs @@ -170,6 +170,40 @@ End Sub } } + [Test] + [Category("Inspections")] + public void AssignedByValParameter_NoResultForDefaultMembberAssignment() + { + var class1 = @" +Public Property Get Something() As Long +Attribute Foo.VB_UserMemId = 0 +End Property +Public Property Let Something(ByVal value As Long) +Attribute Foo.VB_UserMemId = 0 +End Property +"; + var caller = @" +Option Explicit +Private Sub DoSomething(ByVal foo As Class1) + foo = 42 +End Sub +"; + var builder = new MockVbeBuilder(); + var vbe = builder.ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Module1", ComponentType.StandardModule, caller) + .AddProjectToVbeBuilder() + .Build(); + + using (var state = MockParser.CreateAndParse(vbe.Object)) + { + var inspection = new AssignedByValParameterInspection(state); + var inspectionResults = inspection.GetInspectionResults(CancellationToken.None); + + Assert.IsFalse(inspectionResults.Any()); + } + } + [Test] [Category("Inspections")] public void InspectionName() From 39402e80291a1a971b298599ad0b47fb4282a15b Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Wed, 14 Aug 2019 01:05:48 +0200 Subject: [PATCH 15/22] Reorder alternatives in annotationArgList in grammar Previously the options without explicit parentheses were preferred and matched to expressions with parentheses consuming them as part or the argument. --- Rubberduck.Parsing/Grammar/VBAParser.g4 | 9 ++-- .../Annotations/AnnotationResolutionTests.cs | 46 +++++++++++++++++++ 2 files changed, 51 insertions(+), 4 deletions(-) diff --git a/Rubberduck.Parsing/Grammar/VBAParser.g4 b/Rubberduck.Parsing/Grammar/VBAParser.g4 index 0e4cfca99c..fd31ca55e3 100644 --- a/Rubberduck.Parsing/Grammar/VBAParser.g4 +++ b/Rubberduck.Parsing/Grammar/VBAParser.g4 @@ -955,11 +955,12 @@ annotationList : SINGLEQUOTE (AT annotation)+ (COLON commentBody)?; annotation : annotationName annotationArgList? whiteSpace?; annotationName : unrestrictedIdentifier; annotationArgList : - whiteSpace annotationArg - | whiteSpace annotationArg (whiteSpace? COMMA whiteSpace? annotationArg)+ + whiteSpace? LPAREN whiteSpace? annotationArg whiteSpace? RPAREN | whiteSpace? LPAREN whiteSpace? RPAREN - | whiteSpace? LPAREN whiteSpace? annotationArg whiteSpace? RPAREN - | whiteSpace? LPAREN annotationArg (whiteSpace? COMMA whiteSpace? annotationArg)+ whiteSpace? RPAREN; + | whiteSpace? LPAREN annotationArg (whiteSpace? COMMA whiteSpace? annotationArg)+ whiteSpace? RPAREN + | whiteSpace annotationArg + | whiteSpace annotationArg (whiteSpace? COMMA whiteSpace? annotationArg)+ +; annotationArg : expression; mandatoryLineContinuation : LINE_CONTINUATION WS*; diff --git a/RubberduckTests/Annotations/AnnotationResolutionTests.cs b/RubberduckTests/Annotations/AnnotationResolutionTests.cs index 6a042648f8..9c567025a7 100644 --- a/RubberduckTests/Annotations/AnnotationResolutionTests.cs +++ b/RubberduckTests/Annotations/AnnotationResolutionTests.cs @@ -1,5 +1,6 @@ using System.Linq; using NUnit.Framework; +using Rubberduck.Parsing.Annotations; using Rubberduck.Parsing.Symbols; using RubberduckTests.Mocks; @@ -556,5 +557,50 @@ public void IdentifierAnnotationsOnPreviousNonWhiteSpaceDoNotGetScopedToIdentifi Assert.AreEqual(expectedAnnotationCount, actualAnnotationCount); } } + + [Test] + //Cf. issue #5071 at https://github.com/rubberduck-vba/Rubberduck/issues/5071 + public void AnnotationArgumentIsRecognisedWithWhiteSpaceInBetween() + { + const string inputCode = + @" +'@description (""Function description"") +Public Function Bar() As Variant +End Function"; + var vbe = MockVbeBuilder.BuildFromSingleStandardModule(inputCode, out _); + using (var state = MockParser.CreateAndParse(vbe.Object)) + { + var declaration = state.DeclarationFinder.UserDeclarations(DeclarationType.Function).Single(); + var annotation = declaration.Annotations.OfType().Single(); + + var expectedAnnotationArgument = "Function description"; + var actualAnnotationArgument = annotation.Description; + + Assert.AreEqual(expectedAnnotationArgument, actualAnnotationArgument); + } + } + + [Test] + public void AnnotationArgumentIsRecognisedWithLineContinuationsInBetween() + { + const string inputCode = + @" +'@description _ + _ + (""Function description"") +Public Function Bar() As Variant +End Function"; + var vbe = MockVbeBuilder.BuildFromSingleStandardModule(inputCode, out _); + using (var state = MockParser.CreateAndParse(vbe.Object)) + { + var declaration = state.DeclarationFinder.UserDeclarations(DeclarationType.Function).Single(); + var annotation = declaration.Annotations.OfType().Single(); + + var expectedAnnotationArgument = "Function description"; + var actualAnnotationArgument = annotation.Description; + + Assert.AreEqual(expectedAnnotationArgument, actualAnnotationArgument); + } + } } } \ No newline at end of file From 02cad444e5e4daff8f058132399f72e5c5528672 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Wed, 14 Aug 2019 22:10:08 +0200 Subject: [PATCH 16/22] Fix resolution of default member and array accesses on dictionary access expressions --- .../Binding/Bindings/IndexDefaultBinding.cs | 61 +++- RubberduckTests/Grammar/ResolverTests.cs | 272 +++++++++++++++++- 2 files changed, 319 insertions(+), 14 deletions(-) diff --git a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs index 20f616d714..829d72d10b 100644 --- a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs +++ b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs @@ -75,24 +75,38 @@ private IBoundExpression Resolve(IBoundExpression lExpression, int defaultMember return ResolveLExpressionIsUnbound(lExpression); } - if (lExpression is IndexExpression indexExpression - && _argumentList.HasArguments - && lExpression.ReferencedDeclaration != null) + if(lExpression.ReferencedDeclaration != null) { - var doubleIndexExpression = ResolveLExpressionIsIndexExpression(indexExpression, defaultMemberResolutionRecursionDepth); - if (doubleIndexExpression != null) + if (_argumentList.HasArguments) { - return doubleIndexExpression; + switch (lExpression) + { + case IndexExpression indexExpression: + var doubleIndexExpression = ResolveLExpressionIsIndexExpression(indexExpression, defaultMemberResolutionRecursionDepth); + if (doubleIndexExpression != null) + { + return doubleIndexExpression; + } + + break; + case DictionaryAccessExpression dictionaryAccessExpression: + var indexOnBangExpression = ResolveLExpressionIsDictionaryAccessExpression(dictionaryAccessExpression, defaultMemberResolutionRecursionDepth); + if (indexOnBangExpression != null) + { + return indexOnBangExpression; + } + + break; + } } - } - if (IsVariablePropertyFunctionWithoutParameters(lExpression) - && lExpression.ReferencedDeclaration != null) - { - var parameterlessLExpressionAccess = ResolveLExpressionIsVariablePropertyFunctionNoParameters(lExpression, defaultMemberResolutionRecursionDepth); - if (parameterlessLExpressionAccess != null) + if (IsVariablePropertyFunctionWithoutParameters(lExpression)) { - return parameterlessLExpressionAccess; + var parameterlessLExpressionAccess = ResolveLExpressionIsVariablePropertyFunctionNoParameters(lExpression, defaultMemberResolutionRecursionDepth); + if (parameterlessLExpressionAccess != null) + { + return parameterlessLExpressionAccess; + } } } @@ -185,6 +199,27 @@ private IBoundExpression ResolveLExpressionIsIndexExpression(IndexExpression ind return ResolveDefaultMember(indexExpression, asTypeName, asTypeDeclaration, defaultMemberResolutionRecursionDepth); } + private IBoundExpression ResolveLExpressionIsDictionaryAccessExpression(DictionaryAccessExpression dictionaryAccessExpression, int defaultMemberResolutionRecursionDepth = 0) + { + //This is equivalent to the case in which the lExpression is an IndexExpression with the difference that it cannot be an array access. + + var indexedDeclaration = dictionaryAccessExpression.ReferencedDeclaration; + if (indexedDeclaration == null) + { + return null; + } + + if (indexedDeclaration.IsArray) + { + return ResolveLExpressionDeclaredTypeIsArray(dictionaryAccessExpression); + } + + var asTypeName = indexedDeclaration.AsTypeName; + var asTypeDeclaration = indexedDeclaration.AsTypeDeclaration; + + return ResolveDefaultMember(dictionaryAccessExpression, asTypeName, asTypeDeclaration, defaultMemberResolutionRecursionDepth); + } + private IBoundExpression ResolveDefaultMember(IBoundExpression lExpression, string asTypeName, Declaration asTypeDeclaration, int defaultMemberResolutionRecursionDepth) { /* diff --git a/RubberduckTests/Grammar/ResolverTests.cs b/RubberduckTests/Grammar/ResolverTests.cs index c356aa5de2..52b80a3345 100644 --- a/RubberduckTests/Grammar/ResolverTests.cs +++ b/RubberduckTests/Grammar/ResolverTests.cs @@ -3056,7 +3056,7 @@ End Function [Category("Grammar")] [Category("Resolver")] [Test] - public void ChainedDictionaryAccessExpressionHasReferenceToDefaultMemberAtExclamationMark() + public void ChainedSameMemberDictionaryAccessExpressionHasReferenceToDefaultMemberAtExclamationMark() { var classCode = @" Public Function Foo(bar As String) As Class1 @@ -3093,6 +3093,276 @@ End Function } } + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void ChainedDictionaryAccessExpressionHasReferenceToDefaultMemberAtSecondExclamationMark() + { + var class1Code = @" +Public Function Foo(bar As String) As Class2 +Attribute Foo.VB_UserMemId = 0 + Set Foo = New Class2 +End Function +"; + + var class2Code = @" +Public Function Baz(bar As String) As Class2 +Attribute Baz.VB_UserMemId = 0 + Set Baz = New Class2 +End Function +"; + + var moduleCode = @" +Private Function Foo() As Class1 + Dim cls As new Class1 + Set Foo = cls!newClassObject!whatever +End Function +"; + + var vbe = MockVbeBuilder.BuildFromModules( + ("Class1", class1Code, ComponentType.ClassModule), + ("Class2", class2Code, ComponentType.ClassModule), + ("Module1", moduleCode, ComponentType.StandardModule)); + + var selection = new Selection(4, 18, 4, 19); + + using (var state = Resolve(vbe.Object)) + { + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "Module1"); + var qualifiedSelection = new QualifiedSelection(module, selection); + var reference = state.DeclarationFinder.IdentifierReferences(qualifiedSelection).First(); + var referencedDeclaration = reference.Declaration; + + var expectedReferencedDeclarationName = "Class1.Foo"; + var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; + + Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + Assert.IsTrue(reference.IsDefaultMemberAccess); + } + } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void ChainedDictionaryAccessExpressionHasReferenceToDefaultMemberAtFirstExclamationMark() + { + var class1Code = @" +Public Function Foo(bar As String) As Class2 +Attribute Foo.VB_UserMemId = 0 + Set Foo = New Class2 +End Function +"; + + var class2Code = @" +Public Function Baz(bar As String) As Class2 +Attribute Baz.VB_UserMemId = 0 + Set Baz = New Class2 +End Function +"; + + var moduleCode = @" +Private Function Foo() As Class1 + Dim cls As new Class1 + Set Foo = cls!newClassObject!whatever +End Function +"; + + var vbe = MockVbeBuilder.BuildFromModules( + ("Class1", class1Code, ComponentType.ClassModule), + ("Class2", class2Code, ComponentType.ClassModule), + ("Module1", moduleCode, ComponentType.StandardModule)); + + var selection = new Selection(4, 33, 4, 34); + + using (var state = Resolve(vbe.Object)) + { + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "Module1"); + var qualifiedSelection = new QualifiedSelection(module, selection); + var reference = state.DeclarationFinder.IdentifierReferences(qualifiedSelection).First(); + var referencedDeclaration = reference.Declaration; + + var expectedReferencedDeclarationName = "Class2.Baz"; + var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; + + Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + Assert.IsTrue(reference.IsDefaultMemberAccess); + } + } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void DictionaryAccessExpressionWithIndexedDefaultMemberAccessHasReferenceToDefaultMemberAtExclamationMark() + { + var class1Code = @" +Public Function Foo(bar As String) As Class2 +Attribute Foo.VB_UserMemId = 0 + Set Foo = New Class2 +End Function +"; + + var class2Code = @" +Public Function Baz(bar As String) As Class2 +Attribute Baz.VB_UserMemId = 0 + Set Baz = New Class2 +End Function +"; + + var moduleCode = @" +Private Function Foo() As Class1 + Dim cls As new Class1 + Set Foo = cls!newClassObject(""whatever"") +End Function +"; + + var vbe = MockVbeBuilder.BuildFromModules( + ("Class1", class1Code, ComponentType.ClassModule), + ("Class2", class2Code, ComponentType.ClassModule), + ("Module1", moduleCode, ComponentType.StandardModule)); + + var selection = new Selection(4, 18, 4, 19); + + using (var state = Resolve(vbe.Object)) + { + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "Module1"); + var qualifiedSelection = new QualifiedSelection(module, selection); + var reference = state.DeclarationFinder.IdentifierReferences(qualifiedSelection).First(); + var referencedDeclaration = reference.Declaration; + + var expectedReferencedDeclarationName = "Class1.Foo"; + var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; + + Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + Assert.IsTrue(reference.IsDefaultMemberAccess); + } + } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void DictionaryAccessExpressionWithIndexedDefaultMemberAccessHasReferenceToDefaultMemberOnEntireContextExcludingFinalArguments() + { + var class1Code = @" +Public Function Foo(bar As String) As Class2 +Attribute Foo.VB_UserMemId = 0 + Set Foo = New Class2 +End Function +"; + + var class2Code = @" +Public Function Baz(bar As String) As Class2 +Attribute Baz.VB_UserMemId = 0 + Set Baz = New Class2 +End Function +"; + + var moduleCode = @" +Private Function Foo() As Class1 + Dim cls As new Class1 + Set Foo = cls!newClassObject(""whatever"") +End Function +"; + + var vbe = MockVbeBuilder.BuildFromModules( + ("Class1", class1Code, ComponentType.ClassModule), + ("Class2", class2Code, ComponentType.ClassModule), + ("Module1", moduleCode, ComponentType.StandardModule)); + + var selection = new Selection(4, 15, 4, 33); + + using (var state = Resolve(vbe.Object)) + { + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "Module1"); + var qualifiedSelection = new QualifiedSelection(module, selection); + var reference = state.DeclarationFinder.IdentifierReferences(qualifiedSelection).First(); + var referencedDeclaration = reference.Declaration; + + var expectedReferencedDeclarationName = "Class2.Baz"; + var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; + + Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + Assert.IsTrue(reference.IsDefaultMemberAccess); + } + } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void DictionaryAccessExpressionWithArrayAccessHasReferenceToDefaultMemberAtExclamationMark() + { + var class1Code = @" +Public Function Foo(bar As String) As Class1() +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var moduleCode = @" +Private Function Foo() As Class1 + Dim cls As new Class1 + Set Foo = cls!newClassObject(""whatever"") +End Function +"; + + var vbe = MockVbeBuilder.BuildFromModules( + ("Class1", class1Code, ComponentType.ClassModule), + ("Module1", moduleCode, ComponentType.StandardModule)); + + var selection = new Selection(4, 18, 4, 19); + + using (var state = Resolve(vbe.Object)) + { + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "Module1"); + var qualifiedSelection = new QualifiedSelection(module, selection); + var reference = state.DeclarationFinder.IdentifierReferences(qualifiedSelection).First(); + var referencedDeclaration = reference.Declaration; + + var expectedReferencedDeclarationName = "Class1.Foo"; + var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; + + Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + Assert.IsTrue(reference.IsDefaultMemberAccess); + } + } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void DictionaryAccessExpressionWithArrayAccessHasReferenceToDefaultMemberOnEntireContext() + { + var class1Code = @" +Public Function Foo(bar As String) As Class1() +Attribute Foo.VB_UserMemId = 0 +End Function +"; + + var moduleCode = @" +Private Function Foo() As Class1 + Dim cls As new Class1 + Set Foo = cls!newClassObject(0) +End Function +"; + + var vbe = MockVbeBuilder.BuildFromModules( + ("Class1", class1Code, ComponentType.ClassModule), + ("Module1", moduleCode, ComponentType.StandardModule)); + + var selection = new Selection(4, 15, 4, 36); + + using (var state = Resolve(vbe.Object)) + { + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "Module1"); + var qualifiedSelection = new QualifiedSelection(module, selection); + var reference = state.DeclarationFinder.IdentifierReferences(qualifiedSelection).First(); + var referencedDeclaration = reference.Declaration; + + var expectedReferencedDeclarationName = "Class1.Foo"; + var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; + + Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + Assert.IsTrue(reference.IsArrayAccess); + } + } + [Category("Grammar")] [Category("Resolver")] [Test] From c5ab99e68f8a637039cce2e05cf3a517beb123b1 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Wed, 14 Aug 2019 22:37:37 +0200 Subject: [PATCH 17/22] Clarify todos and add comments --- .../Concrete/AssignedByValParameterInspection.cs | 2 ++ .../Bindings/DictionaryAccessDefaultBinding.cs | 2 ++ .../Binding/Bindings/IndexDefaultBinding.cs | 6 ++++-- Rubberduck.Parsing/Grammar/VBAParser.g4 | 2 +- Rubberduck.VBEEditor/Selection.cs | 12 ++++++++++++ 5 files changed, 21 insertions(+), 3 deletions(-) diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/AssignedByValParameterInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/AssignedByValParameterInspection.cs index ddd7af55ce..721580b360 100644 --- a/Rubberduck.CodeAnalysis/Inspections/Concrete/AssignedByValParameterInspection.cs +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/AssignedByValParameterInspection.cs @@ -58,6 +58,8 @@ protected override IEnumerable DoGetInspectionResults() private static bool IsAssignmentToDeclaration(IdentifierReference reference) { + //Todo: Review whether this is still needed once parameterless default member assignments are resolved correctly. + if (!reference.IsAssignment) { return false; diff --git a/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs index 8382ceb50c..822c27f1c3 100644 --- a/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs +++ b/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs @@ -16,6 +16,8 @@ public sealed class DictionaryAccessDefaultBinding : IExpressionBinding private const int DEFAULT_MEMBER_RECURSION_LIMIT = 32; + //This is based on the spec at https://docs.microsoft.com/en-us/openspecs/microsoft_general_purpose_programming_languages/MS-VBAL/f20c9ebc-3365-4614-9788-1cd50a504574 + public DictionaryAccessDefaultBinding( ParserRuleContext expression, IExpressionBinding lExpressionBinding, diff --git a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs index 829d72d10b..6aab3f90a5 100644 --- a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs +++ b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs @@ -16,6 +16,8 @@ public sealed class IndexDefaultBinding : IExpressionBinding private const int DEFAULT_MEMBER_RECURSION_LIMIT = 32; + //This is based on the spec at https://docs.microsoft.com/en-us/openspecs/microsoft_general_purpose_programming_languages/MS-VBAL/551030b2-72a4-4c95-9cb0-fb8f8c8774b4 + public IndexDefaultBinding( ParserRuleContext expression, IExpressionBinding lExpressionBinding, @@ -250,7 +252,7 @@ private IBoundExpression ResolveDefaultMember(IBoundExpression lExpression, stri index expression references this default member and takes on its classification and declared type. - TODO: Improve argument compatibility check. + TODO: Improve argument compatibility check by checking the argument types. */ var parameters = ((IParameterizedDeclaration) defaultMember).Parameters.ToList(); if (ArgumentListIsCompatible(parameters, _argumentList)) @@ -350,7 +352,7 @@ private IBoundExpression ResolveLExpressionDeclaredTypeIsArray(IBoundExpression references an individual element of the array, is classified as a variable and has the declared type of the array’s element type. - TODO: Implement compatibility checking / amend the grammar + TODO: Implement compatibility checking */ return new IndexExpression(indexedDeclaration, ExpressionClassification.Variable, _expression, lExpression, _argumentList, isArrayAccess: true); diff --git a/Rubberduck.Parsing/Grammar/VBAParser.g4 b/Rubberduck.Parsing/Grammar/VBAParser.g4 index fd31ca55e3..a0a42b2723 100644 --- a/Rubberduck.Parsing/Grammar/VBAParser.g4 +++ b/Rubberduck.Parsing/Grammar/VBAParser.g4 @@ -647,7 +647,7 @@ visibility : PRIVATE | PUBLIC | FRIEND | GLOBAL; // 5.6 Expressions expression : // Literal Expression has to come before lExpression, otherwise it'll be classified as simple name expression instead. - //The same holds for Built-in Type Expression. + //The same holds for Built-in Type Expression. whiteSpace? LPAREN whiteSpace? expression whiteSpace? RPAREN # parenthesizedExpr | TYPEOF whiteSpace expression # typeofexpr // To make the grammar SLL, the type-of-is-expression is actually the child of an IS relational op. | HASH expression # markedFileNumberExpr // Added to support special forms such as Input(file1, #file1) diff --git a/Rubberduck.VBEEditor/Selection.cs b/Rubberduck.VBEEditor/Selection.cs index ff5af5bcae..2823a8bf3e 100644 --- a/Rubberduck.VBEEditor/Selection.cs +++ b/Rubberduck.VBEEditor/Selection.cs @@ -142,6 +142,9 @@ public override string ToString() return !(selection1 == selection2); } + /// + /// Orders first by start position and then end position. + /// public static bool operator >(Selection selection1, Selection selection2) { return IsGreaterPosition(selection1.StartLine, selection1.StartColumn, selection2.StartLine, selection2.StartColumn) @@ -156,6 +159,9 @@ private static bool IsGreaterPosition(int line1, int column1, int line2, int col && column1 > column2; } + /// + /// Orders first by start position and then end position. + /// public static bool operator <(Selection selection1, Selection selection2) { return IsLesserPosition(selection1.StartLine, selection1.StartColumn, selection2.StartLine, selection2.StartColumn) @@ -170,11 +176,17 @@ private static bool IsLesserPosition(int line1, int column1, int line2, int colu && column1 < column2; } + /// + /// Orders first by start position and then end position. + /// public static bool operator >=(Selection selection1, Selection selection2) { return !(selection1 < selection2); } + /// + /// Orders first by start position and then end position. + /// public static bool operator <=(Selection selection1, Selection selection2) { return !(selection1 > selection2); From 426dc00c82c074444f0192dccae6ee1364e0a24e Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Thu, 15 Aug 2019 00:09:10 +0200 Subject: [PATCH 18/22] Fix named argument resolution on default member accesses --- .../DictionaryAccessDefaultBinding.cs | 63 ++++++----- .../Binding/Bindings/IndexDefaultBinding.cs | 103 +++++++++--------- RubberduckTests/Grammar/ResolverTests.cs | 40 +++++++ .../Symbols/DeclarationFinderTests.cs | 23 ++-- 4 files changed, 141 insertions(+), 88 deletions(-) diff --git a/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs index 822c27f1c3..507c3e13ad 100644 --- a/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs +++ b/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs @@ -40,9 +40,9 @@ public sealed class DictionaryAccessDefaultBinding : IExpressionBinding _argumentList = argumentList; } - private void ResolveArgumentList(Declaration calledProcedure) + private static void ResolveArgumentList(Declaration calledProcedure, ArgumentList argumentList) { - foreach (var argument in _argumentList.Arguments) + foreach (var argument in argumentList.Arguments) { argument.Resolve(calledProcedure); } @@ -55,49 +55,54 @@ public IBoundExpression Resolve() _lExpression = _lExpressionBinding.Resolve(); } - if (_lExpression.Classification == ExpressionClassification.ResolutionFailed) + return Resolve(_lExpression, _argumentList, _expression); + } + + private static IBoundExpression Resolve(IBoundExpression lExpression, ArgumentList argumentList, ParserRuleContext expression) + { + if (lExpression.Classification == ExpressionClassification.ResolutionFailed) { - ResolveArgumentList(null); - return CreateFailedExpression(_lExpression); + ResolveArgumentList(null, argumentList); + return CreateFailedExpression(lExpression, argumentList); } - var lDeclaration = _lExpression.ReferencedDeclaration; + var lDeclaration = lExpression.ReferencedDeclaration; - if (_lExpression.Classification == ExpressionClassification.Unbound) + if (lExpression.Classification == ExpressionClassification.Unbound) { /* is classified as an unbound member. In this case, the dictionary access expression is classified as an unbound member with a declared type of Variant, referencing with no member name. */ - ResolveArgumentList(lDeclaration); - return new DictionaryAccessExpression(null, ExpressionClassification.Unbound, _expression, _lExpression, _argumentList); + ResolveArgumentList(lDeclaration, argumentList); + return new DictionaryAccessExpression(null, ExpressionClassification.Unbound, expression, lExpression, argumentList); } if (lDeclaration == null) { - ResolveArgumentList(null); - return CreateFailedExpression(_lExpression); + ResolveArgumentList(null, argumentList); + return CreateFailedExpression(lExpression, argumentList); } var asTypeName = lDeclaration.AsTypeName; var asTypeDeclaration = lDeclaration.AsTypeDeclaration; - return ResolveViaDefaultMember(_lExpression, asTypeName, asTypeDeclaration); + return ResolveViaDefaultMember(lExpression, asTypeName, asTypeDeclaration, argumentList, expression); } - private IBoundExpression CreateFailedExpression(IBoundExpression lExpression) + private static IBoundExpression CreateFailedExpression(IBoundExpression lExpression, ArgumentList argumentList) { var failedExpr = new ResolutionFailedExpression(); failedExpr.AddSuccessfullyResolvedExpression(lExpression); - foreach (var arg in _argumentList.Arguments) + foreach (var arg in argumentList.Arguments) { failedExpr.AddSuccessfullyResolvedExpression(arg.Expression); } return failedExpr; - } + } - private IBoundExpression ResolveViaDefaultMember(IBoundExpression lExpression, string asTypeName, Declaration asTypeDeclaration, int recursionDepth = 0) + private static IBoundExpression ResolveViaDefaultMember(IBoundExpression lExpression, string asTypeName, Declaration asTypeDeclaration, ArgumentList argumentList, ParserRuleContext expression, int recursionDepth = 0) { if (Tokens.Variant.Equals(asTypeName, StringComparison.InvariantCultureIgnoreCase) || Tokens.Object.Equals(asTypeName, StringComparison.InvariantCultureIgnoreCase)) @@ -107,8 +112,8 @@ private IBoundExpression ResolveViaDefaultMember(IBoundExpression lExpression, s In this case, the dictionary access expression is classified as an unbound member with a declared type of Variant, referencing with no member name. */ - ResolveArgumentList(null); - return new DictionaryAccessExpression(null, ExpressionClassification.Unbound, _expression, lExpression, _argumentList); + ResolveArgumentList(null, argumentList); + return new DictionaryAccessExpression(null, ExpressionClassification.Unbound, expression, lExpression, argumentList); } /* @@ -120,8 +125,8 @@ private IBoundExpression ResolveViaDefaultMember(IBoundExpression lExpression, s || !IsPropertyGetLetFunctionProcedure(defaultMember) || !IsPublic(defaultMember)) { - ResolveArgumentList(null); - return CreateFailedExpression(lExpression); + ResolveArgumentList(null, argumentList); + return CreateFailedExpression(lExpression, argumentList); } var defaultMemberClassification = DefaultMemberClassification(defaultMember); @@ -135,8 +140,8 @@ private IBoundExpression ResolveViaDefaultMember(IBoundExpression lExpression, s dictionary access expression references this default member and takes on its classification and declared type. */ - ResolveArgumentList(defaultMember); - return new DictionaryAccessExpression(defaultMember, defaultMemberClassification, _expression, lExpression, _argumentList); + ResolveArgumentList(defaultMember, argumentList); + return new DictionaryAccessExpression(defaultMember, defaultMemberClassification, expression, lExpression, argumentList); } if (parameters.Count(param => !param.IsOptional) == 0 @@ -148,11 +153,11 @@ declared type. same . */ - return ResolveRecursiveDefaultMember(defaultMember, defaultMemberClassification, recursionDepth); + return ResolveRecursiveDefaultMember(defaultMember, defaultMemberClassification, argumentList, expression, recursionDepth); } - ResolveArgumentList(null); - return CreateFailedExpression(lExpression); + ResolveArgumentList(null, argumentList); + return CreateFailedExpression(lExpression, argumentList); } private static bool IsCompatibleWithOneStringArgument(List parameters) @@ -163,9 +168,9 @@ private static bool IsCompatibleWithOneStringArgument(List || Tokens.Variant.Equals(parameters[0].AsTypeName, StringComparison.InvariantCultureIgnoreCase)); } - private IBoundExpression ResolveRecursiveDefaultMember(Declaration defaultMember, ExpressionClassification defaultMemberClassification, int recursionDepth) + private static IBoundExpression ResolveRecursiveDefaultMember(Declaration defaultMember, ExpressionClassification defaultMemberClassification, ArgumentList argumentList, ParserRuleContext expression, int recursionDepth) { - var defaultMemberAsLExpression = new SimpleNameExpression(defaultMember, defaultMemberClassification, _expression); + var defaultMemberAsLExpression = new SimpleNameExpression(defaultMember, defaultMemberClassification, expression); var defaultMemberAsTypeName = defaultMember.AsTypeName; var defaultMemberAsTypeDeclaration = defaultMember.AsTypeDeclaration; @@ -173,6 +178,8 @@ private IBoundExpression ResolveRecursiveDefaultMember(Declaration defaultMember defaultMemberAsLExpression, defaultMemberAsTypeName, defaultMemberAsTypeDeclaration, + argumentList, + expression, recursionDepth + 1); } @@ -193,7 +200,7 @@ private static bool IsPublic(Declaration declaration) || accessibility == Accessibility.Public; } - private ExpressionClassification DefaultMemberClassification(Declaration defaultMember) + private static ExpressionClassification DefaultMemberClassification(Declaration defaultMember) { if (defaultMember.DeclarationType.HasFlag(DeclarationType.Property)) { diff --git a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs index 6aab3f90a5..cfeb56821f 100644 --- a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs +++ b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs @@ -40,9 +40,9 @@ public sealed class IndexDefaultBinding : IExpressionBinding _argumentList = argumentList; } - private void ResolveArgumentList(Declaration calledProcedure) + private static void ResolveArgumentList(Declaration calledProcedure, ArgumentList argumentList) { - foreach (var argument in _argumentList.Arguments) + foreach (var argument in argumentList.Arguments) { argument.Resolve(calledProcedure); } @@ -54,37 +54,31 @@ public IBoundExpression Resolve() { _lExpression = _lExpressionBinding.Resolve(); } - if (_lExpression.Classification != ExpressionClassification.ResolutionFailed) - { - ResolveArgumentList(_lExpression.ReferencedDeclaration); - } - else - { - ResolveArgumentList(null); - } - return Resolve(_lExpression); + + return Resolve(_lExpression, _argumentList, _expression); } - private IBoundExpression Resolve(IBoundExpression lExpression, int defaultMemberResolutionRecursionDepth = 0) + private static IBoundExpression Resolve(IBoundExpression lExpression, ArgumentList argumentList, ParserRuleContext expression, int defaultMemberResolutionRecursionDepth = 0) { if (lExpression.Classification == ExpressionClassification.ResolutionFailed) { - return CreateFailedExpression(lExpression); + ResolveArgumentList(null, argumentList); + return CreateFailedExpression(lExpression, argumentList); } if (lExpression.Classification == ExpressionClassification.Unbound) { - return ResolveLExpressionIsUnbound(lExpression); + return ResolveLExpressionIsUnbound(lExpression, argumentList, expression); } if(lExpression.ReferencedDeclaration != null) { - if (_argumentList.HasArguments) + if (argumentList.HasArguments) { switch (lExpression) { case IndexExpression indexExpression: - var doubleIndexExpression = ResolveLExpressionIsIndexExpression(indexExpression, defaultMemberResolutionRecursionDepth); + var doubleIndexExpression = ResolveLExpressionIsIndexExpression(indexExpression, argumentList, expression, defaultMemberResolutionRecursionDepth); if (doubleIndexExpression != null) { return doubleIndexExpression; @@ -92,7 +86,7 @@ private IBoundExpression Resolve(IBoundExpression lExpression, int defaultMember break; case DictionaryAccessExpression dictionaryAccessExpression: - var indexOnBangExpression = ResolveLExpressionIsDictionaryAccessExpression(dictionaryAccessExpression, defaultMemberResolutionRecursionDepth); + var indexOnBangExpression = ResolveLExpressionIsDictionaryAccessExpression(dictionaryAccessExpression, argumentList, expression, defaultMemberResolutionRecursionDepth); if (indexOnBangExpression != null) { return indexOnBangExpression; @@ -104,7 +98,7 @@ private IBoundExpression Resolve(IBoundExpression lExpression, int defaultMember if (IsVariablePropertyFunctionWithoutParameters(lExpression)) { - var parameterlessLExpressionAccess = ResolveLExpressionIsVariablePropertyFunctionNoParameters(lExpression, defaultMemberResolutionRecursionDepth); + var parameterlessLExpressionAccess = ResolveLExpressionIsVariablePropertyFunctionNoParameters(lExpression, argumentList, expression, defaultMemberResolutionRecursionDepth); if (parameterlessLExpressionAccess != null) { return parameterlessLExpressionAccess; @@ -116,24 +110,25 @@ private IBoundExpression Resolve(IBoundExpression lExpression, int defaultMember || lExpression.Classification == ExpressionClassification.Function || lExpression.Classification == ExpressionClassification.Subroutine) { - return ResolveLExpressionIsPropertyFunctionSubroutine(lExpression); + return ResolveLExpressionIsPropertyFunctionSubroutine(lExpression, argumentList, expression); } - return CreateFailedExpression(lExpression); + ResolveArgumentList(null, argumentList); + return CreateFailedExpression(lExpression, argumentList); } - private IBoundExpression CreateFailedExpression(IBoundExpression lExpression) + private static IBoundExpression CreateFailedExpression(IBoundExpression lExpression, ArgumentList argumentList) { var failedExpr = new ResolutionFailedExpression(); failedExpr.AddSuccessfullyResolvedExpression(lExpression); - foreach (var arg in _argumentList.Arguments) + foreach (var arg in argumentList.Arguments) { failedExpr.AddSuccessfullyResolvedExpression(arg.Expression); } return failedExpr; } - private IBoundExpression ResolveLExpressionIsVariablePropertyFunctionNoParameters(IBoundExpression lExpression, int defaultMemberResolutionRecursionDepth) + private static IBoundExpression ResolveLExpressionIsVariablePropertyFunctionNoParameters(IBoundExpression lExpression, ArgumentList argumentList, ParserRuleContext expression, int defaultMemberResolutionRecursionDepth) { /* is classified as a variable, or is classified as a property or function @@ -151,13 +146,13 @@ private IBoundExpression ResolveLExpressionIsVariablePropertyFunctionNoParameter if (indexedDeclaration.IsArray) { - return ResolveLExpressionDeclaredTypeIsArray(lExpression); + return ResolveLExpressionDeclaredTypeIsArray(lExpression, argumentList, expression); } var asTypeName = indexedDeclaration.AsTypeName; var asTypeDeclaration = indexedDeclaration.AsTypeDeclaration; - return ResolveDefaultMember(lExpression, asTypeName, asTypeDeclaration, defaultMemberResolutionRecursionDepth); + return ResolveDefaultMember(lExpression, asTypeName, asTypeDeclaration, argumentList, expression, defaultMemberResolutionRecursionDepth); } private static bool IsVariablePropertyFunctionWithoutParameters(IBoundExpression lExpression) @@ -174,7 +169,7 @@ private static bool IsVariablePropertyFunctionWithoutParameters(IBoundExpression } } - private IBoundExpression ResolveLExpressionIsIndexExpression(IndexExpression indexExpression, int defaultMemberResolutionRecursionDepth = 0) + private static IBoundExpression ResolveLExpressionIsIndexExpression(IndexExpression indexExpression, ArgumentList argumentList, ParserRuleContext expression, int defaultMemberResolutionRecursionDepth = 0) { /* is classified as an index expression and the argument list is not empty. @@ -192,16 +187,16 @@ private IBoundExpression ResolveLExpressionIsIndexExpression(IndexExpression ind //via the default member path. if (indexedDeclaration.IsArray && !indexExpression.IsArrayAccess) { - return ResolveLExpressionDeclaredTypeIsArray(indexExpression); + return ResolveLExpressionDeclaredTypeIsArray(indexExpression, argumentList, expression); } var asTypeName = indexedDeclaration.AsTypeName; var asTypeDeclaration = indexedDeclaration.AsTypeDeclaration; - return ResolveDefaultMember(indexExpression, asTypeName, asTypeDeclaration, defaultMemberResolutionRecursionDepth); + return ResolveDefaultMember(indexExpression, asTypeName, asTypeDeclaration, argumentList, expression, defaultMemberResolutionRecursionDepth); } - private IBoundExpression ResolveLExpressionIsDictionaryAccessExpression(DictionaryAccessExpression dictionaryAccessExpression, int defaultMemberResolutionRecursionDepth = 0) + private static IBoundExpression ResolveLExpressionIsDictionaryAccessExpression(DictionaryAccessExpression dictionaryAccessExpression, ArgumentList argumentList, ParserRuleContext expression, int defaultMemberResolutionRecursionDepth) { //This is equivalent to the case in which the lExpression is an IndexExpression with the difference that it cannot be an array access. @@ -213,16 +208,16 @@ private IBoundExpression ResolveLExpressionIsDictionaryAccessExpression(Dictiona if (indexedDeclaration.IsArray) { - return ResolveLExpressionDeclaredTypeIsArray(dictionaryAccessExpression); + return ResolveLExpressionDeclaredTypeIsArray(dictionaryAccessExpression, argumentList, expression); } var asTypeName = indexedDeclaration.AsTypeName; var asTypeDeclaration = indexedDeclaration.AsTypeDeclaration; - return ResolveDefaultMember(dictionaryAccessExpression, asTypeName, asTypeDeclaration, defaultMemberResolutionRecursionDepth); + return ResolveDefaultMember(dictionaryAccessExpression, asTypeName, asTypeDeclaration, argumentList, expression, defaultMemberResolutionRecursionDepth); } - private IBoundExpression ResolveDefaultMember(IBoundExpression lExpression, string asTypeName, Declaration asTypeDeclaration, int defaultMemberResolutionRecursionDepth) + private static IBoundExpression ResolveDefaultMember(IBoundExpression lExpression, string asTypeName, Declaration asTypeDeclaration, ArgumentList argumentList, ParserRuleContext expression, int defaultMemberResolutionRecursionDepth) { /* The declared type of is Object or Variant, and contains no @@ -232,9 +227,10 @@ private IBoundExpression ResolveDefaultMember(IBoundExpression lExpression, stri if ( (Tokens.Variant.Equals(asTypeName, StringComparison.InvariantCultureIgnoreCase) || Tokens.Object.Equals(asTypeName, StringComparison.InvariantCultureIgnoreCase)) - && !_argumentList.HasNamedArguments) + && !argumentList.HasNamedArguments) { - return new IndexExpression(null, ExpressionClassification.Unbound, _expression, lExpression, _argumentList, isDefaultMemberAccess: true); + ResolveArgumentList(null, argumentList); + return new IndexExpression(null, ExpressionClassification.Unbound, expression, lExpression, argumentList, isDefaultMemberAccess: true); } /* The declared type of is a specific class, which has a public default Property @@ -255,9 +251,10 @@ declared type. TODO: Improve argument compatibility check by checking the argument types. */ var parameters = ((IParameterizedDeclaration) defaultMember).Parameters.ToList(); - if (ArgumentListIsCompatible(parameters, _argumentList)) + if (ArgumentListIsCompatible(parameters, argumentList)) { - return new IndexExpression(defaultMember, defaultMemberClassification, _expression, _lExpression, _argumentList, isDefaultMemberAccess: true); + ResolveArgumentList(defaultMember, argumentList); + return new IndexExpression(defaultMember, defaultMemberClassification, expression, lExpression, argumentList, isDefaultMemberAccess: true); } /** @@ -268,7 +265,7 @@ declared type. if (parameters.Count(parameter => !parameter.IsOptional) == 0 && DEFAULT_MEMBER_RECURSION_LIMIT > defaultMemberResolutionRecursionDepth) { - return ResolveRecursiveDefaultMember(defaultMember, defaultMemberClassification, defaultMemberResolutionRecursionDepth); + return ResolveRecursiveDefaultMember(defaultMember, defaultMemberClassification, argumentList, expression, defaultMemberResolutionRecursionDepth); } } @@ -282,10 +279,10 @@ private static bool ArgumentListIsCompatible(ICollection p && parameters.Count(parameter => !parameter.IsOptional) <= argumentList.Arguments.Count; } - private IBoundExpression ResolveRecursiveDefaultMember(Declaration defaultMember, ExpressionClassification defaultMemberClassification, int defaultMemberResolutionRecursionDepth) + private static IBoundExpression ResolveRecursiveDefaultMember(Declaration defaultMember, ExpressionClassification defaultMemberClassification, ArgumentList argumentList, ParserRuleContext expression, int defaultMemberResolutionRecursionDepth) { - var defaultMemberAsLExpression = new SimpleNameExpression(defaultMember, defaultMemberClassification, _expression); - return Resolve(defaultMemberAsLExpression, defaultMemberResolutionRecursionDepth + 1); + var defaultMemberAsLExpression = new SimpleNameExpression(defaultMember, defaultMemberClassification, expression); + return Resolve(defaultMemberAsLExpression, argumentList, expression, defaultMemberResolutionRecursionDepth + 1); } private static ExpressionClassification DefaultMemberExpressionClassification(Declaration defaultMember) @@ -320,10 +317,11 @@ private static bool IsPublic(Declaration declaration) || accessibility == Accessibility.Public; } - private IBoundExpression ResolveLExpressionDeclaredTypeIsArray(IBoundExpression lExpression) + private static IBoundExpression ResolveLExpressionDeclaredTypeIsArray(IBoundExpression lExpression, ArgumentList argumentList, ParserRuleContext expression) { var indexedDeclaration = lExpression.ReferencedDeclaration; - if (!indexedDeclaration?.IsArray ?? false) + if (indexedDeclaration == null + || !indexedDeclaration.IsArray) { return null; } @@ -333,18 +331,18 @@ private IBoundExpression ResolveLExpressionDeclaredTypeIsArray(IBoundExpression been specified for it, and one of the following is true: */ - if (!_argumentList.HasArguments) + if (!argumentList.HasArguments) { /* represents an empty argument list. In this case, the index expression takes on the classification and declared type of and references the same array. */ - - return new IndexExpression(indexedDeclaration, lExpression.Classification, _expression, lExpression, _argumentList); + ResolveArgumentList(indexedDeclaration, argumentList); + return new IndexExpression(indexedDeclaration, lExpression.Classification, expression, lExpression, argumentList); } - if (!_argumentList.HasNamedArguments) + if (!argumentList.HasNamedArguments) { /* represents an argument list with a number of positional arguments equal @@ -355,13 +353,14 @@ private IBoundExpression ResolveLExpressionDeclaredTypeIsArray(IBoundExpression TODO: Implement compatibility checking */ - return new IndexExpression(indexedDeclaration, ExpressionClassification.Variable, _expression, lExpression, _argumentList, isArrayAccess: true); + ResolveArgumentList(indexedDeclaration.AsTypeDeclaration, argumentList); + return new IndexExpression(indexedDeclaration, ExpressionClassification.Variable, expression, lExpression, argumentList, isArrayAccess: true); } return null; } - private IBoundExpression ResolveLExpressionIsPropertyFunctionSubroutine(IBoundExpression lExpression) + private static IBoundExpression ResolveLExpressionIsPropertyFunctionSubroutine(IBoundExpression lExpression, ArgumentList argumentList, ParserRuleContext expression) { /* is classified as a property or function and its parameter list is compatible with @@ -374,16 +373,18 @@ private IBoundExpression ResolveLExpressionIsPropertyFunctionSubroutine(IBoundEx Note: We assume compatibility through enforcement by the VBE. */ - return new IndexExpression(lExpression.ReferencedDeclaration, lExpression.Classification, _expression, lExpression, _argumentList); + ResolveArgumentList(lExpression.ReferencedDeclaration, argumentList); + return new IndexExpression(lExpression.ReferencedDeclaration, lExpression.Classification, expression, lExpression, argumentList); } - private IBoundExpression ResolveLExpressionIsUnbound(IBoundExpression lExpression) + private static IBoundExpression ResolveLExpressionIsUnbound(IBoundExpression lExpression, ArgumentList argumentList, ParserRuleContext expression) { /* is classified as an unbound member. In this case, the index expression references , is classified as an unbound member and its declared type is Variant. */ - return new IndexExpression(lExpression.ReferencedDeclaration, ExpressionClassification.Unbound, _expression, lExpression, _argumentList); + ResolveArgumentList(lExpression.ReferencedDeclaration, argumentList); + return new IndexExpression(lExpression.ReferencedDeclaration, ExpressionClassification.Unbound, expression, lExpression, argumentList); } } } diff --git a/RubberduckTests/Grammar/ResolverTests.cs b/RubberduckTests/Grammar/ResolverTests.cs index 52b80a3345..fb19235a28 100644 --- a/RubberduckTests/Grammar/ResolverTests.cs +++ b/RubberduckTests/Grammar/ResolverTests.cs @@ -3566,5 +3566,45 @@ End Sub Assert.IsTrue(reference.IsAssignment); } } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void NamedArgumentOfIndexExpressionWithDefaultMemberAccessHasReferenceToParameter() + { + var classCode = @" +Public Function Foo(index As Long) As String +Attribute Foo.VB_UserMemId = 0 + Set Foo = ""Hello"" +End Function +"; + + var moduleCode = @" +Private Function Foo() As String + Dim cls As new Class1 + Foo = cls(index:=0) +End Function +"; + + var vbe = MockVbeBuilder.BuildFromModules( + ("Class1", classCode, ComponentType.ClassModule), + ("Module1", moduleCode, ComponentType.StandardModule)); + + var selection = new Selection(4, 15, 4, 20); + + using (var state = Resolve(vbe.Object)) + { + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName == "Module1"); + var qualifiedSelection = new QualifiedSelection(module, selection); + var memberReference = state.DeclarationFinder.ContainingIdentifierReferences(qualifiedSelection).Last(); + var referencedDeclaration = memberReference.Declaration; + + var expectedReferencedDeclarationName = "TestProject1.Class1.Foo.index"; + var actualReferencedDeclarationName = $"{referencedDeclaration.ParentScope}.{referencedDeclaration.IdentifierName}"; + + Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + Assert.AreEqual(DeclarationType.Parameter, referencedDeclaration.DeclarationType); + } + } } } diff --git a/RubberduckTests/Symbols/DeclarationFinderTests.cs b/RubberduckTests/Symbols/DeclarationFinderTests.cs index b85005495d..15d335c41e 100644 --- a/RubberduckTests/Symbols/DeclarationFinderTests.cs +++ b/RubberduckTests/Symbols/DeclarationFinderTests.cs @@ -1156,7 +1156,6 @@ End Function [Category("Resolver")] [Test] - [Ignore("Temporarily ignored, the mock or serialization appears to be broken (works in release as of 7/16/2018); see issue #4191 for background")] public void Identify_NamedParameter_Parameter_FromExcel() { const string code = @" @@ -1183,7 +1182,7 @@ public void Identify_NamedParameter_Parameter_FromExcel() [Category("Resolver")] [Test] - [Ignore("Need to fix the default member access for function calls; see case #3937")] + //[Ignore("Need to fix the default member access for function calls; see case #3937")] public void Identify_NamedParameter_Parameter_FromExcel_DefaultAccess() { // Note that ColumnIndex is actually a parameter of the _Default default member @@ -1197,20 +1196,26 @@ public void Identify_NamedParameter_Parameter_FromExcel_DefaultAccess() End Sub"; var vbe = new MockVbeBuilder() .ProjectBuilder("TestProject", ProjectProtection.Unprotected) - .AddComponent("TestModule", ComponentType.StandardModule, code, new Selection(6, 22)) + .AddComponent("TestModule", ComponentType.StandardModule, code) .AddReference("Excel", MockVbeBuilder.LibraryPathMsExcel, 1, 8, true) .AddProjectToVbeBuilder() .Build(); + var selection = new Selection(6, 21, 6, 32); + using (var state = MockParser.CreateAndParse(vbe.Object)) { - var expected = state.DeclarationFinder.DeclarationsWithType(DeclarationType.Parameter).Single(p => - !p.IsUserDefined && p.IdentifierName == "ColumnIndex" && - p.ParentScope == "EXCEL.EXE;Excel.Range._Default"); - var actual = state.DeclarationFinder.FindSelectedDeclaration(vbe.Object.ActiveCodePane); + var module = state.DeclarationFinder.AllModules.First(qmn => qmn.ComponentName.Equals("TestModule")); + var qualifiedSelection = new QualifiedSelection(module, selection); + + var reference = state.DeclarationFinder.IdentifierReferences(qualifiedSelection).First(); + var referencedDeclaration = reference.Declaration; + + var expectedReferencedDeclarationName = "EXCEL.EXE;Excel.Range._Default.Let.ColumnIndex"; + var actualReferencedDeclarationName = $"{referencedDeclaration.ParentScope}.{referencedDeclaration.IdentifierName}"; - Assert.AreEqual(expected, actual, "Expected {0}, resolved to {1}", expected.DeclarationType, - actual.DeclarationType); + Assert.AreEqual(expectedReferencedDeclarationName, actualReferencedDeclarationName); + Assert.AreEqual(DeclarationType.Parameter, referencedDeclaration.DeclarationType); } } From 7a7f2e7ca1b707391dd9cce5c6dd3b9af9100e63 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Thu, 15 Aug 2019 00:47:22 +0200 Subject: [PATCH 19/22] Set Severity of SetAssignmentWithIncompatibleObjectTypeInspection to Error --- .../SetAssignmentWithIncompatibleObjectTypeInspection.cs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs index 5f98fdf1a5..fea530722f 100644 --- a/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs @@ -5,6 +5,7 @@ using Rubberduck.Inspections.Results; using Rubberduck.Parsing; using Rubberduck.Parsing.Grammar; +using Rubberduck.Parsing.Inspections; using Rubberduck.Parsing.Inspections.Abstract; using Rubberduck.Parsing.Symbols; using Rubberduck.Parsing.TypeResolvers; @@ -85,6 +86,9 @@ public SetAssignmentWithIncompatibleObjectTypeInspection(RubberduckParserState s { _declarationFinderProvider = state; _setTypeResolver = setTypeResolver; + + //This will most likely cause a runtime error. The exceptions are rare and should be refactored or made explicit with an @Ignore annotation. + Severity = CodeInspectionSeverity.Error; } protected override IEnumerable DoGetInspectionResults() From 8668b13e2ce99b65139eb4d81542f5bd155971e5 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Thu, 15 Aug 2019 01:15:35 +0200 Subject: [PATCH 20/22] Unignore tests passing now --- RubberduckTests/Grammar/ResolverTests.cs | 4 ++-- RubberduckTests/Grammar/VBAParserTests.cs | 4 ++-- .../ImplicitActiveWorkbookReferenceInspectionTests.cs | 1 - .../Inspections/ObjectVariableNotSetInspectionTests.cs | 4 ++-- .../Inspections/SheetAccessedUsingStringInspectionTests.cs | 1 - RubberduckTests/Symbols/DeclarationFinderTests.cs | 1 - 6 files changed, 6 insertions(+), 9 deletions(-) diff --git a/RubberduckTests/Grammar/ResolverTests.cs b/RubberduckTests/Grammar/ResolverTests.cs index fb19235a28..2de938dd6f 100644 --- a/RubberduckTests/Grammar/ResolverTests.cs +++ b/RubberduckTests/Grammar/ResolverTests.cs @@ -3096,7 +3096,7 @@ End Function [Category("Grammar")] [Category("Resolver")] [Test] - public void ChainedDictionaryAccessExpressionHasReferenceToDefaultMemberAtSecondExclamationMark() + public void ChainedDictionaryAccessExpressionHasReferenceToDefaultMemberAtFirstExclamationMark() { var class1Code = @" Public Function Foo(bar As String) As Class2 @@ -3144,7 +3144,7 @@ End Function [Category("Grammar")] [Category("Resolver")] [Test] - public void ChainedDictionaryAccessExpressionHasReferenceToDefaultMemberAtFirstExclamationMark() + public void ChainedDictionaryAccessExpressionHasReferenceToDefaultMemberAtSecondExclamationMark() { var class1Code = @" Public Function Foo(bar As String) As Class2 diff --git a/RubberduckTests/Grammar/VBAParserTests.cs b/RubberduckTests/Grammar/VBAParserTests.cs index 440b259f6b..20fdb065bb 100644 --- a/RubberduckTests/Grammar/VBAParserTests.cs +++ b/RubberduckTests/Grammar/VBAParserTests.cs @@ -3170,7 +3170,7 @@ End Sub [Test] - [Ignore("This cannot work with the current setup of identifiers bacause the SLL parser confuses the bang for a type hint.")] + [Ignore("This cannot work with the current setup of identifiers because the SLL parser confuses the bang for a type hint.")] public void ParserDoesNotFailOnBangOperatorOnForeignIdentifier() { const string code = @" @@ -3201,7 +3201,7 @@ End Sub [Test] - [Ignore("This cannot work with the current setup of identifiers bacause the SLL parser confuses the bang for a type hint.")] + [Ignore("This cannot work with the current setup of identifiers because the SLL parser confuses the bang for a type hint.")] public void ParserDoesNotFailOnStackedBangOperator_ForeignIdentifier() { const string code = @" diff --git a/RubberduckTests/Inspections/ImplicitActiveWorkbookReferenceInspectionTests.cs b/RubberduckTests/Inspections/ImplicitActiveWorkbookReferenceInspectionTests.cs index 4d91cb2d19..235c08be4f 100644 --- a/RubberduckTests/Inspections/ImplicitActiveWorkbookReferenceInspectionTests.cs +++ b/RubberduckTests/Inspections/ImplicitActiveWorkbookReferenceInspectionTests.cs @@ -11,7 +11,6 @@ namespace RubberduckTests.Inspections public class ImplicitActiveWorkbookReferenceInspectionTests { [Test] - [Ignore("This was apparently only passing due to the test setup. See #4404")] [Category("Inspections")] public void ImplicitActiveWorkbookReference_ReportsWorksheets() { diff --git a/RubberduckTests/Inspections/ObjectVariableNotSetInspectionTests.cs b/RubberduckTests/Inspections/ObjectVariableNotSetInspectionTests.cs index fb532c6e30..776d31c53d 100644 --- a/RubberduckTests/Inspections/ObjectVariableNotSetInspectionTests.cs +++ b/RubberduckTests/Inspections/ObjectVariableNotSetInspectionTests.cs @@ -304,9 +304,9 @@ End Enum // This is a corner case similar to #4037. Previously, Collection's default member was not being generated correctly in // when it was loaded by the COM collector (_Collection is missing the default interface flag). After picking up that member - // this test fails because it resolves as attempting to assign 'New Colletion' to `Test.DefaultMember`. + // this test fails because it resolves as attempting to assign 'New Collection' to `Test.DefaultMember`. [Test] - [Ignore("Broken by COM collector fix. See comment on test.")] + //[Ignore("Broken by COM collector fix. See comment on test.")] [Category("Inspections")] public void ObjectVariableNotSet_FunctionReturnNotSet_ReturnsResult() { diff --git a/RubberduckTests/Inspections/SheetAccessedUsingStringInspectionTests.cs b/RubberduckTests/Inspections/SheetAccessedUsingStringInspectionTests.cs index 0961effa82..0920b92925 100644 --- a/RubberduckTests/Inspections/SheetAccessedUsingStringInspectionTests.cs +++ b/RubberduckTests/Inspections/SheetAccessedUsingStringInspectionTests.cs @@ -14,7 +14,6 @@ namespace RubberduckTests.Inspections public class SheetAccessedUsingStringInspectionTests { [Test] - [Ignore("See #4411")] [Category("Inspections")] public void SheetAccessedUsingString_ReturnsResult_AccessingUsingWorkbookModule() { diff --git a/RubberduckTests/Symbols/DeclarationFinderTests.cs b/RubberduckTests/Symbols/DeclarationFinderTests.cs index 15d335c41e..44ee33212f 100644 --- a/RubberduckTests/Symbols/DeclarationFinderTests.cs +++ b/RubberduckTests/Symbols/DeclarationFinderTests.cs @@ -1182,7 +1182,6 @@ public void Identify_NamedParameter_Parameter_FromExcel() [Category("Resolver")] [Test] - //[Ignore("Need to fix the default member access for function calls; see case #3937")] public void Identify_NamedParameter_Parameter_FromExcel_DefaultAccess() { // Note that ColumnIndex is actually a parameter of the _Default default member From 2fe9ab92991e5a27b9378d9589afd7f5e8e74d06 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Thu, 15 Aug 2019 18:33:52 +0200 Subject: [PATCH 21/22] Fix comments --- .../SetAssignmentWithIncompatibleObjectTypeInspection.cs | 4 ++-- Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs | 2 +- Rubberduck.Resources/Inspections/InspectionNames.Designer.cs | 2 +- Rubberduck.Resources/Inspections/InspectionNames.resx | 2 +- .../Inspections/ObjectVariableNotSetInspectionTests.cs | 1 - 5 files changed, 5 insertions(+), 6 deletions(-) diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs index fea530722f..3e36abb14c 100644 --- a/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs @@ -27,7 +27,7 @@ public class SetAssignmentWithIncompatibleObjectTypeInspection : InspectionBase /// /// The VBA compiler does not check whether different object types are compatible. Instead there is a runtime error whenever the types are incompatible. /// - /// + /// /// /// - /// + /// /// - /// Looks up a localized string similar to Set Assignment With Incompatible Object Type. + /// Looks up a localized string similar to Set assignment with incompatible object type. /// public static string SetAssignmentWithIncompatibleObjectTypeInspection { get { diff --git a/Rubberduck.Resources/Inspections/InspectionNames.resx b/Rubberduck.Resources/Inspections/InspectionNames.resx index c6e886c348..957906a7ba 100644 --- a/Rubberduck.Resources/Inspections/InspectionNames.resx +++ b/Rubberduck.Resources/Inspections/InspectionNames.resx @@ -387,7 +387,7 @@ Use of obsolete 'While...Wend' statement - Set Assignment With Incompatible Object Type + Set assignment with incompatible object type Empty method diff --git a/RubberduckTests/Inspections/ObjectVariableNotSetInspectionTests.cs b/RubberduckTests/Inspections/ObjectVariableNotSetInspectionTests.cs index 776d31c53d..eedae28ffd 100644 --- a/RubberduckTests/Inspections/ObjectVariableNotSetInspectionTests.cs +++ b/RubberduckTests/Inspections/ObjectVariableNotSetInspectionTests.cs @@ -306,7 +306,6 @@ End Enum // when it was loaded by the COM collector (_Collection is missing the default interface flag). After picking up that member // this test fails because it resolves as attempting to assign 'New Collection' to `Test.DefaultMember`. [Test] - //[Ignore("Broken by COM collector fix. See comment on test.")] [Category("Inspections")] public void ObjectVariableNotSet_FunctionReturnNotSet_ReturnsResult() { From 0ba0c90c79ea3a8248e8b2b9bdfd88342caecfe1 Mon Sep 17 00:00:00 2001 From: Max Doerner Date: Thu, 15 Aug 2019 19:14:16 +0200 Subject: [PATCH 22/22] Remove restriction to variables on SetAssignmentWithIncompatibleObjectTypeInspection Also changes the way the set assignments are obtained to increase performance when libraries are referenced. --- ...entWithIncompatibleObjectTypeInspection.cs | 23 ++-- .../Rubberduck.CodeAnalysis.xml | 4 +- ...thIncompatibleObjectTypeInspectionTests.cs | 120 +++++++++++++++++- 3 files changed, 131 insertions(+), 16 deletions(-) diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs index 3e36abb14c..4804a76f7d 100644 --- a/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs @@ -95,28 +95,25 @@ protected override IEnumerable DoGetInspectionResults() { var finder = _declarationFinderProvider.DeclarationFinder; - var offendingAssignments = StronglyTypedObjectVariables(finder) - .SelectMany(SetAssignments) + var setAssignments = finder.AllIdentifierReferences().Where(reference => reference.IsSetAssignment); + + var offendingAssignments = setAssignments + .Where(ToBeConsidered) .Select(setAssignment => SetAssignmentWithAssignedTypeName(setAssignment, finder)) .Where(setAssignmentWithAssignedTypeName => setAssignmentWithAssignedTypeName.assignedTypeName != null - && !SetAssignmentPossiblyLegal(setAssignmentWithAssignedTypeName)); + && !SetAssignmentPossiblyLegal(setAssignmentWithAssignedTypeName)); return offendingAssignments .Where(setAssignmentWithAssignedTypeName => !IsIgnored(setAssignmentWithAssignedTypeName.setAssignment)) .Select(setAssignmentWithAssignedTypeName => InspectionResult(setAssignmentWithAssignedTypeName, _declarationFinderProvider)); } - - private IEnumerable StronglyTypedObjectVariables(DeclarationFinder declarationFinder) - { - return declarationFinder.DeclarationsWithType(DeclarationType.Variable) - .Where(declaration => declaration.IsObject - && declaration.AsTypeDeclaration != null); - } - - private IEnumerable SetAssignments(Declaration declaration) + private static bool ToBeConsidered(IdentifierReference reference) { - return declaration.References.Where(reference => reference.IsSetAssignment); + var declaration = reference.Declaration; + return declaration != null + && declaration.AsTypeDeclaration != null + && declaration.IsObject; } private (IdentifierReference setAssignment, string assignedTypeName) SetAssignmentWithAssignedTypeName(IdentifierReference setAssignment, DeclarationFinder finder) diff --git a/Rubberduck.CodeAnalysis/Rubberduck.CodeAnalysis.xml b/Rubberduck.CodeAnalysis/Rubberduck.CodeAnalysis.xml index 55209f029a..d1f8fd29ab 100644 --- a/Rubberduck.CodeAnalysis/Rubberduck.CodeAnalysis.xml +++ b/Rubberduck.CodeAnalysis/Rubberduck.CodeAnalysis.xml @@ -72,7 +72,7 @@ The VBA compiler does not check whether different object types are compatible. Instead there is a runtime error whenever the types are incompatible. - + - + (); + setTypeResolverMock.Setup(m => + m.SetTypeName(It.IsAny(), It.IsAny())) + .Returns((VBAParser.ExpressionContext context, QualifiedModuleName qmn) => expressionFullTypeName); + + var inspectionResults = InspectionResults(vbe, setTypeResolverMock.Object).ToList(); + + Assert.AreEqual(expectedResultsCount, inspectionResults.Count); + } + + [Test] + [Category("Inspections")] + [TestCase("Class1", "TestProject.Class1", 0)] + [TestCase("Interface1", "TestProject.Class1", 0)] + [TestCase("Class1", "TestProject.Interface1", 0)] + [TestCase("Variant", "Whatever", 0)] //Tokens.Variant cannot be used here because it is not a constant expression. + [TestCase("Object", "Whatever", 0)] + [TestCase("Whatever", "Variant", 0)] + [TestCase("Whatever", "Object", 0)] + [TestCase("Class1", "TestProject.SomethingIncompatible", 1)] + [TestCase("Class1", "SomethingDifferent", 1)] + [TestCase("TestProject.Class1", "OtherProject.Class1", 1)] + [TestCase("TestProject.Interface1", "OtherProject.Class1", 1)] + [TestCase("TestProject.Class1", "OtherProject.Interface1", 1)] + [TestCase("Class1", "OtherProject.Class1", 1)] + [TestCase("Interface1", "OtherProject.Class1", 1)] + [TestCase("Class1", "OtherProject.Interface1", 1)] + [TestCase("Class1", SetTypeResolver.NotAnObject, 1)] //The RHS is not even an object. (Will show as type NotAnObject in the result.) + [TestCase("Class1", null, 0)] //We could not resolve the Set type, so we do not return a result. + public void MockedSetTypeEvaluatorTest_Function(string lhsTypeName, string expressionFullTypeName, int expectedResultsCount) + { + const string interface1 = + @" +Private Sub Foo() +End Sub +"; + const string class1 = + @"Implements Interface1 + +Private Sub Interface1_Foo() +End Sub +"; + + var module1 = + $@" +Private Property Get Cls() As {lhsTypeName} + Set Cls = expression +End Property +"; + + var vbe = new MockVbeBuilder() + .ProjectBuilder("TestProject", ProjectProtection.Unprotected) + .AddComponent("Class1", ComponentType.ClassModule, class1) + .AddComponent("Interface1", ComponentType.ClassModule, interface1) + .AddComponent("Module1", ComponentType.StandardModule, module1) + .AddProjectToVbeBuilder() + .Build() + .Object; + + var setTypeResolverMock = new Mock(); + setTypeResolverMock.Setup(m => + m.SetTypeName(It.IsAny(), It.IsAny())) + .Returns((VBAParser.ExpressionContext context, QualifiedModuleName qmn) => expressionFullTypeName); + + var inspectionResults = InspectionResults(vbe, setTypeResolverMock.Object).ToList(); + + Assert.AreEqual(expectedResultsCount, inspectionResults.Count); + } + + [Test] + [Category("Inspections")] + [TestCase("Class1", "TestProject.Class1", 0)] + [TestCase("Interface1", "TestProject.Class1", 0)] + [TestCase("Class1", "TestProject.Interface1", 0)] + [TestCase("Variant", "Whatever", 0)] //Tokens.Variant cannot be used here because it is not a constant expression. + [TestCase("Object", "Whatever", 0)] + [TestCase("Whatever", "Variant", 0)] + [TestCase("Whatever", "Object", 0)] + [TestCase("Class1", "TestProject.SomethingIncompatible", 1)] + [TestCase("Class1", "SomethingDifferent", 1)] + [TestCase("TestProject.Class1", "OtherProject.Class1", 1)] + [TestCase("TestProject.Interface1", "OtherProject.Class1", 1)] + [TestCase("TestProject.Class1", "OtherProject.Interface1", 1)] + [TestCase("Class1", "OtherProject.Class1", 1)] + [TestCase("Interface1", "OtherProject.Class1", 1)] + [TestCase("Class1", "OtherProject.Interface1", 1)] + [TestCase("Class1", SetTypeResolver.NotAnObject, 1)] //The RHS is not even an object. (Will show as type NotAnObject in the result.) + [TestCase("Class1", null, 0)] //We could not resolve the Set type, so we do not return a result. + public void MockedSetTypeEvaluatorTest_PropertyGet(string lhsTypeName, string expressionFullTypeName, int expectedResultsCount) { const string interface1 = @"