diff --git a/Rubberduck.CodeAnalysis/Inspections/Concrete/AssignedByValParameterInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/AssignedByValParameterInspection.cs index 8ac979dc82..721580b360 100644 --- a/Rubberduck.CodeAnalysis/Inspections/Concrete/AssignedByValParameterInspection.cs +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/AssignedByValParameterInspection.cs @@ -48,12 +48,43 @@ 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) + { + //Todo: Review whether this is still needed once parameterless default member assignments are resolved correctly. + + 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.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.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs b/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs new file mode 100644 index 0000000000..4804a76f7d --- /dev/null +++ b/Rubberduck.CodeAnalysis/Inspections/Concrete/SetAssignmentWithIncompatibleObjectTypeInspection.cs @@ -0,0 +1,195 @@ +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; +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; +using Rubberduck.VBEditor; + +namespace Rubberduck.CodeAnalysis.Inspections.Concrete +{ + public class SetAssignmentWithIncompatibleObjectTypeInspection : InspectionBase + { + private readonly IDeclarationFinderProvider _declarationFinderProvider; + private readonly ISetTypeResolver _setTypeResolver; + + /// + /// 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, ISetTypeResolver setTypeResolver) + : base(state) + { + _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() + { + var finder = _declarationFinderProvider.DeclarationFinder; + + 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)); + + return offendingAssignments + .Where(setAssignmentWithAssignedTypeName => !IsIgnored(setAssignmentWithAssignedTypeName.setAssignment)) + .Select(setAssignmentWithAssignedTypeName => InspectionResult(setAssignmentWithAssignedTypeName, _declarationFinderProvider)); + } + + private static bool ToBeConsidered(IdentifierReference reference) + { + var declaration = reference.Declaration; + return declaration != null + && declaration.AsTypeDeclaration != null + && declaration.IsObject; + } + + 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) + { + return _setTypeResolver.SetTypeName(expression, containingModule); + } + + 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 44424c8284..d1f8fd29ab 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. 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/Bindings/DictionaryAccessDefaultBinding.cs b/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs new file mode 100644 index 0000000000..507c3e13ad --- /dev/null +++ b/Rubberduck.Parsing/Binding/Bindings/DictionaryAccessDefaultBinding.cs @@ -0,0 +1,218 @@ +using System; +using System.Collections.Generic; +using Rubberduck.Parsing.Symbols; +using System.Linq; +using Antlr4.Runtime; +using Rubberduck.Parsing.Grammar; + +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; + + //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, + ArgumentList argumentList) + : this( + expression, + (IBoundExpression) null, + argumentList) + { + _lExpressionBinding = lExpressionBinding; + } + + public DictionaryAccessDefaultBinding( + ParserRuleContext expression, + IBoundExpression lExpression, + ArgumentList argumentList) + { + _expression = expression; + _lExpression = lExpression; + _argumentList = argumentList; + } + + private static void ResolveArgumentList(Declaration calledProcedure, ArgumentList argumentList) + { + foreach (var argument in argumentList.Arguments) + { + argument.Resolve(calledProcedure); + } + } + + public IBoundExpression Resolve() + { + if (_lExpressionBinding != null) + { + _lExpression = _lExpressionBinding.Resolve(); + } + + return Resolve(_lExpression, _argumentList, _expression); + } + + private static IBoundExpression Resolve(IBoundExpression lExpression, ArgumentList argumentList, ParserRuleContext expression) + { + if (lExpression.Classification == ExpressionClassification.ResolutionFailed) + { + ResolveArgumentList(null, argumentList); + return CreateFailedExpression(lExpression, argumentList); + } + + 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, argumentList); + return new DictionaryAccessExpression(null, ExpressionClassification.Unbound, expression, lExpression, argumentList); + } + + if (lDeclaration == null) + { + ResolveArgumentList(null, argumentList); + return CreateFailedExpression(lExpression, argumentList); + } + + var asTypeName = lDeclaration.AsTypeName; + var asTypeDeclaration = lDeclaration.AsTypeDeclaration; + + return ResolveViaDefaultMember(lExpression, asTypeName, asTypeDeclaration, argumentList, expression); + } + + private static IBoundExpression CreateFailedExpression(IBoundExpression lExpression, ArgumentList argumentList) + { + var failedExpr = new ResolutionFailedExpression(); + failedExpr.AddSuccessfullyResolvedExpression(lExpression); + foreach (var arg in argumentList.Arguments) + { + failedExpr.AddSuccessfullyResolvedExpression(arg.Expression); + } + + return failedExpr; + } + + 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)) + { + /* + 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, argumentList); + 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, argumentList); + return CreateFailedExpression(lExpression, argumentList); + } + + var defaultMemberClassification = DefaultMemberClassification(defaultMember); + + var parameters = ((IParameterizedDeclaration) defaultMember).Parameters.ToList(); + + if (IsCompatibleWithOneStringArgument(parameters)) + { + /* + 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, argumentList); + return new DictionaryAccessExpression(defaultMember, defaultMemberClassification, expression, lExpression, argumentList); + } + + if (parameters.Count(param => !param.IsOptional) == 0 + && 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 . + */ + + return ResolveRecursiveDefaultMember(defaultMember, defaultMemberClassification, argumentList, expression, recursionDepth); + } + + ResolveArgumentList(null, argumentList); + return CreateFailedExpression(lExpression, argumentList); + } + + 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 static IBoundExpression ResolveRecursiveDefaultMember(Declaration defaultMember, ExpressionClassification defaultMemberClassification, ArgumentList argumentList, ParserRuleContext expression, int recursionDepth) + { + var defaultMemberAsLExpression = new SimpleNameExpression(defaultMember, defaultMemberClassification, expression); + var defaultMemberAsTypeName = defaultMember.AsTypeName; + var defaultMemberAsTypeDeclaration = defaultMember.AsTypeDeclaration; + + return ResolveViaDefaultMember( + defaultMemberAsLExpression, + defaultMemberAsTypeName, + defaultMemberAsTypeDeclaration, + argumentList, + expression, + recursionDepth + 1); + } + + 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 static 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..cfeb56821f 100644 --- a/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs +++ b/Rubberduck.Parsing/Binding/Bindings/IndexDefaultBinding.cs @@ -1,37 +1,28 @@ -using Antlr4.Runtime; +using System; +using System.Collections.Generic; +using Antlr4.Runtime; using Rubberduck.Parsing.Symbols; using System.Linq; -using Rubberduck.Parsing.VBA.DeclarationCaching; +using Rubberduck.Parsing.Grammar; 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; private readonly ArgumentList _argumentList; private const int DEFAULT_MEMBER_RECURSION_LIMIT = 32; - private int _defaultMemberRecursionLimitCounter = 0; + + //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( - DeclarationFinder declarationFinder, - Declaration project, - Declaration module, - Declaration parent, ParserRuleContext expression, IExpressionBinding lExpressionBinding, ArgumentList argumentList) : this( - declarationFinder, - project, - module, - parent, expression, (IBoundExpression)null, argumentList) @@ -40,26 +31,18 @@ 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; } - 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); } @@ -71,234 +54,313 @@ 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) + private static IBoundExpression Resolve(IBoundExpression lExpression, ArgumentList argumentList, ParserRuleContext expression, int defaultMemberResolutionRecursionDepth = 0) { - IBoundExpression boundExpression = null; if (lExpression.Classification == ExpressionClassification.ResolutionFailed) { - return CreateFailedExpression(lExpression); - } - boundExpression = ResolveLExpressionIsVariablePropertyFunctionNoParameters(lExpression); - if (boundExpression != null) - { - return boundExpression; + ResolveArgumentList(null, argumentList); + return CreateFailedExpression(lExpression, argumentList); } - boundExpression = ResolveLExpressionIsIndexExpression(lExpression); - if (boundExpression != null) + + if (lExpression.Classification == ExpressionClassification.Unbound) { - return boundExpression; + return ResolveLExpressionIsUnbound(lExpression, argumentList, expression); } - boundExpression = ResolveLExpressionIsPropertyFunctionSubroutine(lExpression); - if (boundExpression != null) + + if(lExpression.ReferencedDeclaration != null) { - return boundExpression; + if (argumentList.HasArguments) + { + switch (lExpression) + { + case IndexExpression indexExpression: + var doubleIndexExpression = ResolveLExpressionIsIndexExpression(indexExpression, argumentList, expression, defaultMemberResolutionRecursionDepth); + if (doubleIndexExpression != null) + { + return doubleIndexExpression; + } + + break; + case DictionaryAccessExpression dictionaryAccessExpression: + var indexOnBangExpression = ResolveLExpressionIsDictionaryAccessExpression(dictionaryAccessExpression, argumentList, expression, defaultMemberResolutionRecursionDepth); + if (indexOnBangExpression != null) + { + return indexOnBangExpression; + } + + break; + } + } + + if (IsVariablePropertyFunctionWithoutParameters(lExpression)) + { + var parameterlessLExpressionAccess = ResolveLExpressionIsVariablePropertyFunctionNoParameters(lExpression, argumentList, expression, 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, 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) + 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 - 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, argumentList, expression); + } + + var asTypeName = indexedDeclaration.AsTypeName; + var asTypeDeclaration = indexedDeclaration.AsTypeDeclaration; + + return ResolveDefaultMember(lExpression, asTypeName, asTypeDeclaration, argumentList, expression, 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 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. 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; + + //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 ResolveLExpressionDeclaredTypeIsArray(indexExpression, argumentList, expression); + } + + var asTypeName = indexedDeclaration.AsTypeName; + var asTypeDeclaration = indexedDeclaration.AsTypeDeclaration; + + return ResolveDefaultMember(indexExpression, asTypeName, asTypeDeclaration, argumentList, expression, defaultMemberResolutionRecursionDepth); } - private IBoundExpression ResolveDefaultMember(IBoundExpression lExpression, string asTypeName, Declaration asTypeDeclaration) + private static IBoundExpression ResolveLExpressionIsDictionaryAccessExpression(DictionaryAccessExpression dictionaryAccessExpression, ArgumentList argumentList, ParserRuleContext expression, int defaultMemberResolutionRecursionDepth) { - if (lExpression.ReferencedDeclaration.IsArray) + //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, argumentList, expression); + } + + var asTypeName = indexedDeclaration.AsTypeName; + var asTypeDeclaration = indexedDeclaration.AsTypeDeclaration; + + return ResolveDefaultMember(dictionaryAccessExpression, asTypeName, asTypeDeclaration, argumentList, expression, 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 named arguments. In this case, the index expression is classified as an unbound member with a declared type of Variant, referencing with no member name. */ if ( - asTypeName != null - && (asTypeName.ToUpperInvariant() == "VARIANT" || asTypeName.ToUpperInvariant() == "OBJECT") - && !_argumentList.HasNamedArguments) + (Tokens.Variant.Equals(asTypeName, StringComparison.InvariantCultureIgnoreCase) + || Tokens.Object.Equals(asTypeName, StringComparison.InvariantCultureIgnoreCase)) + && !argumentList.HasNamedArguments) { - return new IndexExpression(null, ExpressionClassification.Unbound, _expression, lExpression, _argumentList); + 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 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)) { - 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) - { + 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. + /* + 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. - */ - if (((IParameterizedDeclaration)defaultMember).Parameters.Count() == _argumentList.Arguments.Count) - { - return new IndexExpression(defaultMember, lExpression.Classification, _expression, lExpression, _argumentList); - } + TODO: Improve argument compatibility check by checking the argument types. + */ + var parameters = ((IParameterizedDeclaration) defaultMember).Parameters.ToList(); + if (ArgumentListIsCompatible(parameters, argumentList)) + { + ResolveArgumentList(defaultMember, argumentList); + return new IndexExpression(defaultMember, defaultMemberClassification, 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 (((IParameterizedDeclaration)defaultMember).Parameters.Count() == 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, argumentList, expression, defaultMemberResolutionRecursionDepth); } } + return null; } - private IBoundExpression ResolveLExpressionDeclaredTypeIsArray(IBoundExpression lExpression, Declaration asTypeDeclaration) + 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 static IBoundExpression ResolveRecursiveDefaultMember(Declaration defaultMember, ExpressionClassification defaultMemberClassification, ArgumentList argumentList, ParserRuleContext expression, int defaultMemberResolutionRecursionDepth) + { + var defaultMemberAsLExpression = new SimpleNameExpression(defaultMember, defaultMemberClassification, expression); + return Resolve(defaultMemberAsLExpression, argumentList, expression, 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; + 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 static IBoundExpression ResolveLExpressionDeclaredTypeIsArray(IBoundExpression lExpression, ArgumentList argumentList, ParserRuleContext expression) + { + var indexedDeclaration = lExpression.ReferencedDeclaration; + if (indexedDeclaration == null + || !indexedDeclaration.IsArray) + { + 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); - } - } + ResolveArgumentList(indexedDeclaration, 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 + */ + + 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 @@ -311,26 +373,18 @@ 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; + 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. */ - if (lExpression.Classification == ExpressionClassification.Unbound) - { - return new IndexExpression(lExpression.ReferencedDeclaration, ExpressionClassification.Unbound, _expression, lExpression, _argumentList); - } - return null; + ResolveArgumentList(lExpression.ReferencedDeclaration, argumentList); + return new IndexExpression(lExpression.ReferencedDeclaration, ExpressionClassification.Unbound, expression, lExpression, argumentList); } } } diff --git a/Rubberduck.Parsing/Binding/DefaultBindingContext.cs b/Rubberduck.Parsing/Binding/DefaultBindingContext.cs index b8911bbe6e..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) @@ -179,7 +178,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) @@ -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/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/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/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..a0a42b2723 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 @@ -686,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 @@ -951,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/Rubberduck.Parsing/Symbols/Declaration.cs b/Rubberduck.Parsing/Symbols/Declaration.cs index 55d359e347..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); @@ -359,7 +362,9 @@ public virtual bool IsObject IEnumerable annotations, bool isAssignmentTarget = false, bool hasExplicitLetStatement = false, - bool isSetAssigned = false + bool isSetAssigned = false, + bool isDefaultMemberAccess = false, + bool isArrayAccess = false ) { var oldReference = _references.FirstOrDefault(r => @@ -386,7 +391,9 @@ public virtual bool IsObject isAssignmentTarget, hasExplicitLetStatement, annotations, - isSetAssigned); + isSetAssigned, + isDefaultMemberAccess, + isArrayAccess); _references.AddOrUpdate(newReference, 1, (key, value) => 1); } @@ -448,7 +455,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 +475,32 @@ 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 + { + 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()); private Declaration _asTypeDeclaration; diff --git a/Rubberduck.Parsing/Symbols/IdentifierReference.cs b/Rubberduck.Parsing/Symbols/IdentifierReference.cs index bf6e4b4174..182ad90e59 100644 --- a/Rubberduck.Parsing/Symbols/IdentifierReference.cs +++ b/Rubberduck.Parsing/Symbols/IdentifierReference.cs @@ -23,7 +23,9 @@ public class IdentifierReference : IEquatable bool isAssignmentTarget = false, bool hasExplicitLetStatement = false, IEnumerable annotations = null, - bool isSetAssigned = false) + bool isSetAssigned = false, + bool isDefaultMemberAccess = false, + bool isArrayAccess = false) { ParentScoping = parentScopingDeclaration; ParentNonScoping = parentNonScopingDeclaration; @@ -35,6 +37,8 @@ public class IdentifierReference : IEquatable HasExplicitLetStatement = hasExplicitLetStatement; IsAssignment = isAssignmentTarget; IsSetAssignment = isSetAssigned; + IsDefaultMemberAccess = isDefaultMemberAccess; + IsArrayAccess = isArrayAccess; Annotations = annotations ?? new List(); } @@ -60,6 +64,10 @@ public class IdentifierReference : IEquatable public bool IsSetAssignment { get; } + 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 90384c429d..e293c935b6 100644 --- a/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs +++ b/Rubberduck.Parsing/Symbols/IdentifierReferenceResolver.cs @@ -193,26 +193,12 @@ private IEnumerable FindIdentifierAnnotations(QualifiedModuleName m } } - IParameterizedDeclaration defaultMember = null; - if (boundExpression.ReferencedDeclaration != null - && boundExpression.ReferencedDeclaration.DeclarationType != DeclarationType.Project - && boundExpression.ReferencedDeclaration.AsTypeDeclaration != null) - { - 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))); - } - _boundExpressionVisitor.AddIdentifierReferences( boundExpression, _qualifiedModuleName, _currentScope, _currentParent, - isAssignmentTarget && (defaultMember == null || isSetAssignment || defaultMember.Parameters.All(param => param.IsOptional)), + isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); } @@ -262,12 +248,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/Rubberduck.Parsing/TypeResolvers/ISetTypeResolver.cs b/Rubberduck.Parsing/TypeResolvers/ISetTypeResolver.cs new file mode 100644 index 0000000000..606804d3c7 --- /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 + /// 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 new file mode 100644 index 0000000000..d621873598 --- /dev/null +++ b/Rubberduck.Parsing/TypeResolvers/SetTypeResolver.cs @@ -0,0 +1,268 @@ +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 + { + public const string NotAnObject = "NotAnObject"; + + + private readonly IDeclarationFinderProvider _declarationFinderProvider; + + public SetTypeResolver(IDeclarationFinderProvider declarationFinderProvider) + { + _declarationFinderProvider = 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(lExpression, containingModule, finder); + return SetTypeDeclaration(setTypeDeterminingDeclaration.declaration); + } + + private Declaration SetTypeDeclaration(Declaration setTypeDeterminingDeclaration) + { + return setTypeDeterminingDeclaration?.DeclarationType.HasFlag(DeclarationType.ClassModule) ?? true + ? setTypeDeterminingDeclaration + : setTypeDeterminingDeclaration.AsTypeDeclaration; + } + + + 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(lExpression, containingModule, finder); + return setTypeDeterminingDeclaration.mightHaveSetType + ? FullObjectTypeName(setTypeDeterminingDeclaration.declaration, lExpression) + : NotAnObject; + } + + private static string FullObjectTypeName(Declaration setTypeDeterminingDeclaration, VBAParser.LExpressionContext lExpression) + { + if (setTypeDeterminingDeclaration == null) + { + return null; + } + + if (setTypeDeterminingDeclaration.DeclarationType.HasFlag(DeclarationType.ClassModule)) + { + return setTypeDeterminingDeclaration.QualifiedModuleName.ToString(); + } + + if (setTypeDeterminingDeclaration.IsObject || setTypeDeterminingDeclaration.IsObjectArray) + { + return setTypeDeterminingDeclaration.FullAsTypeName; + } + + return setTypeDeterminingDeclaration.AsTypeName == Tokens.Variant + ? setTypeDeterminingDeclaration.AsTypeName + : NotAnObject; + } + + private (Declaration declaration, bool mightHaveSetType) 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: + return SetTypeDeterminingDeclarationOfIndexExpression(indexExpression, containingModule, finder); + case VBAParser.MemberAccessExprContext memberAccessExpression: + return SetTypeDeterminingDeclarationOfExpression(memberAccessExpression.unrestrictedIdentifier(), containingModule, finder); + case VBAParser.WithMemberAccessExprContext withMemberAccessExpression: + return SetTypeDeterminingDeclarationOfExpression(withMemberAccessExpression.unrestrictedIdentifier(), containingModule, finder); + case VBAParser.DictionaryAccessExprContext dictionaryAccessExpression: + return SetTypeDeterminingDeclarationOfExpression(dictionaryAccessExpression.dictionaryAccess(), containingModule, finder); + case VBAParser.WithDictionaryAccessExprContext withDictionaryAccessExpression: + return SetTypeDeterminingDeclarationOfExpression(withDictionaryAccessExpression.dictionaryAccess(), containingModule, finder); + case VBAParser.WhitespaceIndexExprContext whitespaceIndexExpression: + 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 indexExpr, QualifiedModuleName containingModule, DeclarationFinder 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)); + } + + //Passing the indexExpr itself is correct. + var arrayDeclaration = ResolveIndexExpressionAsArrayAccess(indexExpr, containingModule, finder); + + return (arrayDeclaration, MightHaveSetTypeOnArrayAccess(arrayDeclaration)); + } + + 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, lExpressionOfIndexExpression.GetSelection().Collapse()); + var candidate = finder + .ContainingIdentifierReferences(qualifiedSelection) + .LastOrDefault() + ?.Declaration; + return candidate?.DeclarationType.HasFlag(DeclarationType.Member) ?? false + ? candidate + : null; + } + + private Declaration ResolveIndexExpressionAsDefaultMemberAccess(VBAParser.LExpressionContext lExpressionOfIndexExpression, QualifiedModuleName containingModule, DeclarationFinder finder) + { + // A default member access references the entire lExpression. + 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) + { + // An 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) + { + var declaration = finder.IdentifierReferences(identifier, containingModule) + .Select(reference => reference.Declaration) + .FirstOrDefault(); + return (declaration, MightHaveSetType(declaration)); + } + + private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfExpression(VBAParser.UnrestrictedIdentifierContext identifier, QualifiedModuleName containingModule, DeclarationFinder finder) + { + var declaration = finder.IdentifierReferences(identifier, containingModule) + .Select(reference => reference.Declaration) + .FirstOrDefault(); + 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 + || declaration.IsObject + || Tokens.Variant.Equals( declaration.AsTypeName, StringComparison.InvariantCultureIgnoreCase) + || declaration.DeclarationType.HasFlag(DeclarationType.ClassModule); + } + + private static bool MightHaveSetTypeOnArrayAccess(Declaration declaration) + { + return declaration == null + || declaration.IsObjectArray + || Tokens.Variant.Equals(declaration.AsTypeName, StringComparison.InvariantCultureIgnoreCase); + } + + private (Declaration declaration, bool mightHaveSetType) SetTypeDeterminingDeclarationOfInstance(QualifiedModuleName instance, DeclarationFinder finder) + { + var classDeclaration = finder.Classes.FirstOrDefault(cls => cls.QualifiedModuleName.Equals(instance)); + return (classDeclaration, true); + } + } +} \ No newline at end of file diff --git a/Rubberduck.Parsing/VBA/DeclarationCaching/DeclarationFinder.cs b/Rubberduck.Parsing/VBA/DeclarationCaching/DeclarationFinder.cs index 5cacd6569f..acca6cba9f 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. /// @@ -1413,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 a3482b0931..82e137559d 100644 --- a/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs +++ b/Rubberduck.Parsing/VBA/ReferenceManagement/BoundExpressionVisitor.cs @@ -3,7 +3,6 @@ using System.Linq; using Rubberduck.Parsing.Annotations; using Rubberduck.Parsing.Binding; -using Rubberduck.Parsing.Grammar; using Rubberduck.Parsing.Symbols; using Rubberduck.Parsing.VBA.DeclarationCaching; using Rubberduck.VBEditor; @@ -48,8 +47,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,19 +62,25 @@ 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); break; + case DictionaryAccessExpression dictionaryAccessExpression: + Visit(dictionaryAccessExpression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); + break; case TypeOfIsExpression typeOfIsExpression: Visit(typeOfIsExpression, module, scope, parent); break; 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()}"); } } @@ -101,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; @@ -175,33 +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.Classification != ExpressionClassification.Unbound - && expression.ReferencedDeclaration != null - && !ReferenceEquals(expression.LExpression.ReferencedDeclaration, expression.ReferencedDeclaration)) + if (expression.IsDefaultMemberAccess) { - // 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) + Visit(expression.LExpression, module, scope, parent); + + if (expression.Classification != ExpressionClassification.Unbound + && 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); + AddDefaultMemberReference(expression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); } } - // Argument List not affected by being unbound. + else if (expression.Classification != ExpressionClassification.Unbound + && expression.IsArrayAccess + && expression.ReferencedDeclaration != null) + { + Visit(expression.LExpression, module, scope, parent); + AddArrayAccessReference(expression, module, scope, parent, isAssignmentTarget, hasExplicitLetStatement, isSetAssignment); + } + 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) @@ -215,6 +210,102 @@ 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, + 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), + isAssignmentTarget, + hasExplicitLetStatement, + isSetAssignment, + isDefaultMemberAccess: true); + } + // 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/Rubberduck.Resources/Inspections/InspectionInfo.Designer.cs b/Rubberduck.Resources/Inspections/InspectionInfo.Designer.cs index 7cf67ea9cc..b13d2efd4b 100644 --- a/Rubberduck.Resources/Inspections/InspectionInfo.Designer.cs +++ b/Rubberduck.Resources/Inspections/InspectionInfo.Designer.cs @@ -726,6 +726,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 e9165c057c..7e5e65015a 100644 --- a/Rubberduck.Resources/Inspections/InspectionInfo.de.resx +++ b/Rubberduck.Resources/Inspections/InspectionInfo.de.resx @@ -382,4 +382,7 @@ Falls der Parameter 'null' sein kann, bitte dieses Auftreten ignorieren. 'null' 'While...Wend'-Schleifen sind aus Gründen der Abwärtskompatibilität vorhanden und wurden durch die Einführung von 'Do While...Loop'-Blöcken ersetzt, die die 'Exit Do'-Exit-Anweisung unterstützen. 'While...Wend'-Schleifen können nur beendet werden, wenn die 'While'-Bedingung erfüllt ist. + + 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 4a27c599dc..455898c00e 100644 --- a/Rubberduck.Resources/Inspections/InspectionInfo.resx +++ b/Rubberduck.Resources/Inspections/InspectionInfo.resx @@ -382,6 +382,9 @@ 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. + Methods without executable statements may appear to be doing something which they actually don't, and therefore causing unexpected behaviour. diff --git a/Rubberduck.Resources/Inspections/InspectionNames.Designer.cs b/Rubberduck.Resources/Inspections/InspectionNames.Designer.cs index cf59e4ea57..c010d08fe3 100644 --- a/Rubberduck.Resources/Inspections/InspectionNames.Designer.cs +++ b/Rubberduck.Resources/Inspections/InspectionNames.Designer.cs @@ -726,6 +726,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 fde6d7954f..92c00f7eb1 100644 --- a/Rubberduck.Resources/Inspections/InspectionNames.de.resx +++ b/Rubberduck.Resources/Inspections/InspectionNames.de.resx @@ -363,6 +363,9 @@ Fehlende Modulannotation + + Set-Zuweisung mit nicht kompatiblem Objekttyp + Verwendung der veralteten 'While...Wend'-Anweisung diff --git a/Rubberduck.Resources/Inspections/InspectionNames.resx b/Rubberduck.Resources/Inspections/InspectionNames.resx index afd4668793..957906a7ba 100644 --- a/Rubberduck.Resources/Inspections/InspectionNames.resx +++ b/Rubberduck.Resources/Inspections/InspectionNames.resx @@ -386,6 +386,9 @@ Use of obsolete 'While...Wend' statement + + Set assignment with incompatible object type + Empty method diff --git a/Rubberduck.Resources/Inspections/InspectionResults.Designer.cs b/Rubberduck.Resources/Inspections/InspectionResults.Designer.cs index f6b84f27d7..3d7bb8e5bf 100644 --- a/Rubberduck.Resources/Inspections/InspectionResults.Designer.cs +++ b/Rubberduck.Resources/Inspections/InspectionResults.Designer.cs @@ -744,6 +744,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 bef3eac8af..d669c85319 100644 --- a/Rubberduck.Resources/Inspections/InspectionResults.de.resx +++ b/Rubberduck.Resources/Inspections/InspectionResults.de.resx @@ -404,4 +404,7 @@ In Memoriam, 1972-2018 'While...Wend'-Schleife kann als 'Do While...Loop'-Block formuliert 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 56f42fa1c9..b9892d92f7 100644 --- a/Rubberduck.Resources/Inspections/InspectionResults.resx +++ b/Rubberduck.Resources/Inspections/InspectionResults.resx @@ -425,6 +425,10 @@ 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 + {0} '{1}' contains no executable statements. {0} Method kind, {1} Method name diff --git a/Rubberduck.VBEEditor/Selection.cs b/Rubberduck.VBEEditor/Selection.cs index 1923b39726..2823a8bf3e 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) @@ -139,25 +142,51 @@ 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 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; + } + + /// + /// Orders first by start position and then end position. + /// 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; } + /// + /// 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); 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 diff --git a/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs new file mode 100644 index 0000000000..869e79baf3 --- /dev/null +++ b/RubberduckTests/ExpressionResolving/SetTypeResolverTests.cs @@ -0,0 +1,1303 @@ +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", SetTypeResolver.NotAnObject)] + 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); + } + + [Test] + [Category("ExpressionResolver")] + [TestCase("Class1", "TestProject.Class1")] + [TestCase("TestProject.Class1", "TestProject.Class1")] + [TestCase("Variant", "Variant")] + [TestCase("Object", "Object")] + [TestCase("Long", SetTypeResolver.NotAnObject)] + 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", SetTypeResolver.NotAnObject)] + 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); + } + + [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 BuiltInTypeExpression_SetTypeNameTests(string builtInType, string expectedSetTypeName) + { + var class1 = + @" +Public Property Get Foo() As Variant +End Property +"; + + var module1 = + $@" +Private Sub Bar() + Dim baz as Variant + baz = TypeOf baz Is {builtInType} +End Sub +"; + + var expressionSelection = new Selection(4, 25, 4, 26); + + 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 BuiltInTypeExpression_SetTypeDeclarationTests(string builtInType, string expectedNameOfSetTypeDeclaration) + { + var class1 = + @" +Public Property Get Foo() As Variant +End Property +"; + + var module1 = + $@" +Private Sub Bar() + Dim baz as Variant + baz = TypeOf baz Is {builtInType} +End Sub +"; + + var expressionSelection = new Selection(4, 25, 4, 26); + + 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 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); + } + + [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)) + { + 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; + } + + var containingChild = context.children + .OfType() + .FirstOrDefault(childContext => childContext.GetSelection().Contains(selection)); + + var containedTestExpression = containingChild != null + ? TestExpression(containingChild, selection) + : null; + + if (containedTestExpression != null) + { + return containedTestExpression; + } + + if (context is VBAParser.ExpressionContext expression) + { + return expression; + } + + return null; + } + + private static ISetTypeResolver ExpressionResolverUnderTest(IDeclarationFinderProvider declarationFinderProvider) + { + return new SetTypeResolver(declarationFinderProvider); + } + } +} \ No newline at end of file diff --git a/RubberduckTests/Grammar/ResolverTests.cs b/RubberduckTests/Grammar/ResolverTests.cs index 79697c89be..2de938dd6f 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")] @@ -987,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()) @@ -1005,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)); } } @@ -1031,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)); @@ -1355,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)); } } @@ -3002,5 +3012,599 @@ 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); + Assert.IsTrue(reference.IsDefaultMemberAccess); + } + } + + [Category("Grammar")] + [Category("Resolver")] + [Test] + public void ChainedSameMemberDictionaryAccessExpressionHasReferenceToDefaultMemberAtExclamationMark() + { + 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); + 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, 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 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, 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] + 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); + Assert.IsTrue(reference.IsDefaultMemberAccess); + } + } + + [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); + Assert.IsTrue(reference.IsDefaultMemberAccess); + } + } + + [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. + } + } + + [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 memberReference = state.DeclarationFinder.ContainingIdentifierReferences(qualifiedSelection).Last(reference => reference.IsDefaultMemberAccess); + var referencedDeclaration = memberReference.Declaration; + + var expectedReferencedDeclarationName = "Class1.Foo"; + var actualReferencedDeclarationName = $"{referencedDeclaration.ComponentName}.{referencedDeclaration.IdentifierName}"; + + 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); + } + } + + [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/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/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() 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/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); + } } } diff --git a/RubberduckTests/Inspections/ObjectVariableNotSetInspectionTests.cs b/RubberduckTests/Inspections/ObjectVariableNotSetInspectionTests.cs index 8263a6d243..eedae28ffd 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); @@ -304,9 +304,8 @@ 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.")] [Category("Inspections")] public void ObjectVariableNotSet_FunctionReturnNotSet_ReturnsResult() { diff --git a/RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs b/RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs new file mode 100644 index 0000000000..80f170f3a8 --- /dev/null +++ b/RubberduckTests/Inspections/SetAssignmentWithIncompatibleObjectTypeInspectionTests.cs @@ -0,0 +1,677 @@ +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; + +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()); + } + + [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_Variable(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 Function Cls() As {lhsTypeName} + Set Cls = expression +End Function +"; + + 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_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 = + @" +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(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, setTypeResolver); + return inspection.GetInspectionResults(CancellationToken.None); + } + } + + private static IInspection InspectionUnderTest(RubberduckParserState state, ISetTypeResolver setTypeResolver = null) + { + var setTypeResolverToUse = setTypeResolver ?? new SetTypeResolver(state); + return new SetAssignmentWithIncompatibleObjectTypeInspection(state, setTypeResolverToUse); + } + } +} \ No newline at end of file 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/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?"" 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; diff --git a/RubberduckTests/Symbols/DeclarationFinderTests.cs b/RubberduckTests/Symbols/DeclarationFinderTests.cs index b85005495d..44ee33212f 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,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 @@ -1197,20 +1195,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); } }