Skip to content

Commit

Permalink
Merge pull request #4121 from MDoerner/FixingStuff
Browse files Browse the repository at this point in the history
Fix for MoveCloserToUsage quickfix problem
  • Loading branch information
retailcoder committed Jun 26, 2018
2 parents b20482c + 9470515 commit 23039cc
Show file tree
Hide file tree
Showing 7 changed files with 122 additions and 19 deletions.
26 changes: 18 additions & 8 deletions Rubberduck.Parsing/ComReflection/ComProject.cs
Expand Up @@ -108,30 +108,37 @@ private void LoadModules(ITypeLib typeLibrary)
{
ITypeInfo info;
typeLibrary.GetTypeInfo(index, out info);
IntPtr typeAttributesPointer;
info.GetTypeAttr(out typeAttributesPointer);
info.GetTypeAttr(out var typeAttributesPointer);
var typeAttributes = (TYPEATTR)Marshal.PtrToStructure(typeAttributesPointer, typeof(TYPEATTR));

ComType type;
KnownTypes.TryGetValue(typeAttributes.guid, out type);
KnownTypes.TryGetValue(typeAttributes.guid, out var type);

switch (typeAttributes.typekind)
{
case TYPEKIND.TKIND_ENUM:
var enumeration = type ?? new ComEnumeration(typeLibrary, info, typeAttributes, index);
_enumerations.Add(enumeration as ComEnumeration);
if (type == null) KnownTypes.TryAdd(typeAttributes.guid, enumeration);
if (type == null)
{
KnownTypes.TryAdd(typeAttributes.guid, enumeration);
}
break;
case TYPEKIND.TKIND_COCLASS:
var coclass = type ?? new ComCoClass(typeLibrary, info, typeAttributes, index);
_classes.Add(coclass as ComCoClass);
if (type == null) KnownTypes.TryAdd(typeAttributes.guid, coclass);
if (type == null)
{
KnownTypes.TryAdd(typeAttributes.guid, coclass);
}
break;
case TYPEKIND.TKIND_DISPATCH:
case TYPEKIND.TKIND_INTERFACE:
var intface = type ?? new ComInterface(typeLibrary, info, typeAttributes, index);
_interfaces.Add(intface as ComInterface);
if (type == null) KnownTypes.TryAdd(typeAttributes.guid, intface);
if (type == null)
{
KnownTypes.TryAdd(typeAttributes.guid, intface);
}
break;
case TYPEKIND.TKIND_RECORD:
var structure = new ComStruct(typeLibrary, info, typeAttributes, index);
Expand All @@ -140,7 +147,10 @@ private void LoadModules(ITypeLib typeLibrary)
case TYPEKIND.TKIND_MODULE:
var module = type ?? new ComModule(typeLibrary, info, typeAttributes, index);
_modules.Add(module as ComModule);
if (type == null) KnownTypes.TryAdd(typeAttributes.guid, module);
if (type == null)
{
KnownTypes.TryAdd(typeAttributes.guid, module);
}
break;
case TYPEKIND.TKIND_ALIAS:
var alias = new ComAlias(typeLibrary, info, index, typeAttributes);
Expand Down
2 changes: 1 addition & 1 deletion Rubberduck.Parsing/Grammar/VBAParser.g4
Expand Up @@ -410,7 +410,7 @@ listOrLabel :
lineNumberLabel (whiteSpace? COLON whiteSpace? sameLineStatement?)*
| (COLON whiteSpace?)? sameLineStatement (whiteSpace? COLON whiteSpace? sameLineStatement?)*
;
sameLineStatement : blockStmt;
sameLineStatement : mainBlockStmt;
booleanExpression : expression;

implementsStmt : IMPLEMENTS whiteSpace expression;
Expand Down
3 changes: 3 additions & 0 deletions Rubberduck.Parsing/VBA/ParseCoordinator.cs
Expand Up @@ -352,6 +352,9 @@ private void ParseAllInternal(object requestor, CancellationToken token)
toParse.UnionWith(modules.Where(module => _parserStateManager.GetModuleState(module) != ParserState.Ready));
token.ThrowIfCancellationRequested();

toParse = toParse.Where(module => module.IsParsable).ToHashSet();
token.ThrowIfCancellationRequested();

var removedModules = RemovedModules(modules);
token.ThrowIfCancellationRequested();

Expand Down
8 changes: 1 addition & 7 deletions Rubberduck.Parsing/VBA/ParseRunner.cs
Expand Up @@ -42,13 +42,7 @@ public override void ParseModules(IReadOnlyCollection<QualifiedModuleName> modul
{
Parallel.ForEach(modules,
options,
module =>
{
if (module.IsParsable)
{
ParseModule(module, token);
}
}
module => ParseModule(module, token)
);
}
catch (AggregateException exception)
Expand Down
2 changes: 0 additions & 2 deletions Rubberduck.Parsing/VBA/ParseRunnerBase.cs
Expand Up @@ -5,8 +5,6 @@
using System.Threading;
using Rubberduck.Parsing.PreProcessing;
using Antlr4.Runtime;
using Rubberduck.Parsing.Inspections.Abstract;
using Rubberduck.Parsing.Symbols;
using Rubberduck.Parsing.Symbols.ParsingExceptions;

namespace Rubberduck.Parsing.VBA
Expand Down
2 changes: 1 addition & 1 deletion Rubberduck.Parsing/VBA/ReferenceResolveRunnerBase.cs
Expand Up @@ -63,7 +63,7 @@ public void ResolveReferences(IReadOnlyCollection<QualifiedModuleName> toResolve
{
token.ThrowIfCancellationRequested();

_toResolve.UnionWith(toResolve.Where(qmn => qmn.IsParsable));
_toResolve.UnionWith(toResolve);
token.ThrowIfCancellationRequested();

if(!_toResolve.Any())
Expand Down
98 changes: 98 additions & 0 deletions RubberduckTests/QuickFixes/MoveFieldCloserToUsageQuickFixTests.cs
Expand Up @@ -39,5 +39,103 @@ public void MoveFieldCloserToUsage_QuickFixWorks()
Assert.AreEqual(expectedCode, component.CodeModule.Content());
}
}

[Test]
[Category("QuickFixes")]
public void MoveFieldCloserToUsage_QuickFixWorks_SingleLineIfStatemente()
{
const string inputCode =
@"Private bar As String
Public Sub Foo()
If bar = ""test"" Then Baz Else Foobar
End Sub
Private Sub Baz()
End Sub
Private Sub FooBar()
End Sub
";

const string expectedCode =
@"Public Sub Foo()
Dim bar As String
If bar = ""test"" Then Baz Else Foobar
End Sub
Private Sub Baz()
End Sub
Private Sub FooBar()
End Sub
";

var vbe = MockVbeBuilder.BuildFromSingleStandardModule(inputCode, out var component);
using (var state = MockParser.CreateAndParse(vbe.Object))
{
var inspection = new MoveFieldCloserToUsageInspection(state);
var inspectionResults = inspection.GetInspectionResults(CancellationToken.None);

new MoveFieldCloserToUsageQuickFix(vbe.Object, state, new Mock<IMessageBox>().Object).Fix(inspectionResults.First());
Assert.AreEqual(expectedCode, component.CodeModule.Content());
}
}

[Test]
[Category("QuickFixes")]
public void MoveFieldCloserToUsage_QuickFixWorks_SingleLineThenStatemente()
{
const string inputCode =
@"Private bar As String
Public Sub Foo()
If True Then bar = ""test""
End Sub";

const string expectedCode =
@"Public Sub Foo()
Dim bar As String
If True Then bar = ""test""
End Sub";

var vbe = MockVbeBuilder.BuildFromSingleStandardModule(inputCode, out var component);
using (var state = MockParser.CreateAndParse(vbe.Object))
{
var inspection = new MoveFieldCloserToUsageInspection(state);
var inspectionResults = inspection.GetInspectionResults(CancellationToken.None);

new MoveFieldCloserToUsageQuickFix(vbe.Object, state, new Mock<IMessageBox>().Object).Fix(inspectionResults.First());
Assert.AreEqual(expectedCode, component.CodeModule.Content());
}
}

[Test]
[Category("QuickFixes")]
public void MoveFieldCloserToUsage_QuickFixWorks_SingleLineElseStatemente()
{
const string inputCode =
@"Private bar As String
Public Sub Foo()
If True Then Else bar = ""test""
End Sub";

const string expectedCode =
@"Public Sub Foo()
Dim bar As String
If True Then Else bar = ""test""
End Sub";

var vbe = MockVbeBuilder.BuildFromSingleStandardModule(inputCode, out var component);
using (var state = MockParser.CreateAndParse(vbe.Object))
{
var inspection = new MoveFieldCloserToUsageInspection(state);
var inspectionResults = inspection.GetInspectionResults(CancellationToken.None);

new MoveFieldCloserToUsageQuickFix(vbe.Object, state, new Mock<IMessageBox>().Object).Fix(inspectionResults.First());
Assert.AreEqual(expectedCode, component.CodeModule.Content());
}
}
}
}

0 comments on commit 23039cc

Please sign in to comment.