Skip to content

Commit

Permalink
Merge pull request #1996 from Hosch250/tests
Browse files Browse the repository at this point in the history
Get test for ImplicitActiveSheetReference inspection working
  • Loading branch information
Hosch250 committed Jul 8, 2016
2 parents 8fc93ec + 5b18e37 commit 1c6438a
Show file tree
Hide file tree
Showing 8 changed files with 1,085 additions and 28 deletions.
2 changes: 1 addition & 1 deletion RetailCoder.VBE/API/ParserState.cs
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,7 @@ public void Initialize(VBE vbe)
Func<IVBAPreprocessor> preprocessorFactory = () => new VBAPreprocessor(double.Parse(vbe.Version, CultureInfo.InvariantCulture));
_attributeParser = new AttributeParser(new ModuleExporter(), preprocessorFactory);
_parser = new RubberduckParser(_state, _attributeParser, preprocessorFactory,
new List<ICustomDeclarationLoader> { new DebugDeclarations(_state), new FormEventDeclarations(_state) });
new List<ICustomDeclarationLoader> { new DebugDeclarations(_state), new FormEventDeclarations(_state), new AliasDeclarations(_state) });
}

/// <summary>
Expand Down
2 changes: 1 addition & 1 deletion Rubberduck.Parsing/Symbols/AliasDeclarations.cs
Original file line number Diff line number Diff line change
Expand Up @@ -56,7 +56,7 @@ private IReadOnlyList<Declaration> AddAliasDeclarations()
item => item.IdentifierName == "Interaction" && item.Scope == "VBE7.DLL;VBA.Interaction");

var stringsModule = _state.AllDeclarations.SingleOrDefault(
item => item.IdentifierName == "Interaction" && item.Scope == "VBE7.DLL;VBA.Interaction");
item => item.IdentifierName == "Strings" && item.Scope == "VBE7.DLL;VBA.Strings");

