Skip to content

Commit 314a2d0

Browse files
authored
Merge pull request #2652 from comintern/next
Lots of small bug fixes, initial WIP for ComAlias (not connected yet).
2 parents 4ed1f44 + 503df95 commit 314a2d0

24 files changed

+229
-123
lines changed

RetailCoder.VBE/Inspections/ObjectVariableNotSetInspection.cs

Lines changed: 3 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -3,6 +3,7 @@
33
using Rubberduck.Inspections.Abstract;
44
using Rubberduck.Inspections.Resources;
55
using Rubberduck.Inspections.Results;
6+
using Rubberduck.Parsing;
67
using Rubberduck.Parsing.Grammar;
78
using Rubberduck.Parsing.Symbols;
89
using Rubberduck.Parsing.VBA;
@@ -20,29 +21,13 @@ public ObjectVariableNotSetInspection(RubberduckParserState state)
2021
public override string Description { get { return InspectionsUI.ObjectVariableNotSetInspectionName; } }
2122
public override CodeInspectionType InspectionType { get { return CodeInspectionType.CodeQualityIssues; } }
2223

23-
private static readonly IReadOnlyList<string> ValueTypes = new[]
24-
{
25-
Tokens.Boolean,
26-
Tokens.Byte,
27-
Tokens.Currency,
28-
Tokens.Date,
29-
Tokens.Decimal,
30-
Tokens.Double,
31-
Tokens.Integer,
32-
Tokens.Long,
33-
Tokens.LongLong,
34-
Tokens.Single,
35-
Tokens.String,
36-
Tokens.Variant
37-
};
38-
3924
public override IEnumerable<InspectionResultBase> GetInspectionResults()
4025
{
4126
var interestingDeclarations =
4227
State.AllUserDeclarations.Where(item =>
4328
!item.IsSelfAssigned &&
4429
!item.IsArray &&
45-
!ValueTypes.Contains(item.AsTypeName) &&
30+
!SymbolList.ValueTypes.Contains(item.AsTypeName) &&
4631
(item.AsTypeDeclaration == null || (!ClassModuleDeclaration.HasDefaultMember(item.AsTypeDeclaration) &&
4732
item.AsTypeDeclaration.DeclarationType != DeclarationType.Enumeration &&
4833
item.AsTypeDeclaration.DeclarationType != DeclarationType.UserDefinedType)) &&
@@ -54,7 +39,7 @@ public override IEnumerable<InspectionResultBase> GetInspectionResults()
5439
(item.DeclarationType == DeclarationType.Function || item.DeclarationType == DeclarationType.PropertyGet)
5540
&& !item.IsArray
5641
&& item.IsTypeSpecified
57-
&& !ValueTypes.Contains(item.AsTypeName)
42+
&& !SymbolList.ValueTypes.Contains(item.AsTypeName)
5843
&& (item.AsTypeDeclaration == null // null if unresolved (e.g. in unit tests)
5944
|| (item.AsTypeDeclaration.DeclarationType != DeclarationType.Enumeration && item.AsTypeDeclaration.DeclarationType != DeclarationType.UserDefinedType
6045
&& item.AsTypeDeclaration != null

RetailCoder.VBE/Inspections/QuickFixes/RemoveTypeHintsQuickFix.cs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -2,6 +2,7 @@
22
using Antlr4.Runtime;
33
using Rubberduck.Inspections.Abstract;
44
using Rubberduck.Inspections.Resources;
5+
using Rubberduck.Parsing;
56
using Rubberduck.Parsing.Grammar;
67
using Rubberduck.Parsing.Symbols;
78
using Rubberduck.VBEditor;
@@ -47,7 +48,7 @@ private void FixTypeHintUsage(string hint, ICodeModule module, Selection selecti
4748
{
4849
var line = module.GetLines(selection.StartLine, 1);
4950

50-
var asTypeClause = ' ' + Tokens.As + ' ' + Declaration.TypeHintToTypeName[hint];
51+
var asTypeClause = ' ' + Tokens.As + ' ' + SymbolList.TypeHintToTypeName[hint];
5152

5253
string fix;
5354

RetailCoder.VBE/Inspections/Results/ImplicitActiveWorkbookReferenceInspectionResult.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -30,7 +30,7 @@ public override IEnumerable<QuickFixBase> QuickFixes
3030

3131
public override string Description
3232
{
33-
get { return string.Format(InspectionsUI.ImplicitActiveSheetReferenceInspectionResultFormat, Context.GetText() /*_reference.Declaration.IdentifierName*/); }
33+
get { return string.Format(InspectionsUI.ImplicitActiveWorkbookReferenceInspectionResultFormat, Context.GetText() /*_reference.Declaration.IdentifierName*/); }
3434
}
3535
}
3636
}

RetailCoder.VBE/Inspections/SelfAssignedDeclarationInspection.cs

Lines changed: 2 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,7 @@
33
using Rubberduck.Inspections.Abstract;
44
using Rubberduck.Inspections.QuickFixes;
55
using Rubberduck.Inspections.Resources;
6-
using Rubberduck.Parsing.Grammar;
6+
using Rubberduck.Parsing;
77
using Rubberduck.Parsing.VBA;
88
using Rubberduck.Parsing.Symbols;
99

@@ -20,27 +20,12 @@ public SelfAssignedDeclarationInspection(RubberduckParserState state)
2020
public override string Description { get { return InspectionsUI.SelfAssignedDeclarationInspectionName; } }
2121
public override CodeInspectionType InspectionType { get { return CodeInspectionType.CodeQualityIssues; } }
2222

23-
private static readonly IReadOnlyList<string> ValueTypes = new[]
24-
{
25-
Tokens.Boolean,
26-
Tokens.Byte,
27-
Tokens.Currency,
28-
Tokens.Date,
29-
Tokens.Decimal,
30-
Tokens.Double,
31-
Tokens.Integer,
32-
Tokens.Long,
33-
Tokens.LongLong,
34-
Tokens.Single,
35-
Tokens.String
36-
};
37-
3823
public override IEnumerable<InspectionResultBase> GetInspectionResults()
3924
{
4025
return UserDeclarations
4126
.Where(declaration => declaration.IsSelfAssigned
4227
&& declaration.IsTypeSpecified
43-
&& !ValueTypes.Contains(declaration.AsTypeName)
28+
&& !SymbolList.ValueTypes.Contains(declaration.AsTypeName)
4429
&& declaration.DeclarationType == DeclarationType.Variable
4530
&& (declaration.AsTypeDeclaration == null
4631
|| declaration.AsTypeDeclaration.DeclarationType != DeclarationType.UserDefinedType)

RetailCoder.VBE/Navigation/CodeExplorer/CodeExplorerViewModel.cs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,6 +4,7 @@
44
using System.Linq;
55
using NLog;
66
using Rubberduck.Navigation.Folders;
7+
using Rubberduck.Parsing;
78
using Rubberduck.Parsing.Annotations;
89
using Rubberduck.Parsing.Symbols;
910
using Rubberduck.Parsing.VBA;
@@ -201,7 +202,7 @@ public string PanelTitle
201202
}
202203

203204
var typeName = declaration.HasTypeHint
204-
? Declaration.TypeHintToTypeName[declaration.TypeHint]
205+
? SymbolList.TypeHintToTypeName[declaration.TypeHint]
205206
: declaration.AsTypeName;
206207

207208
return nameWithDeclarationType + ": " + typeName;

RetailCoder.VBE/Refactorings/ExtractMethod/ExtractMethodPresenter.cs

Lines changed: 0 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,6 @@
11
using System;
2-
using System.Collections.Generic;
32
using System.Linq;
43
using System.Windows.Forms;
5-
using Rubberduck.Parsing.Grammar;
64
using Rubberduck.SmartIndenter;
75

86
namespace Rubberduck.Refactorings.ExtractMethod
@@ -59,21 +57,6 @@ private void PrepareView(IExtractMethodModel extractedMethodModel, IExtractMetho
5957
_view.OnRefreshPreview();
6058
}
6159

62-
private static readonly IEnumerable<string> ValueTypes = new[]
63-
{
64-
Tokens.Boolean,
65-
Tokens.Byte,
66-
Tokens.Currency,
67-
Tokens.Date,
68-
Tokens.Decimal,
69-
Tokens.Double,
70-
Tokens.Integer,
71-
Tokens.Long,
72-
Tokens.LongLong,
73-
Tokens.Single,
74-
Tokens.String
75-
};
76-
7760
private void GeneratePreview(IExtractMethodModel extractMethodModel,IExtractMethodProc extractMethodProc )
7861
{
7962
extractMethodModel.Method.MethodName = _view.MethodName;

RetailCoder.VBE/UI/Command/MenuItems/CommandBars/IContextFormatter.cs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
using System.Linq;
2+
using Rubberduck.Parsing;
23
using Rubberduck.Parsing.Symbols;
34
using Rubberduck.VBEditor.SafeComWrappers.Abstract;
45

@@ -39,7 +40,7 @@ private string Format(Declaration declaration)
3940
var formattedDeclaration = string.Empty;
4041
var moduleName = declaration.QualifiedName.QualifiedModuleName;
4142
var typeName = declaration.HasTypeHint
42-
? Declaration.TypeHintToTypeName[declaration.TypeHint]
43+
? SymbolList.TypeHintToTypeName[declaration.TypeHint]
4344
: declaration.AsTypeName;
4445
var declarationType = RubberduckUI.ResourceManager.GetString("DeclarationType_" + declaration.DeclarationType, Settings.Settings.Culture);
4546

Lines changed: 39 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,39 @@
1+
using System;
2+
using System.Collections.Generic;
3+
using System.Diagnostics;
4+
using System.Linq;
5+
using System.Runtime.InteropServices;
6+
using System.Runtime.InteropServices.ComTypes;
7+
using System.Security.Permissions;
8+
using System.Text;
9+
using System.Threading.Tasks;
10+
using TYPEATTR = System.Runtime.InteropServices.ComTypes.TYPEATTR;
11+
12+
namespace Rubberduck.Parsing.ComReflection
13+
{
14+
public class ComAlias : ComBase
15+
{
16+
public VarEnum VarType { get; set; }
17+
18+
public string TypeName { get; set; }
19+
20+
public ComAlias(ITypeLib typeLib, ITypeInfo info, int index, TYPEATTR attributes) : base(typeLib, index)
21+
{
22+
Index = index;
23+
Documentation = new ComDocumentation(typeLib, index);
24+
VarType = (VarEnum)attributes.tdescAlias.vt;
25+
if (ComVariant.TypeNames.ContainsKey(VarType))
26+
{
27+
TypeName = ComVariant.TypeNames[VarType];
28+
}
29+
else if (VarType == VarEnum.VT_USERDEFINED)
30+
{
31+
//?
32+
}
33+
else
34+
{
35+
throw new NotImplementedException(string.Format("Didn't expect an alias with a type of {0}.", VarType));
36+
}
37+
}
38+
}
39+
}

Rubberduck.Parsing/ComReflection/ComProject.cs

Lines changed: 11 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,12 @@ public class ComProject : ComBase
2525
// ReSharper disable once NotAccessedField.Local
2626
private TypeLibTypeFlags _flags;
2727

28+
private readonly List<ComAlias> _aliases = new List<ComAlias>();
29+
public IEnumerable<ComAlias> Aliases
30+
{
31+
get { return _aliases; }
32+
}
33+
2834
private readonly List<ComInterface> _interfaces = new List<ComInterface>();
2935
public IEnumerable<ComInterface> Interfaces
3036
{
@@ -120,10 +126,6 @@ private void LoadModules(ITypeLib typeLibrary)
120126
if (type != null) KnownTypes.TryAdd(typeAttributes.guid, coclass);
121127
break;
122128
case TYPEKIND.TKIND_ALIAS:
123-
//The current handling of this is wrong - these don't have to be classes or interfaces. In the VBE module for example,
124-
//"LongPtr" is defined as an alias to "Long" (at least on a 32 bit system) - RD is currently treating is like a class.
125-
//Unclear if these can *also* define alternative names for interfaces as well, but all the ones I've seen have been basically
126-
//a C typedef. So... this needs work. Don't make any assumptions about these elsewhere in the code until this is nailed down.
127129
case TYPEKIND.TKIND_DISPATCH:
128130
case TYPEKIND.TKIND_INTERFACE:
129131
var intface = type ?? new ComInterface(typeLibrary, info, typeAttributes, index);
@@ -139,6 +141,11 @@ private void LoadModules(ITypeLib typeLibrary)
139141
_modules.Add(module as ComModule);
140142
if (type != null) KnownTypes.TryAdd(typeAttributes.guid, module);
141143
break;
144+
//case TYPEKIND.TKIND_ALIAS:
145+
// //TKIND_ALIAS does not appear to be a supported member type in VBA - cache it internally to use the aliased type.
146+
// var alias = new ComAlias(typeLibrary, info, index, typeAttributes);
147+
// _aliases.Add(alias);
148+
// break;
142149
case TYPEKIND.TKIND_UNION:
143150
//TKIND_UNION is not a supported member type in VBA.
144151
break;

Rubberduck.Parsing/ComReflection/ComVariant.cs

Lines changed: 26 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
using System;
22
using System.Collections.Generic;
33
using System.Runtime.InteropServices;
4+
using Rubberduck.Parsing.Grammar;
45

56
namespace Rubberduck.Parsing.ComReflection
67
{
@@ -9,32 +10,32 @@ public class ComVariant
910
{
1011
internal static readonly IDictionary<VarEnum, string> TypeNames = new Dictionary<VarEnum, string>
1112
{
12-
{VarEnum.VT_DISPATCH, "Object"},
13+
{VarEnum.VT_DISPATCH, Tokens.Object},
1314
{VarEnum.VT_VOID, string.Empty},
14-
{VarEnum.VT_VARIANT, "Variant"},
15-
{VarEnum.VT_BLOB_OBJECT, "Object"},
16-
{VarEnum.VT_STORED_OBJECT, "Object"},
17-
{VarEnum.VT_STREAMED_OBJECT, "Object"},
18-
{VarEnum.VT_BOOL, "Boolean"},
19-
{VarEnum.VT_BSTR, "String"},
20-
{VarEnum.VT_LPSTR, "String"},
21-
{VarEnum.VT_LPWSTR, "String"},
22-
{VarEnum.VT_I1, "Variant"}, // no signed byte type in VBA
23-
{VarEnum.VT_UI1, "Byte"},
24-
{VarEnum.VT_I2, "Integer"},
25-
{VarEnum.VT_UI2, "Variant"}, // no unsigned integer type in VBA
26-
{VarEnum.VT_I4, "Long"},
27-
{VarEnum.VT_UI4, "Variant"}, // no unsigned long integer type in VBA
28-
{VarEnum.VT_I8, "Variant"}, // LongLong on 64-bit VBA
29-
{VarEnum.VT_UI8, "Variant"}, // no unsigned LongLong integer type in VBA
30-
{VarEnum.VT_INT, "Long"}, // same as I4
31-
{VarEnum.VT_UINT, "Variant"}, // same as UI4
32-
{VarEnum.VT_DATE, "Date"},
33-
{VarEnum.VT_CY, "Currency"},
34-
{VarEnum.VT_DECIMAL, "Currency"}, // best match?
35-
{VarEnum.VT_EMPTY, "Empty"},
36-
{VarEnum.VT_R4, "Single"},
37-
{VarEnum.VT_R8, "Double"},
15+
{VarEnum.VT_VARIANT, Tokens.Variant},
16+
{VarEnum.VT_BLOB_OBJECT, Tokens.Object},
17+
{VarEnum.VT_STORED_OBJECT, Tokens.Object},
18+
{VarEnum.VT_STREAMED_OBJECT, Tokens.Object},
19+
{VarEnum.VT_BOOL, Tokens.Boolean},
20+
{VarEnum.VT_BSTR, Tokens.String},
21+
{VarEnum.VT_LPSTR, Tokens.LongPtr},
22+
{VarEnum.VT_LPWSTR, Tokens.LongPtr},
23+
{VarEnum.VT_I1, Tokens.Variant}, // no signed byte type in VBA
24+
{VarEnum.VT_UI1, Tokens.Byte},
25+
{VarEnum.VT_I2, Tokens.Integer},
26+
{VarEnum.VT_UI2, Tokens.Variant}, // no unsigned integer type in VBA
27+
{VarEnum.VT_I4, Tokens.Long},
28+
{VarEnum.VT_UI4, Tokens.Variant}, // no unsigned long integer type in VBA
29+
{VarEnum.VT_I8, Tokens.Variant}, // LongLong on 64-bit VBA
30+
{VarEnum.VT_UI8, Tokens.Variant}, // no unsigned LongLong integer type in VBA
31+
{VarEnum.VT_INT, Tokens.Long}, // same as I4
32+
{VarEnum.VT_UINT, Tokens.Variant}, // same as UI4
33+
{VarEnum.VT_DATE, Tokens.Date},
34+
{VarEnum.VT_CY, Tokens.Currency},
35+
{VarEnum.VT_DECIMAL, Tokens.Decimal},
36+
{VarEnum.VT_EMPTY, Tokens.Empty},
37+
{VarEnum.VT_R4, Tokens.Single},
38+
{VarEnum.VT_R8, Tokens.Double},
3839
};
3940

4041

0 commit comments

Comments
 (0)