|
7 | 7 | using Rubberduck.UI;
|
8 | 8 | using Rubberduck.VBEditor;
|
9 | 9 | using Rubberduck.VBEditor.SafeComWrappers;
|
10 |
| -using Rubberduck.VBEditor.SafeComWrappers.Abstract; |
11 | 10 | using RubberduckTests.Mocks;
|
12 | 11 |
|
13 | 12 | namespace RubberduckTests.Refactoring
|
@@ -865,36 +864,68 @@ Private Sub Foo()
|
865 | 864 | [Category("Refactorings")]
|
866 | 865 | public void MoveCloser_RespectsObjectProperties_InUsages()
|
867 | 866 | {
|
868 |
| - const string input = @"Option Explicit |
| 867 | + string inputClassCode = |
| 868 | +@" |
| 869 | +Option Explicit |
| 870 | +
|
| 871 | +Private _name As Long |
| 872 | +Private _myOtherProperty As Long |
| 873 | +
|
| 874 | +Public Property Set Name(name As String) |
| 875 | + _name = name |
| 876 | +End Property |
| 877 | +
|
| 878 | +Public Property Get Name() As String |
| 879 | + Name = _name |
| 880 | +End Property |
| 881 | +
|
| 882 | +Public Property Set OtherProperty(val As Long) |
| 883 | + _myOtherProperty = val |
| 884 | +End Property |
| 885 | +
|
| 886 | +Public Property Get OtherProperty() As Long |
| 887 | + OtherProperty = _myOtherProperty |
| 888 | +End Property |
| 889 | +
|
| 890 | +"; |
| 891 | + string inputCode = @"Private foo As Class1 |
| 892 | +
|
869 | 893 |
|
870 | 894 | Public Sub Test()
|
871 |
| - Dim foo As Object |
872 | 895 | Debug.Print ""Some statements between""
|
873 | 896 | Debug.Print ""Declaration and first usage!""
|
874 |
| - Set foo = CreateObject(""Some.Object"") |
| 897 | + Set foo = new Class1 |
875 | 898 | foo.Name = ""FooName""
|
876 | 899 | foo.OtherProperty = 1626
|
877 | 900 | End Sub";
|
878 | 901 |
|
879 |
| - const string expected = @"Option Explicit |
| 902 | + var selection = new Selection(1, 1); |
880 | 903 |
|
881 |
| -Public Sub Test() |
| 904 | + const string expected = @"Public Sub Test() |
882 | 905 | Debug.Print ""Some statements between""
|
883 | 906 | Debug.Print ""Declaration and first usage!""
|
884 |
| - Dim foo As Object |
885 |
| -Set foo = CreateObject(""Some.Object"") |
| 907 | + Dim foo As Class1 |
| 908 | +Set foo = new Class1 |
886 | 909 | foo.Name = ""FooName""
|
887 | 910 | foo.OtherProperty = 1626
|
888 | 911 | End Sub";
|
889 | 912 |
|
890 |
| - var vbe = MockVbeBuilder.BuildFromSingleStandardModule(input, out var component, referenceStdLibs: true); |
891 |
| - |
| 913 | + var builder = new MockVbeBuilder(); |
| 914 | + var project = builder.ProjectBuilder("VBAProject", ProjectProtection.Unprotected); |
| 915 | + project.AddComponent("Class1", ComponentType.ClassModule, inputClassCode); |
| 916 | + project.AddComponent("Module1", ComponentType.StandardModule, inputCode); |
| 917 | + builder = builder.AddProject(project.Build()); |
| 918 | + var vbe = builder.Build(); |
| 919 | + |
| 920 | + var testComponent = project.MockComponents.Find(mc => mc.Object.Name.Equals("Module1")); |
| 921 | + var qualifiedSelection = new QualifiedSelection(new QualifiedModuleName(testComponent.Object), selection); |
| 922 | + |
892 | 923 | using (var state = MockParser.CreateAndParse(vbe.Object))
|
893 | 924 | {
|
894 | 925 | var messageBox = new Mock<IMessageBox>();
|
895 | 926 | var refactoring = new MoveCloserToUsageRefactoring(vbe.Object, state, messageBox.Object);
|
896 |
| - refactoring.Refactor(state.AllUserDeclarations.First(d => d.DeclarationType == DeclarationType.Variable)); |
897 |
| - var rewriter = state.GetRewriter(component); |
| 927 | + refactoring.Refactor(qualifiedSelection); |
| 928 | + var rewriter = state.GetRewriter(testComponent.Object); |
898 | 929 | Assert.AreEqual(expected, rewriter.GetText());
|
899 | 930 | }
|
900 | 931 | }
|
|
0 commit comments