Skip to content

Commit c3932ae

Browse files
committed
Merge pull request #1147 from autoboosh/fixeos
fix grammar line continuation issues + add first vbparser tests to prevent regressions
2 parents e680e79 + 9934908 commit c3932ae

File tree

4 files changed

+3506
-3649
lines changed

4 files changed

+3506
-3649
lines changed

Rubberduck.Parsing/Grammar/VBA.g4

Lines changed: 19 additions & 96 deletions
Original file line numberDiff line numberDiff line change
@@ -15,84 +15,7 @@
1515
* along with this program. If not, see <http://www.gnu.org/licenses/>.
1616
*/
1717

18-
/*
19-
* Visual Basic 6.0 Grammar for ANTLR4
20-
*
21-
* This is an approximate grammar for Visual Basic 6.0, derived
22-
* from the Visual Basic 6.0 language reference
23-
* http://msdn.microsoft.com/en-us/library/aa338033%28v=vs.60%29.aspx
24-
* and tested against MSDN VB6 statement examples as well as several Visual
25-
* Basic 6.0 code repositories.
26-
*
27-
* Characteristics:
28-
*
29-
* 1. This grammar is line-based and takes into account whitespace, so that
30-
* member calls (e.g. "A.B") are distinguished from contextual object calls
31-
* in WITH statements (e.g. "A .B").
32-
*
33-
* 2. Keywords can be used as identifiers depending on the context, enabling
34-
* e.g. "A.Type", but not "Type.B".
35-
*
36-
*
37-
* Known limitations:
38-
*
39-
* 1. Preprocessor statements (#if, #else, ...) must not interfere with regular
40-
* statements.
41-
*
42-
* Change log:
43-
*
44-
* v1.4 Rubberduck
45-
* - renamed to VBA; goal is to support VBA, and a shorter name is more practical.
46-
* - added moduleDeclarations rule, moved moduleOptions there; options can now be
47-
* located anywhere in declarations section, without breaking the parser.
48-
* - added support for Option Compare Database.
49-
* - added support for VBA 7.0 PtrSafe attribute for Declare statements.
50-
* - implemented a fileNumber rule to locate identifier usages in file numbers.
51-
* - added support for anonymous declarations in With blocks (With New Something)
52-
* - blockStmt rules being sorted alphabetically was wrong. moved implicit call statement last.
53-
* - '!' in dictionary call statement rule gets picked up as a type hint; changed member call
54-
* to accept '!' as well as '.', but this complicates resolving the '!' shorthand syntax.
55-
* - added a subscripts rule in procedure calls, to avoid breaking the parser with
56-
* a function call that returns an array that is immediately accessed.
57-
* - added missing macroConstStmt (#CONST) rule.
58-
* - amended selectCaseStmt rules to support all valid syntaxes.
59-
* - blockStmt is now illegal in declarations section.
60-
* - added ON_LOCAL_ERROR token, to support legacy ON LOCAL ERROR statements.
61-
* - added additional typeHint? token to declareStmt, to support "Declare Function Foo$".
62-
* - modified WS lexer rule to correctly account for line continuations;
63-
* - modified multi-word lexer rules to use WS lexer token instead of ' '; this makes
64-
* the grammar support "Option _\n Explicit" and other keywords being specified on multiple lines.
65-
* - modified moduleOption rules to account for WS token in corresponding lexer rules.
66-
* - modified NEWLINE lexer rule to properly support instructions separator (':').
67-
* - tightened DATELITERAL lexer rule to the format enforced by the VBE, because "#fn: Close #"
68-
* in "Dim fn: fn = FreeFile: Open "filename" For Output As #fn: Close #fn" was picked up as a date literal.
69-
* - redefined IDENTIFIER lexer rule to support non-Latin characters (e.g. Japanese)
70-
* - made seekStmt, lockStmt, unlockStmt, getStmt and widthStmt accept a fileNumber (needed to support '#')
71-
* - fixed precompiler directives, which can now be nested. they still can't interfere with other blocks though.
72-
* - optional parameters can be a valueStmt.
73-
* - added support for Octal and Currency literals.
74-
* - implemented proper specs for DATELITERAL.
75-
* - added comments to parse tree (removes known limitation #2).
76-
* - macroConstStmt now allowed in blockStmt.
77-
* - allow type hints for parameters.
78-
* - fix operator precedence (in valueStmt)
79-
* - remove PLUS_EQ and MINUS_EQ since that's not supported in VBA
80-
* - remove PLUS valueStmt since that is not needed
81-
*
82-
*======================================================================================
83-
*
84-
* v1.3
85-
* - call statement precedence
86-
*
87-
* v1.2
88-
* - refined call statements
89-
*
90-
* v1.1
91-
* - precedence of operators and of ELSE in select statements
92-
* - optimized member calls
93-
*
94-
* v1.0 Initial revision
95-
*/
18+
/* VBA grammar based on Microsoft's [MS-VBAL]: VBA Language Specification. */
9619

9720
grammar VBA;
9821

@@ -102,30 +25,30 @@ startRule : module EOF;
10225

