Skip to content

Commit 02472c8

Browse files
committed
Brought information about the parsed component, the parse pass and the type of parse (preprocessing/main parse) into the syntax errors their logging.
1 parent 78263f8 commit 02472c8

27 files changed

+325
-115
lines changed

RetailCoder.VBE/UI/Command/SyntaxErrorExtensions.cs

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,5 @@
11
using Rubberduck.Parsing.Symbols;
2+
using Rubberduck.Parsing.Symbols.ParsingExceptions;
23
using Rubberduck.VBEditor;
34

45
namespace Rubberduck.UI.Command

Rubberduck.Parsing/Preprocessing/IVBAPreprocessor.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,6 @@ namespace Rubberduck.Parsing.PreProcessing
55
{
66
public interface IVBAPreprocessor
77
{
8-
void PreprocessTokenStream(string moduleName, CommonTokenStream unprocessedTokenStream, CancellationToken token);
8+
void PreprocessTokenStream(string moduleName, CommonTokenStream unprocessedTokenStream, BaseErrorListener errorListener, CancellationToken token);
99
}
1010
}

Rubberduck.Parsing/Preprocessing/VBAPrecompilationParser.cs

Lines changed: 19 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -3,27 +3,42 @@
33
using Antlr4.Runtime.Atn;
44
using NLog;
55
using Rubberduck.Parsing.Symbols;
6+
using Rubberduck.Parsing.Symbols.ParsingExceptions;
7+
using Rubberduck.Parsing.VBA;
68

