Skip to content

Commit 04aa262

Browse files
committed
Stop using inspector for parse tree inspections
The inspector swallows exceptions, which we really do not want in tests.
1 parent ca77a8d commit 04aa262

File tree

5 files changed

+112
-15
lines changed

5 files changed

+112
-15
lines changed

Rubberduck.CodeAnalysis/QuickFixes/RestoreErrorHandlingQuickFix.cs

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,6 @@
11
using System.Collections.Generic;
22
using System.Linq;
3+
using System.Threading;
34
using Antlr4.Runtime;
45
using Rubberduck.Inspections.Abstract;
56
using Rubberduck.Inspections.Concrete;
@@ -93,7 +94,9 @@ public override void Fix(IInspectionResult result, IRewriteSession rewriteSessio
9394

9495
var rewriter = rewriteSession.CheckOutModuleRewriter(result.QualifiedSelection.QualifiedName);
9596
var context = (VBAParser.OnErrorStmtContext)result.Context;
96-
var labels = bodyElementContext.GetDescendents<VBAParser.IdentifierStatementLabelContext>().ToArray();
97+
var labels = bodyElementContext.GetDescendents<VBAParser.IdentifierStatementLabelContext>()
98+
.OrderBy(labelContext => labelContext.GetSelection())
99+
.ToArray();
97100
var maximumExistingLabelIndex = GetMaximumExistingLabelIndex(labels);
98101
var unhandledContexts = resultProperties.Properties;
99102
var offset = unhandledContexts.IndexOf(result.Context);

RubberduckTests/Inspections/InspectionTestsBase.cs

Lines changed: 33 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,12 @@
1-
using System.Collections.Generic;
1+
using System;
2+
using System.Collections.Generic;
23
using System.Threading;
4+
using Antlr4.Runtime.Tree;
35
using Rubberduck.Parsing.Inspections.Abstract;
46
using Rubberduck.Parsing.VBA;
7+
using Rubberduck.Parsing.VBA.Parsing;
8+
using Rubberduck.VBEditor;
9+
using Rubberduck.VBEditor.Extensions;
510
using Rubberduck.VBEditor.SafeComWrappers;
611
using Rubberduck.VBEditor.SafeComWrappers.Abstract;
712
using RubberduckTests.Mocks;
@@ -53,13 +58,37 @@ public IEnumerable<IInspectionResult> InspectionResults(IVBE vbe)
5358

5459
private static IEnumerable<IInspectionResult> InspectionResults(IInspection inspection, RubberduckParserState state)
5560
{
56-
if (inspection is IParseTreeInspection)
61+
if (inspection is IParseTreeInspection parseTreeInspection)
5762
{
58-
var inspector = InspectionsHelper.GetInspector(inspection);
59-
return inspector.FindIssuesAsync(state, CancellationToken.None).Result;
63+
WalkTrees(parseTreeInspection, state);
6064
}
6165

6266
return inspection.GetInspectionResults(CancellationToken.None);
6367
}
68+
69+
protected static void WalkTrees(IParseTreeInspection inspection, RubberduckParserState state)
70+
{
71+
var codeKind = inspection.TargetKindOfCode;
72+
var listener = inspection.Listener;
73+
74+
List<KeyValuePair<QualifiedModuleName, IParseTree>> trees;
75+
switch (codeKind)
76+
{
77+
case CodeKind.AttributesCode:
78+
trees = state.AttributeParseTrees;
79+
break;
80+
case CodeKind.CodePaneCode:
81+
trees = state.ParseTrees;
82+
break;
83+
default:
84+
throw new ArgumentOutOfRangeException(nameof(codeKind), codeKind, null);
85+
}
86+
87+
foreach (var (module, tree) in trees)
88+
{
89+
listener.CurrentModuleName = module;
90+
ParseTreeWalker.Default.Walk(listener, tree);
91+
}
92+
}
6493
}
6594
}

RubberduckTests/Inspections/ThunderCode/ThunderCodeInspectionTests.cs

Lines changed: 42 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,16 @@
11
using System;
2+
using System.Collections.Generic;
23
using System.Linq;
34
using System.Threading;
5+
using Antlr4.Runtime.Tree;
46
using NUnit.Framework;
57
using Rubberduck.Inspections.Inspections.Concrete.ThunderCode;
68
using Rubberduck.Parsing.Inspections.Abstract;
79
using Rubberduck.Parsing.VBA;
10+
using Rubberduck.Parsing.VBA.Parsing;
11+
using Rubberduck.Resources.Inspections;
12+
using Rubberduck.VBEditor;
13+
using Rubberduck.VBEditor.Extensions;
814
using RubberduckTests.Mocks;
915