// all these modules are all part of the same project--only need to check one
if (conversionModule == null)
Expand Down
Original file line number Diff line number Diff line change
@@ -1,10 +1,12 @@
using System.Linq;
using System.Collections.Generic;
using System.Linq;
using System.Threading;
using Microsoft.Vbe.Interop;
using Microsoft.VisualStudio.TestTools.UnitTesting;
using Moq;
using Rubberduck.Inspections;
using Rubberduck.Parsing;
using Rubberduck.Parsing.Annotations;
using Rubberduck.Parsing.Symbols;
using Rubberduck.Parsing.VBA;
using Rubberduck.VBEditor;
Expand All @@ -16,7 +18,7 @@ namespace RubberduckTests.Inspections
[TestClass]
public class ImplicitActiveSheetReferenceInspectionTests
{
[TestMethod, Ignore] // doesn't pick up the reference to "Range".
[TestMethod] // doesn't pick up the reference to "Range".
[TestCategory("Inspections")]
public void ReportsRange()
{
Expand All @@ -29,12 +31,9 @@ End Sub

//Arrange
var builder = new MockVbeBuilder();
var project = builder.ProjectBuilder("TestProject1", vbext_ProjectProtection.vbext_pp_none)
var project = builder.ProjectBuilder("TestProject1", "TestProject1", vbext_ProjectProtection.vbext_pp_none)
.AddComponent("Class1", vbext_ComponentType.vbext_ct_ClassModule, inputCode)
.AddReference("Excel", string.Empty, true)

// Apparently, the COM loader can't find it when it isn't actually loaded...
//.AddReference("VBA", "C:\\Program Files\\Common Files\\Microsoft Shared\\VBA\\VBA7.1\\VBE7.DLL", true)
.AddReference("Excel", "C:\\Program Files\\Microsoft Office\\Root\\Office 16\\EXCEL.EXE", true)
.Build();
var vbe = builder.AddProject(project).Build();

Expand All @@ -43,33 +42,106 @@ End Sub

var parser = MockParser.Create(vbe.Object, new RubberduckParserState(vbe.Object, new Mock<ISinks>().Object));

GetExcelRangeDeclarations().ForEach(d => parser.State.AddDeclaration(d));

parser.Parse(new CancellationTokenSource());
if (parser.State.Status >= ParserState.Error) { Assert.Inconclusive("Parser Error"); }

var inspection = new ImplicitActiveSheetReferenceInspection(vbe.Object, parser.State);
var inspectionResults = inspection.GetInspectionResults();

Assert.AreEqual(1, inspectionResults.Count());
}

[TestMethod]
[TestCategory("Inspections")]
public void InspectionType()
{
var builder = new MockVbeBuilder();
var project = builder.ProjectBuilder("TestProject1", "TestProject1", vbext_ProjectProtection.vbext_pp_none)
.AddComponent("Class1", vbext_ComponentType.vbext_ct_ClassModule, string.Empty)
.AddReference("Excel", "C:\\Program Files\\Microsoft Office\\Root\\Office 16\\EXCEL.EXE", true)
.Build();
var vbe = builder.AddProject(project).Build();

var inspection = new ImplicitActiveSheetReferenceInspection(vbe.Object, null);
Assert.AreEqual(CodeInspectionType.MaintainabilityAndReadabilityIssues, inspection.InspectionType);
}

[TestMethod]
[TestCategory("Inspections")]
public void InspectionName()
{
var builder = new MockVbeBuilder();
var project = builder.ProjectBuilder("TestProject1", "TestProject1", vbext_ProjectProtection.vbext_pp_none)
.AddComponent("Class1", vbext_ComponentType.vbext_ct_ClassModule, string.Empty)
.AddReference("Excel", "C:\\Program Files\\Microsoft Office\\Root\\Office 16\\EXCEL.EXE", true)
.Build();
var vbe = builder.AddProject(project).Build();

const string inspectionName = "ImplicitActiveSheetReferenceInspection";
var inspection = new ImplicitActiveSheetReferenceInspection(vbe.Object, null);

Assert.AreEqual(inspectionName, inspection.Name);
}

private List<Declaration> GetExcelRangeDeclarations()
{
var excelDeclaration = new ProjectDeclaration(new QualifiedMemberName(new QualifiedModuleName("Excel",
"C:\\Program Files\\Microsoft Office\\Root\\Office 16\\EXCEL.EXE", "Excel"), "Excel"), "Excel", true);

var listColumnDeclaration = new ClassModuleDeclaration(new QualifiedMemberName(
var globalDeclaration = new ClassModuleDeclaration(new QualifiedMemberName(
new QualifiedModuleName("Excel",
"C:\\Program Files\\Microsoft Office\\Root\\Office 16\\EXCEL.EXE", "ListColumn"),
"ListColumn"), excelDeclaration, "ListColumn", true, null, null);
"C:\\Program Files\\Microsoft Office\\Root\\Office 16\\EXCEL.EXE", "_Global"),
"_Global"), excelDeclaration, "_Global", true, null, null);

var rangeDeclaration =
new Declaration(
new QualifiedMemberName(
new QualifiedModuleName("Excel",
"C:\\Program Files\\Microsoft Office\\Root\\Office 16\\EXCEL.EXE", "ListColumn"), "Range"),
listColumnDeclaration, "EXCEL.EXE;Excel.ListColumn", "Range", null, false, false, Accessibility.Global,
(DeclarationType)3712, false, null, true, null, new Attributes());
var globalCoClassDeclarationAttributes = new Attributes();
globalCoClassDeclarationAttributes.AddPredeclaredIdTypeAttribute();
globalCoClassDeclarationAttributes.AddGlobalClassAttribute();

parser.State.AddDeclaration(excelDeclaration);
parser.State.AddDeclaration(listColumnDeclaration);
parser.State.AddDeclaration(rangeDeclaration);
var globalCoClassDeclaration = new ClassModuleDeclaration(new QualifiedMemberName(
new QualifiedModuleName("Excel",
"C:\\Program Files\\Microsoft Office\\Root\\Office 16\\EXCEL.EXE", "Global"),
"Global"), excelDeclaration, "Global", true, null, globalCoClassDeclarationAttributes);

parser.Parse(new CancellationTokenSource());
if (parser.State.Status >= ParserState.Error) { Assert.Inconclusive("Parser Error"); }
globalDeclaration.AddSubtype(globalCoClassDeclaration);
globalCoClassDeclaration.AddSupertype(globalDeclaration);
globalCoClassDeclaration.AddSupertype("_Global");

var inspection = new ImplicitActiveSheetReferenceInspection(vbe.Object, parser.State);
var inspectionResults = inspection.GetInspectionResults();
var rangeClassModuleDeclaration = new ClassModuleDeclaration(new QualifiedMemberName(
new QualifiedModuleName("Excel",
"C:\\Program Files\\Microsoft Office\\Root\\Office 16\\EXCEL.EXE", "Range"),
"Range"), excelDeclaration, "Range", true, new List<IAnnotation>(), new Attributes());

Assert.AreEqual(1, inspectionResults.Count());
var rangeDeclaration = new PropertyGetDeclaration(new QualifiedMemberName(
new QualifiedModuleName("Excel",
"C:\\Program Files\\Microsoft Office\\Root\\Office 16\\EXCEL.EXE", "_Global"), "Range"),
globalDeclaration, globalDeclaration, "Range", null, null, Accessibility.Global, null, Selection.Home,
false, true, new List<IAnnotation>(), new Attributes());

var firstParamDeclaration = new ParameterDeclaration(new QualifiedMemberName(
new QualifiedModuleName("Excel",
"C:\\Program Files\\Microsoft Office\\Root\\Office 16\\EXCEL.EXE", "_Global"),
"Cell1"), rangeDeclaration, "Variant", null, null, false, false);

var secondParamDeclaration = new ParameterDeclaration(new QualifiedMemberName(
new QualifiedModuleName("Excel",
"C:\\Program Files\\Microsoft Office\\Root\\Office 16\\EXCEL.EXE", "_Global"),
"Cell2"), rangeDeclaration, "Variant", null, null, true, false);

rangeDeclaration.AddParameter(firstParamDeclaration);
rangeDeclaration.AddParameter(secondParamDeclaration);

return new List<Declaration>
{
excelDeclaration,
globalDeclaration,
globalCoClassDeclaration,
rangeClassModuleDeclaration,
rangeDeclaration,
firstParamDeclaration,
secondParamDeclaration,
};
}
}
}
138 changes: 138 additions & 0 deletions RubberduckTests/Inspections/UnassignedVariableUsageInspectionTests.cs
Original file line number Diff line number Diff line change
@@ -0,0 +1,138 @@
using System.Linq;
using System.Threading;
using Microsoft.Vbe.Interop;
using Microsoft.VisualStudio.TestTools.UnitTesting;
using Moq;
using Rubberduck.Inspections;
using Rubberduck.Parsing;
using Rubberduck.Parsing.VBA;
using Rubberduck.VBEditor.Extensions;
using Rubberduck.VBEditor.VBEHost;
using RubberduckTests.Mocks;

