Support MF-style conditional compiler directives ($IF, etc)

OCamlPro · Apr 8, 2024 · c239bb0 · c239bb0
1 parent 015b50d
commit c239bb0
Show file tree

Hide file tree

Showing 7 changed files with 12 additions and 213 deletions.
diff --git 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; <Preproc>
   | CDIR_ELIF; ~ = elif_directive; <Preproc>
   | 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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