From c239bb00d0b408c8c700c2842b2e9f323b731b61 Mon Sep 17 00:00:00 2001 From: Nicolas Berthier Date: Mon, 8 Apr 2024 16:11:37 +0200 Subject: [PATCH] Support MF-style conditional compiler directives (`$IF`, etc) --- src/lsp/cobol_preproc/compdir_grammar.mly | 10 +- src/lsp/cobol_preproc/compdir_tree.ml | 2 + src/lsp/cobol_preproc/preproc_engine.ml | 1 + src/lsp/cobol_preproc/src_lexer.mll | 3 + test/output-tests/listings.expected | 39 ------ test/output-tests/run_refmod.expected | 20 --- test/output-tests/syn_misc.expected | 150 ---------------------- 7 files changed, 12 insertions(+), 213 deletions(-) diff --git a/src/lsp/cobol_preproc/compdir_grammar.mly b/src/lsp/cobol_preproc/compdir_grammar.mly index a5a15d694..18562eaea 100644 --- a/src/lsp/cobol_preproc/compdir_grammar.mly +++ b/src/lsp/cobol_preproc/compdir_grammar.mly @@ -30,10 +30,11 @@ %token NE "<>" [@keyword (* symbol *) "<>"] %token CDIR_DEFINE [@keyword ">>DEFINE", "$DEFINE"] -%token CDIR_ELIF [@keyword ">>ELIF", ">>ELSE-IF"] -%token CDIR_ELSE [@keyword ">>ELSE"] -%token CDIR_END_IF [@keyword ">>END-IF"] -%token CDIR_IF [@keyword ">>IF"] +%token CDIR_ELIF [@keyword ">>ELIF", "$ELIF", ">>ELSE-IF", "$ELSE-IF"] +%token CDIR_ELSE [@keyword ">>ELSE", "$ELSE"] +%token CDIR_END [@keyword "$END"] (* Note: no `>>END` equivalent *) +%token CDIR_END_IF [@keyword ">>END-IF", "$END-IF"] +%token CDIR_IF [@keyword ">>IF", "$IF"] %token CDIR_SET [@keyword ">>SET", "$SET"] %token CDIR_SOURCE [@keyword ">>SOURCE", "$SOURCE"] @@ -109,6 +110,7 @@ let compiler_directive := | CDIR_IF; ~ = if_directive; | CDIR_ELIF; ~ = elif_directive; | CDIR_ELSE; EOL; { Preproc Else } + | CDIR_END; EOL; { Preproc End } | CDIR_END_IF; EOL; { Preproc End_if } (* --- >>SOURCE | $ SET SOURCEFORMAT ---------------------------------------- *) diff --git a/src/lsp/cobol_preproc/compdir_tree.ml b/src/lsp/cobol_preproc/compdir_tree.ml index b96aeeb99..eb53e36fd 100644 --- a/src/lsp/cobol_preproc/compdir_tree.ml +++ b/src/lsp/cobol_preproc/compdir_tree.ml @@ -18,6 +18,7 @@ type directive_kind = | Define_directive | Elif_directive | Else_directive + | End_directive | EndIf_directive | If_directive | Set_directive @@ -39,6 +40,7 @@ and preproc_directive = | If of boolexpr with_loc | Elif of boolexpr with_loc | Else + | End | End_if and definition = diff --git a/src/lsp/cobol_preproc/preproc_engine.ml b/src/lsp/cobol_preproc/preproc_engine.ml index b206f40bf..0d15f9d91 100644 --- a/src/lsp/cobol_preproc/preproc_engine.ml +++ b/src/lsp/cobol_preproc/preproc_engine.ml @@ -251,6 +251,7 @@ and apply_preproc_directive ({ env; context; _ } as lp) new_context lp @@ Preproc_logic.on_elif ~loc ~condition ~env context | Else -> new_context lp @@ Preproc_logic.on_else ~loc context + | End | End_if -> let lp = new_context lp @@ Preproc_logic.on_endif ~loc context in if Preproc_logic.emitting lp.context && lp.rev_ignored <> [] diff --git a/src/lsp/cobol_preproc/src_lexer.mll b/src/lsp/cobol_preproc/src_lexer.mll index f25c1fe1e..21b1a4b94 100644 --- a/src/lsp/cobol_preproc/src_lexer.mll +++ b/src/lsp/cobol_preproc/src_lexer.mll @@ -50,6 +50,7 @@ | CDIR_DEFINE -> Define_directive | CDIR_ELIF -> Elif_directive | CDIR_ELSE -> Else_directive + | CDIR_END -> End_directive | CDIR_END_IF -> EndIf_directive | CDIR_IF -> If_directive | CDIR_SET -> Set_directive @@ -138,6 +139,7 @@ let else_endif_keywords = cdtokens_subset [ CDIR_ELSE; + CDIR_END; CDIR_END_IF; ] @@ -146,6 +148,7 @@ | If_directive | Elif_directive -> conditional_keywords | Else_directive + | End_directive | EndIf_directive -> else_endif_keywords | Set_directive -> set_keywords | Source_directive -> source_keywords diff --git a/test/output-tests/listings.expected b/test/output-tests/listings.expected index 18260da47..5bd5fa995 100644 --- a/test/output-tests/listings.expected +++ b/test/output-tests/listings.expected @@ -2984,45 +2984,6 @@ listings.at-2762-prog.cob:34.32-34.41: Considering: import/gnucobol/tests/testsuite.src/listings.at:2848:0 Considering: import/gnucobol/tests/testsuite.src/listings.at:2876:0 -listings.at-2876-prog2.cob:7.6-7.26: - 4 DATA DIVISION. - 5 WORKING-STORAGE SECTION. - 6 PROCEDURE DIVISION. - 7 > $IF ACTIVATE DEFINED ----- ^^^^^^^^^^^^^^^^^^^^ - 8 DISPLAY "NOTOK" NO ADVANCING - 9 END-DISPLAY ->> Error: Invalid $IF compiler directive - -listings.at-2876-prog2.cob:10.6-10.29: - 7 $IF ACTIVATE DEFINED - 8 DISPLAY "NOTOK" NO ADVANCING - 9 END-DISPLAY - 10 > $ELIF ACTIVATE2 DEFINED ----- ^^^^^^^^^^^^^^^^^^^^^^^ - 11 DISPLAY "OK" NO ADVANCING - 12 END-DISPLAY ->> Error: Invalid $ELIF compiler directive - -listings.at-2876-prog2.cob:13.6-13.11: - 10 $ELIF ACTIVATE2 DEFINED - 11 DISPLAY "OK" NO ADVANCING - 12 END-DISPLAY - 13 > $ELSE ----- ^^^^^ - 14 DISPLAY "NOTOK" NO ADVANCING - 15 END-DISPLAY ->> Error: Invalid $ELSE compiler directive - -listings.at-2876-prog2.cob:16.6-16.10: - 13 $ELSE - 14 DISPLAY "NOTOK" NO ADVANCING - 15 END-DISPLAY - 16 > $END ----- ^^^^ - 17 STOP RUN. ->> Error: Invalid $END compiler directive - Considering: import/gnucobol/tests/testsuite.src/listings.at:3684:0 listings.at-3684-expected.lst:1.6-1.7: 1 > GnuCOBOL V.R.P prog.cob diff --git a/test/output-tests/run_refmod.expected b/test/output-tests/run_refmod.expected index 39614339e..3de82ae64 100644 --- a/test/output-tests/run_refmod.expected +++ b/test/output-tests/run_refmod.expected @@ -58,26 +58,6 @@ run_refmod.at-466-prog2.cob:2.6-2.21: 4 PROGRAM-ID. prog2. >> Error: Malformed compiler directive -run_refmod.at-466-prog2.cob:15.6-15.39: - 12 01 m PIC 9 VALUE 2. - 13 - 14 PROCEDURE DIVISION. - 15 > $IF TEST-ZERO-LEN-REF-MOD DEFINED ----- ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ - 16 DISPLAY y (1:n) - 17 $END ->> Error: Invalid $IF compiler directive - -run_refmod.at-466-prog2.cob:17.6-17.10: - 14 PROCEDURE DIVISION. - 15 $IF TEST-ZERO-LEN-REF-MOD DEFINED - 16 DISPLAY y (1:n) - 17 > $END ----- ^^^^ - 18 DISPLAY y (1:m) - 19 GOBACK. ->> Error: Invalid $END compiler directive - Considering: import/gnucobol/tests/testsuite.src/run_refmod.at:490:0 run_refmod.at-490-prog3.cob:2.6-2.21: 1 diff --git a/test/output-tests/syn_misc.expected b/test/output-tests/syn_misc.expected index 2d05951fc..ef6b0a643 100644 --- a/test/output-tests/syn_misc.expected +++ b/test/output-tests/syn_misc.expected @@ -2434,16 +2434,6 @@ syn_misc.at-7027-prog.cob:17.7-17.22: Considering: import/gnucobol/tests/testsuite.src/syn_misc.at:7051:0 Considering: import/gnucobol/tests/testsuite.src/syn_misc.at:7109:0 -syn_misc.at-7109-prog.cob:8.6-8.19: - 5 WORKING-STORAGE SECTION. - 6 78 Y VALUE 'a'. - 7 PROCEDURE DIVISION. - 8 > $IF X DEFINED ----- ^^^^^^^^^^^^^ - 9 $DISPLAY X defined - 10 $ELIF Y DEFINED ->> Error: Invalid $IF compiler directive - syn_misc.at-7109-prog.cob:9.6-9.24: 6 78 Y VALUE 'a'. 7 PROCEDURE DIVISION. @@ -2454,16 +2444,6 @@ syn_misc.at-7109-prog.cob:9.6-9.24: 11 $DISPLAY X not defined, but Y via lvl 78 >> Error: Invalid $DISPLAY compiler directive -syn_misc.at-7109-prog.cob:10.6-10.21: - 7 PROCEDURE DIVISION. - 8 $IF X DEFINED - 9 $DISPLAY X defined - 10 > $ELIF Y DEFINED ----- ^^^^^^^^^^^^^^^ - 11 $DISPLAY X not defined, but Y via lvl 78 - 12 $ELSE ->> Error: Invalid $ELIF compiler directive - syn_misc.at-7109-prog.cob:11.6-11.46: 8 $IF X DEFINED 9 $DISPLAY X defined @@ -2474,16 +2454,6 @@ syn_misc.at-7109-prog.cob:11.6-11.46: 13 $DISPLAY X not defined >> Error: Invalid $DISPLAY compiler directive -syn_misc.at-7109-prog.cob:12.6-12.11: - 9 $DISPLAY X defined - 10 $ELIF Y DEFINED - 11 $DISPLAY X not defined, but Y via lvl 78 - 12 > $ELSE ----- ^^^^^ - 13 $DISPLAY X not defined - 14 $END ->> Error: Invalid $ELSE compiler directive - syn_misc.at-7109-prog.cob:13.6-13.28: 10 $ELIF Y DEFINED 11 $DISPLAY X not defined, but Y via lvl 78 @@ -2494,27 +2464,7 @@ syn_misc.at-7109-prog.cob:13.6-13.28: 15 CONTINUE >> Error: Invalid $DISPLAY compiler directive -syn_misc.at-7109-prog.cob:14.6-14.10: - 11 $DISPLAY X not defined, but Y via lvl 78 - 12 $ELSE - 13 $DISPLAY X not defined - 14 > $END ----- ^^^^ - 15 CONTINUE - 16 . ->> Error: Invalid $END compiler directive - Considering: import/gnucobol/tests/testsuite.src/syn_misc.at:7160:0 -syn_misc.at-7160-prog.cob:11.6-11.17: - 8 78 X VALUE 2. - 9 78 Z VALUE 354. - 10 PROCEDURE DIVISION. - 11 > $IF Y = Y2X ----- ^^^^^^^^^^^ - 12 $DISPLAY correct Y = Y2 - 13 $ELSE ->> Error: Invalid $IF compiler directive - syn_misc.at-7160-prog.cob:12.6-12.29: 9 78 Z VALUE 354. 10 PROCEDURE DIVISION. @@ -2525,16 +2475,6 @@ syn_misc.at-7160-prog.cob:12.6-12.29: 14 $DISPLAY bad: Y should be = Y2 >> Error: Invalid $DISPLAY compiler directive -syn_misc.at-7160-prog.cob:13.6-13.11: - 10 PROCEDURE DIVISION. - 11 $IF Y = Y2X - 12 $DISPLAY correct Y = Y2 - 13 > $ELSE ----- ^^^^^ - 14 $DISPLAY bad: Y should be = Y2 - 15 $END ->> Error: Invalid $ELSE compiler directive - syn_misc.at-7160-prog.cob:14.6-14.36: 11 $IF Y = Y2X 12 $DISPLAY correct Y = Y2 @@ -2545,26 +2485,6 @@ syn_misc.at-7160-prog.cob:14.6-14.36: 16 $IF Y > X >> Error: Invalid $DISPLAY compiler directive -syn_misc.at-7160-prog.cob:15.6-15.10: - 12 $DISPLAY correct Y = Y2 - 13 $ELSE - 14 $DISPLAY bad: Y should be = Y2 - 15 > $END ----- ^^^^ - 16 $IF Y > X - 17 $DISPLAY BAD - Y is not > X ->> Error: Invalid $END compiler directive - -syn_misc.at-7160-prog.cob:16.6-16.15: - 13 $ELSE - 14 $DISPLAY bad: Y should be = Y2 - 15 $END - 16 > $IF Y > X ----- ^^^^^^^^^ - 17 $DISPLAY BAD - Y is not > X - 18 $ELIF Y < X ->> Error: Invalid $IF compiler directive - syn_misc.at-7160-prog.cob:17.6-17.33: 14 $DISPLAY bad: Y should be = Y2 15 $END @@ -2575,16 +2495,6 @@ syn_misc.at-7160-prog.cob:17.6-17.33: 19 $DISPLAY correct Y < X >> Error: Invalid $DISPLAY compiler directive -syn_misc.at-7160-prog.cob:18.6-18.17: - 15 $END - 16 $IF Y > X - 17 $DISPLAY BAD - Y is not > X - 18 > $ELIF Y < X ----- ^^^^^^^^^^^ - 19 $DISPLAY correct Y < X - 20 $ELSE ->> Error: Invalid $ELIF compiler directive - syn_misc.at-7160-prog.cob:19.6-19.28: 16 $IF Y > X 17 $DISPLAY BAD - Y is not > X @@ -2595,16 +2505,6 @@ syn_misc.at-7160-prog.cob:19.6-19.28: 21 $DISPLAY BROKEN >> Error: Invalid $DISPLAY compiler directive -syn_misc.at-7160-prog.cob:20.6-20.11: - 17 $DISPLAY BAD - Y is not > X - 18 $ELIF Y < X - 19 $DISPLAY correct Y < X - 20 > $ELSE ----- ^^^^^ - 21 $DISPLAY BROKEN - 22 $END ->> Error: Invalid $ELSE compiler directive - syn_misc.at-7160-prog.cob:21.6-21.21: 18 $ELIF Y < X 19 $DISPLAY correct Y < X @@ -2615,26 +2515,6 @@ syn_misc.at-7160-prog.cob:21.6-21.21: 23 >> Error: Invalid $DISPLAY compiler directive -syn_misc.at-7160-prog.cob:22.6-22.10: - 19 $DISPLAY correct Y < X - 20 $ELSE - 21 $DISPLAY BROKEN - 22 > $END ----- ^^^^ - 23 - 24 $IF X > Y ->> Error: Invalid $END compiler directive - -syn_misc.at-7160-prog.cob:24.6-24.15: - 21 $DISPLAY BROKEN - 22 $END - 23 - 24 > $IF X > Y ----- ^^^^^^^^^ - 25 $DISPLAY correct X > Y - 26 $ELIF X < Y ->> Error: Invalid $IF compiler directive - syn_misc.at-7160-prog.cob:25.6-25.28: 22 $END 23 @@ -2645,16 +2525,6 @@ syn_misc.at-7160-prog.cob:25.6-25.28: 27 $DISPLAY BAD - X is not < Y >> Error: Invalid $DISPLAY compiler directive -syn_misc.at-7160-prog.cob:26.6-26.17: - 23 - 24 $IF X > Y - 25 $DISPLAY correct X > Y - 26 > $ELIF X < Y ----- ^^^^^^^^^^^ - 27 $DISPLAY BAD - X is not < Y - 28 $ELSE ->> Error: Invalid $ELIF compiler directive - syn_misc.at-7160-prog.cob:27.6-27.33: 24 $IF X > Y 25 $DISPLAY correct X > Y @@ -2665,16 +2535,6 @@ syn_misc.at-7160-prog.cob:27.6-27.33: 29 $DISPLAY BROKEN >> Error: Invalid $DISPLAY compiler directive -syn_misc.at-7160-prog.cob:28.6-28.11: - 25 $DISPLAY correct X > Y - 26 $ELIF X < Y - 27 $DISPLAY BAD - X is not < Y - 28 > $ELSE ----- ^^^^^ - 29 $DISPLAY BROKEN - 30 $END ->> Error: Invalid $ELSE compiler directive - syn_misc.at-7160-prog.cob:29.6-29.21: 26 $ELIF X < Y 27 $DISPLAY BAD - X is not < Y @@ -2685,16 +2545,6 @@ syn_misc.at-7160-prog.cob:29.6-29.21: 31 CONTINUE >> Error: Invalid $DISPLAY compiler directive -syn_misc.at-7160-prog.cob:30.6-30.10: - 27 $DISPLAY BAD - X is not < Y - 28 $ELSE - 29 $DISPLAY BROKEN - 30 > $END ----- ^^^^ - 31 CONTINUE - 32 . ->> Error: Invalid $END compiler directive - Considering: import/gnucobol/tests/testsuite.src/syn_misc.at:7193:0 Considering: import/gnucobol/tests/testsuite.src/syn_misc.at:7264:0 Considering: import/gnucobol/tests/testsuite.src/syn_misc.at:7417:0