1016
namespace RubberduckTests.Inspections.ThunderCode
@@ -275,11 +281,45 @@ private static void ThunderCatsGo(Func<RubberduckParserState, IInspection> inspe
275281
using (var state = MockParser.CreateAndParse(vbe.Object))
276282
{
277283
var inspection = inspectionFunction(state);
278-
var inspector = InspectionsHelper.GetInspector(inspection);
279-
var actualResults = inspector.FindIssuesAsync(state, CancellationToken.None).Result;
284+
var actualResults = InspectionResults(inspection, state);
280285

281286
Assert.AreEqual(expectedCount, actualResults.Count());
282287
}
283288
}
289+
290+
private static IEnumerable<IInspectionResult> InspectionResults(IInspection inspection, RubberduckParserState state)
291+
{
292+
if (inspection is IParseTreeInspection parseTreeInspection)
293+
{
294+
WalkTrees(parseTreeInspection, state);
295+
}
296+
297+
return inspection.GetInspectionResults(CancellationToken.None);
298+
}
299+
300+
private static void WalkTrees(IParseTreeInspection inspection, RubberduckParserState state)
301+
{
302+
var codeKind = inspection.TargetKindOfCode;
303+
var listener = inspection.Listener;
304+
305+
List<KeyValuePair<QualifiedModuleName, IParseTree>> trees;
306+
switch (codeKind)
307+
{
308+
case CodeKind.AttributesCode:
309+
trees = state.AttributeParseTrees;
310+
break;
311+
case CodeKind.CodePaneCode:
312+
trees = state.ParseTrees;
313+
break;
314+
default:
315+
throw new ArgumentOutOfRangeException(nameof(codeKind), codeKind, null);
316+
}
317+
318+
foreach (var (module, tree) in trees)
319+
{
320+
listener.CurrentModuleName = module;
321+
ParseTreeWalker.Default.Walk(listener, tree);
322+
}
323+
}
284324
}
285325
}

RubberduckTests/QuickFixes/QuickFixTestBase.cs

Lines changed: 29 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -2,14 +2,15 @@
22
using System.Collections.Generic;
33
using System.Linq;
44
using System.Threading;
5+
using Antlr4.Runtime.Tree;
56
using Rubberduck.Parsing.Inspections.Abstract;
67
using Rubberduck.Parsing.Rewriter;
78
using Rubberduck.Parsing.VBA;
89
using Rubberduck.Parsing.VBA.Parsing;
910
using Rubberduck.VBEditor;
11+
using Rubberduck.VBEditor.Extensions;
1012
using Rubberduck.VBEditor.SafeComWrappers;
1113
using Rubberduck.VBEditor.SafeComWrappers.Abstract;
12-
using RubberduckTests.Inspections;
1314
using RubberduckTests.Mocks;
1415

1516
namespace RubberduckTests.QuickFixes
@@ -90,15 +91,39 @@ private string ApplyQuickFixToAppropriateInspectionResults(
9091

9192
private IEnumerable<IInspectionResult> InspectionResults(IInspection inspection, RubberduckParserState state)
9293
{
93-
if (inspection is IParseTreeInspection)
94+
if (inspection is IParseTreeInspection parseTreeInspection)
9495
{
95-
var inspector = InspectionsHelper.GetInspector(inspection);
96-
return inspector.FindIssuesAsync(state, CancellationToken.None).Result;
96+
WalkTrees(parseTreeInspection, state);
9797
}
9898

9999
return inspection.GetInspectionResults(CancellationToken.None);
100100
}
101101

102+
private static void WalkTrees(IParseTreeInspection inspection, RubberduckParserState state)
103+
{
104+
var codeKind = inspection.TargetKindOfCode;
105+
var listener = inspection.Listener;
106+
107+
List<KeyValuePair<QualifiedModuleName, IParseTree>> trees;
108+
switch (codeKind)
109+
{
110+
case CodeKind.AttributesCode:
111+
trees = state.AttributeParseTrees;
112+
break;
113+
case CodeKind.CodePaneCode:
114+
trees = state.ParseTrees;
115+
break;
116+
default:
117+
throw new ArgumentOutOfRangeException(nameof(codeKind), codeKind, null);
118+
}
119+
120+
foreach (var (module, tree) in trees)
121+
{
122+
listener.CurrentModuleName = module;
123+
ParseTreeWalker.Default.Walk(listener, tree);
124+
}
125+
}
126+
102127
private void ApplyToFirstResult(IQuickFix quickFix, IEnumerable<IInspectionResult> inspectionResults, IRewriteSession rewriteSession)
103128
{
104129
var resultToFix = inspectionResults.First();

RubberduckTests/QuickFixes/RestoreErrorHandlingQuickFixTests.cs

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -129,14 +129,14 @@ On Error GoTo ErrorHandler
129129
On Error GoTo ErrorHandler1
130130
131131
Exit Sub
132-
ErrorHandler1:
132+
ErrorHandler:
133133
If Err.Number > 0 Then 'TODO: handle specific error
134134
Err.Clear
135135
Resume Next
136136
End If
137137
138138
Exit Sub
139-
ErrorHandler:
139+
ErrorHandler1:
140140
If Err.Number > 0 Then 'TODO: handle specific error
141141
Err.Clear
142142
Resume Next
@@ -167,14 +167,14 @@ On Error GoTo ErrorHandler3
167167
ErrorHandler1:
168168
169169
Exit Sub
170-
ErrorHandler3:
170+
ErrorHandler2:
171171
If Err.Number > 0 Then 'TODO: handle specific error
172172
Err.Clear
173173
Resume Next
174174
End If
175175
176176
Exit Sub
177-
ErrorHandler2:
177+
ErrorHandler3:
178178
If Err.Number > 0 Then 'TODO: handle specific error
179179
Err.Clear
180180
Resume Next

0 commit comments

Comments
 (0)