79
namespace Rubberduck.Parsing.PreProcessing
810
{
911
public sealed class VBAPrecompilationParser
1012
{
1113
private static readonly Logger Logger = LogManager.GetCurrentClassLogger();
1214

13-
public VBAConditionalCompilationParser.CompilationUnitContext Parse(string moduleName, CommonTokenStream unprocessedTokenStream)
15+
public VBAConditionalCompilationParser.CompilationUnitContext Parse(string moduleName, CommonTokenStream unprocessedTokenStream, BaseErrorListener errorListener)
1416
{
1517
unprocessedTokenStream.Reset();
1618
var parser = new VBAConditionalCompilationParser(unprocessedTokenStream);
17-
parser.AddErrorListener(new ExceptionErrorListener()); // notify?
19+
parser.AddErrorListener(errorListener);
1820
VBAConditionalCompilationParser.CompilationUnitContext tree;
1921
try
2022
{
2123
parser.Interpreter.PredictionMode = PredictionMode.Sll;
2224
tree = parser.compilationUnit();
2325
}
24-
catch (Exception ex)
26+
catch (ParsePassSyntaxErrorException syntaxErrorException)
2527
{
26-
Logger.Warn(ex, "SLL mode failed in module {0}. Retrying using LL.", moduleName);
28+
var parsePassText = syntaxErrorException.ParsePass == ParsePass.CodePanePass
29+
? "code pane"
30+
: "exported";
31+
Logger.Warn($"SLL mode failed while preprocessing the {parsePassText} version of module {moduleName} at symbol {syntaxErrorException.OffendingSymbol.Text} at L{syntaxErrorException.LineNumber}C{syntaxErrorException.Position}. Retrying using LL.");
32+
Logger.Debug(syntaxErrorException, "SLL mode exception");
33+
unprocessedTokenStream.Reset();
34+
parser.Reset();
35+
parser.Interpreter.PredictionMode = PredictionMode.Ll;
36+
tree = parser.compilationUnit();
37+
}
38+
catch (Exception exception)
39+
{
40+
Logger.Warn($"SLL mode failed while prprocessing module {moduleName}. Retrying using LL.");
41+
Logger.Debug(exception, "SLL mode exception");
2742
unprocessedTokenStream.Reset();
2843
parser.Reset();
2944
parser.Interpreter.PredictionMode = PredictionMode.Ll;

Rubberduck.Parsing/Preprocessing/VBAPreprocessor.cs

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
using Antlr4.Runtime;
22
using System.Threading;
3+
using Rubberduck.Parsing.Symbols;
4+
using Rubberduck.Parsing.VBA;
35

46
namespace Rubberduck.Parsing.PreProcessing
57
{
@@ -14,11 +16,11 @@ public VBAPreprocessor(double vbaVersion)
1416
_parser = new VBAPrecompilationParser();
1517
}
1618

17-
public void PreprocessTokenStream(string moduleName, CommonTokenStream tokenStream, CancellationToken token)
19+
public void PreprocessTokenStream(string moduleName, CommonTokenStream tokenStream, BaseErrorListener errorListener, CancellationToken token)
1820
{
1921
token.ThrowIfCancellationRequested();
2022
var symbolTable = new SymbolTable<string, IValue>();
21-
var tree = _parser.Parse(moduleName, tokenStream);
23+
var tree = _parser.Parse(moduleName, tokenStream, errorListener);
2224
token.ThrowIfCancellationRequested();
2325
var stream = tokenStream.TokenSource.InputStream;
2426
var evaluator = new VBAPreprocessorVisitor(symbolTable, new VBAPredefinedCompilationConstants(_vbaVersion), stream, tokenStream);

Rubberduck.Parsing/Rubberduck.Parsing.csproj

Lines changed: 11 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -154,6 +154,13 @@
154154
<Compile Include="Inspections\Abstract\IInspector.cs" />
155155
<Compile Include="Inspections\Abstract\IParseTreeInspection.cs" />
156156
<Compile Include="Inspections\Abstract\IQuickFix.cs" />
157+
<Compile Include="Symbols\ParsingExceptions\MainParseExceptionErrorListener.cs" />
158+
<Compile Include="Symbols\ParsingExceptions\PreprocessorExceptionErrorListener.cs" />
159+
<Compile Include="Symbols\ParsingExceptions\ParsePassExceptionErrorListener.cs" />
160+
<Compile Include="Symbols\ParsingExceptions\ParsePassSyntaxErrorException.cs" />
161+
<Compile Include="Symbols\ParsingExceptions\ParsePassSyntaxErrorInfo.cs" />
162+
<Compile Include="Symbols\ParsingExceptions\MainParseSyntaxErrorException.cs" />
163+
<Compile Include="Symbols\ParsingExceptions\PreprosessorSyntaxErrorException.cs" />
157164
<Compile Include="VBA\ParsePass.cs" />
158165
<Compile Include="Inspections\CannotAnnotateAttribute.cs" />
159166
<Compile Include="Inspections\RequiredLibraryAttribute.cs" />
@@ -316,7 +323,7 @@
316323
<Compile Include="Symbols\CommentExtensions.cs" />
317324
<Compile Include="Symbols\DeclarationEventArgs.cs" />
318325
<Compile Include="Symbols\DeclarationFinder.cs" />
319-
<Compile Include="Symbols\ExceptionErrorListener.cs" />
326+
<Compile Include="Symbols\ParsingExceptions\ExceptionErrorListener.cs" />
320327
<Compile Include="Symbols\ICanBeDefaultMember.cs" />
321328
<Compile Include="Symbols\IParameterizedDeclaration.cs" />
322329
<Compile Include="Symbols\PropertyLetDeclaration.cs" />
@@ -328,8 +335,8 @@
328335
<Compile Include="Symbols\SquareBracketedNameComparer.cs" />
329336
<Compile Include="Symbols\SubroutineDeclaration.cs" />
330337
<Compile Include="Symbols\ProjectReferencePass.cs" />
331-
<Compile Include="Symbols\SyntaxErrorInfo.cs" />
332-
<Compile Include="Symbols\SyntaxErrorNotificationListener.cs" />
338+
<Compile Include="Symbols\ParsingExceptions\SyntaxErrorInfo.cs" />
339+
<Compile Include="Symbols\ParsingExceptions\SyntaxErrorNotificationListener.cs" />
333340
<Compile Include="Symbols\TypeHierarchyPass.cs" />
334341
<Compile Include="Symbols\TypeAnnotationPass.cs" />
335342
<Compile Include="Symbols\IdentifierReferenceResolver.cs" />
@@ -339,7 +346,7 @@
339346
<Compile Include="Symbols\ProjectDeclaration.cs" />
340347
<Compile Include="Symbols\ProjectReference.cs" />
341348
<Compile Include="ComReflection\ReferencedDeclarationsCollector.cs" />
342-
<Compile Include="Symbols\SyntaxErrorException.cs" />
349+
<Compile Include="Symbols\ParsingExceptions\SyntaxErrorException.cs" />
343350
<Compile Include="ParserRuleContextExtensions.cs" />
344351
<Compile Include="Properties\AssemblyInfo.cs" />
345352
<Compile Include="QualifiedContext.cs" />

Rubberduck.Parsing/Symbols/ExceptionErrorListener.cs renamed to Rubberduck.Parsing/Symbols/ParsingExceptions/ExceptionErrorListener.cs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
using Antlr4.Runtime;
22

3-
namespace Rubberduck.Parsing.Symbols
3+
namespace Rubberduck.Parsing.Symbols.ParsingExceptions
44
{
55
public class ExceptionErrorListener : BaseErrorListener
66
{
Lines changed: 18 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,18 @@
1+
using Antlr4.Runtime;
2+
using Rubberduck.Parsing.VBA;
3+
4+
namespace Rubberduck.Parsing.Symbols.ParsingExceptions
5+
{
6+
public class MainParseExceptionErrorListener : ParsePassExceptionErrorListener
7+
{
8+
public MainParseExceptionErrorListener(string componentName, ParsePass parsePass)
9+
:base(componentName, parsePass)
10+
{ }
11+
12+
public override void SyntaxError(IRecognizer recognizer, IToken offendingSymbol, int line, int charPositionInLine, string msg, RecognitionException e)
13+
{
14+
// adding 1 to line, because line is 0-based, but it's 1-based in the VBE
15+
throw new MainParseSyntaxErrorException(msg, e, offendingSymbol, line, charPositionInLine + 1, ComponentName, ParsePass);
16+
}
17+
}
18+
}
Lines changed: 29 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,29 @@
1+
using System;
2+
using Antlr4.Runtime;
3+
using Rubberduck.Parsing.VBA;
4+
5+
namespace Rubberduck.Parsing.Symbols.ParsingExceptions
6+
{
7+
/// <summary>
8+
/// An exception that is thrown when the parser encounters a syntax error while parsing an entire module.
9+
/// This exception indicates either a bug in the grammar... or non-compilable VBA code.
10+
/// </summary>
11+
[Serializable]
12+
public class MainParseSyntaxErrorException : ParsePassSyntaxErrorException
13+
{
14+
public MainParseSyntaxErrorException(ParsePassSyntaxErrorInfo info)
15+
: this(info.Message, info.Exception, info.OffendingSymbol, info.LineNumber, info.Position, info.ComponentName, info.ParsePass) { }
16+
17+
public MainParseSyntaxErrorException(string message, RecognitionException innerException, IToken offendingSymbol, int line, int position, string componentName, ParsePass parsePass)
18+
: base(message, innerException, offendingSymbol, line, position, componentName, parsePass)
19+
{}
20+
21+
public override string ToString()
22+
{
23+
var exceptionText =
24+
$@"{base.ToString()}
25+
ParseType: Main parse";
26+
return exceptionText;
27+
}
28+
}
29+
}
Lines changed: 23 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,23 @@
1+
using Antlr4.Runtime;
2+
using Rubberduck.Parsing.VBA;
3+
4+
namespace Rubberduck.Parsing.Symbols.ParsingExceptions
5+
{
6+
public class ParsePassExceptionErrorListener : ExceptionErrorListener
7+
{
8+
protected readonly string ComponentName;
9+
protected readonly ParsePass ParsePass;
10+
11+
public ParsePassExceptionErrorListener(string componentName, ParsePass parsePass)
12+
{
13+
ComponentName = componentName;
14+
ParsePass = parsePass;
15+
}
16+
17+
public override void SyntaxError(IRecognizer recognizer, IToken offendingSymbol, int line, int charPositionInLine, string msg, RecognitionException e)
18+
{
19+
// adding 1 to line, because line is 0-based, but it's 1-based in the VBE
20+
throw new ParsePassSyntaxErrorException(msg, e, offendingSymbol, line, charPositionInLine + 1, ComponentName, ParsePass);
21+
}
22+
}
23+
}
Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,36 @@
1+
using System;
2+
using Antlr4.Runtime;
3+
using Rubberduck.Parsing.VBA;
4+
5+
namespace Rubberduck.Parsing.Symbols.ParsingExceptions
6+
{
7+
/// <summary>
8+
/// An exception that is thrown when the parser encounters a syntax error during one of two parses of an entire module.
9+
/// This exception indicates either a bug in the grammar... or non-compilable VBA code.
10+
/// </summary>
11+
[Serializable]
12+
public class ParsePassSyntaxErrorException : SyntaxErrorException
13+
{
14+
public ParsePassSyntaxErrorException(ParsePassSyntaxErrorInfo info)
15+
: this(info.Message, info.Exception, info.OffendingSymbol, info.LineNumber, info.Position, info.ComponentName, info.ParsePass) { }
16+
17+
public ParsePassSyntaxErrorException(string message, RecognitionException innerException, IToken offendingSymbol, int line, int position, string componentName, ParsePass parsePass)
18+
: base(message, innerException, offendingSymbol, line, position)
19+
{
20+
ComponentName = componentName;
21+
ParsePass = parsePass;
22+
}
23+
24+
public string ComponentName { get; }
25+
public ParsePass ParsePass { get; }
26+
27+
public override string ToString()
28+
{
29+
var parsePassText = ParsePass == ParsePass.CodePanePass ? "code pane" : "exported";
30+
var exceptionText =
31+
$@"{base.ToString()}
32+
Component: {ComponentName} ({parsePassText} version)";
33+
return exceptionText;
34+
}
35+
}
36+
}

0 commit comments

Comments
 (0)