10326
module :
10427
WS?
105-
endOfLine*
106-
(moduleHeader endOfLine*)?
107-
moduleConfig? endOfLine*
108-
moduleAttributes? endOfLine*
109-
moduleDeclarations? endOfLine*
110-
moduleBody? endOfLine*
28+
endOfStatement
29+
(moduleHeader endOfStatement)?
30+
moduleConfig? endOfStatement
31+
moduleAttributes? endOfStatement
32+
moduleDeclarations? endOfStatement
33+
moduleBody? endOfStatement
11134
WS?
11235
;
11336

11437
moduleHeader : VERSION WS DOUBLELITERAL WS CLASS;
11538

11639
moduleConfig :
117-
BEGIN endOfLine*
40+
BEGIN endOfStatement
11841
moduleConfigElement+
11942
END
12043
;
12144

12245
moduleConfigElement :
123-
ambiguousIdentifier WS? EQ WS? literal endOfLine*
46+
ambiguousIdentifier WS? EQ WS? literal endOfStatement
12447
;
12548

126-
moduleAttributes : (attributeStmt endOfLine+)+;
49+
moduleAttributes : (attributeStmt endOfStatement)+;
12750

128-
moduleDeclarations : moduleDeclarationsElement (endOfLine+ moduleDeclarationsElement)* endOfLine*;
51+
moduleDeclarations : moduleDeclarationsElement (endOfStatement moduleDeclarationsElement)* endOfStatement;
12952

13053
moduleOption :
13154
OPTION_BASE WS SHORTLITERAL # optionBaseStmt
@@ -152,7 +75,7 @@ macroStmt :
15275
| macroIfThenElseStmt;
15376

15477
moduleBody :
155-
moduleBodyElement (endOfLine+ moduleBodyElement)* endOfLine*;
78+
moduleBodyElement (endOfStatement moduleBodyElement)* endOfStatement;
15679

15780
moduleBodyElement :
15881
functionStmt
@@ -588,7 +511,7 @@ implicitCallStmt_InBlock :
588511
| iCS_B_ProcedureCall
589512
;
590513

591-
iCS_B_MemberProcedureCall : implicitCallStmt_InStmt? '.' ambiguousIdentifier typeHint? (WS argsCall)? dictionaryCallStmt? (WS? LPAREN subscripts RPAREN)*;
514+
iCS_B_MemberProcedureCall : implicitCallStmt_InStmt? '.' ambiguousIdentifier typeHint? (WS argsCall)? (WS? dictionaryCallStmt)? (WS? LPAREN subscripts RPAREN)*;
592515

593516
// parantheses are forbidden in case of args
594517
// variables cannot be called in blocks
@@ -604,15 +527,15 @@ implicitCallStmt_InStmt :
604527
| iCS_S_DictionaryCall
605528
;
606529

607-
iCS_S_VariableOrProcedureCall : ambiguousIdentifier typeHint? dictionaryCallStmt? (WS? LPAREN subscripts RPAREN)*;
530+
iCS_S_VariableOrProcedureCall : ambiguousIdentifier typeHint? (WS? dictionaryCallStmt)? (WS? LPAREN subscripts RPAREN)*;
608531

609-
iCS_S_ProcedureOrArrayCall : (ambiguousIdentifier | baseType) typeHint? WS? LPAREN WS? (argsCall WS?)? RPAREN dictionaryCallStmt? (WS? LPAREN subscripts RPAREN)*;
532+
iCS_S_ProcedureOrArrayCall : (ambiguousIdentifier | baseType) typeHint? WS? LPAREN WS? (argsCall WS?)? RPAREN (WS? dictionaryCallStmt)? (WS? LPAREN subscripts RPAREN)*;
610533

611-
iCS_S_MembersCall : (iCS_S_VariableOrProcedureCall | iCS_S_ProcedureOrArrayCall)? iCS_S_MemberCall+ dictionaryCallStmt? (WS? LPAREN subscripts RPAREN)*;
534+
iCS_S_MembersCall : (iCS_S_VariableOrProcedureCall | iCS_S_ProcedureOrArrayCall)? (iCS_S_MemberCall WS?)+ (WS? dictionaryCallStmt)? (WS? LPAREN subscripts RPAREN)*;
612535

613-
iCS_S_MemberCall : ('.' | '!') (iCS_S_VariableOrProcedureCall | iCS_S_ProcedureOrArrayCall);
536+
iCS_S_MemberCall : ('.' | '!') WS? (iCS_S_VariableOrProcedureCall | iCS_S_ProcedureOrArrayCall);
614537

615-
iCS_S_DictionaryCall : dictionaryCallStmt;
538+
iCS_S_DictionaryCall : WS? dictionaryCallStmt;
616539

617540

618541
// atomic call statements ----------------------------------
@@ -621,7 +544,7 @@ argsCall : (argCall? WS? (',' | ';') WS?)* argCall (WS? (',' | ';') WS? argCall?
621544

622545
argCall : LPAREN? ((BYVAL | BYREF | PARAMARRAY) WS)? RPAREN? valueStmt;
623546

624-
dictionaryCallStmt : '!' ambiguousIdentifier typeHint?;
547+
dictionaryCallStmt : '!' WS? ambiguousIdentifier typeHint?;
625548

626549

627550
// atomic rules for statements

0 commit comments

Comments
 (0)