namespace RubberduckTests.Inspections
{
[TestClass]
public class UnassignedVariableUsageInspectionTests
{
[TestMethod]
[TestCategory("Inspections")]
public void UnassignedVariableUsage_ReturnsResult()
{
const string inputCode =
@"Sub Foo()
Dim b As Boolean
Dim bb As Boolean
bb = b
End Sub";

//Arrange
var builder = new MockVbeBuilder();
var project = builder.ProjectBuilder("VBAProject", vbext_ProjectProtection.vbext_pp_none)
.AddComponent("MyClass", vbext_ComponentType.vbext_ct_ClassModule, inputCode)
.Build();
var vbe = builder.AddProject(project).Build();

var mockHost = new Mock<IHostApplication>();
mockHost.SetupAllProperties();
var parser = MockParser.Create(vbe.Object, new RubberduckParserState(vbe.Object, new Mock<ISinks>().Object));

parser.Parse(new CancellationTokenSource());
if (parser.State.Status >= ParserState.Error) { Assert.Inconclusive("Parser Error"); }

var inspection = new UnassignedVariableUsageInspection(parser.State);
var inspectionResults = inspection.GetInspectionResults();

Assert.AreEqual(1, inspectionResults.Count());
}

[TestMethod]
[TestCategory("Inspections")]
public void UnassignedVariableUsage_DoesNotReturnResult()
{
const string inputCode =
@"Sub Foo()
Dim b As Boolean
Dim bb As Boolean
b = True
bb = b
End Sub";

//Arrange
var builder = new MockVbeBuilder();
var project = builder.ProjectBuilder("VBAProject", vbext_ProjectProtection.vbext_pp_none)
.AddComponent("MyClass", vbext_ComponentType.vbext_ct_ClassModule, inputCode)
.Build();
var vbe = builder.AddProject(project).Build();

var mockHost = new Mock<IHostApplication>();
mockHost.SetupAllProperties();
var parser = MockParser.Create(vbe.Object, new RubberduckParserState(vbe.Object, new Mock<ISinks>().Object));

parser.Parse(new CancellationTokenSource());
if (parser.State.Status >= ParserState.Error) { Assert.Inconclusive("Parser Error"); }

var inspection = new UnassignedVariableUsageInspection(parser.State);
var inspectionResults = inspection.GetInspectionResults();

Assert.IsFalse(inspectionResults.Any());
}

[TestMethod]
[TestCategory("Inspections")]
public void UnassignedVariableUsage_QuickFixWorks()
{
const string inputCode =
@"Sub Foo()
Dim b As Boolean
Dim bb As Boolean
bb = b
End Sub";

const string expectedCode =
@"Sub Foo()
Dim b As Boolean
Dim bb As Boolean
TODOTODO = TODO
End Sub";

//Arrange
var builder = new MockVbeBuilder();
VBComponent component;
var vbe = builder.BuildFromSingleStandardModule(inputCode, out component);
var project = vbe.Object.VBProjects.Item(0);
var module = project.VBComponents.Item(0).CodeModule;
var mockHost = new Mock<IHostApplication>();
mockHost.SetupAllProperties();
var parser = MockParser.Create(vbe.Object, new RubberduckParserState(vbe.Object, new Mock<ISinks>().Object));

parser.Parse(new CancellationTokenSource());
if (parser.State.Status >= ParserState.Error) { Assert.Inconclusive("Parser Error"); }

var inspection = new UnassignedVariableUsageInspection(parser.State);
var inspectionResults = inspection.GetInspectionResults();

inspectionResults.First().QuickFixes.First().Fix();

Assert.AreEqual(expectedCode, module.Lines());
}

[TestMethod]
[TestCategory("Inspections")]
public void InspectionType()
{
var inspection = new UnassignedVariableUsageInspection(null);
Assert.AreEqual(CodeInspectionType.CodeQualityIssues, inspection.InspectionType);
}

[TestMethod]
[TestCategory("Inspections")]
public void InspectionName()
{
const string inspectionName = "UnassignedVariableUsageInspection";
var inspection = new UnassignedVariableUsageInspection(null);

Assert.AreEqual(inspectionName, inspection.Name);
}
}
}

0 comments on commit 1c6438a

Please sign in to comment.