diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 3ba30ed12..66d45ae27 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -438,6 +438,12 @@ * typeck.c (cb_emit_write): changed configuration check and warning for cb_sequential_advancing to dialect variant +2022-01-27 Nicolas Berthier + + * pplex.l, ppparse.y: add support for CONTROL DIVISION (GCOS 7 + extension); only SUBSTITUTION SECTION is handled yet + * config.def: new control-division option + 2022-01-25 Nicolas Berthier * pplex.l, ppparse.y, config.h: support COPY and REPLACE diff --git a/cobc/config.def b/cobc/config.def index e1091fe43..d24c5fa6e 100644 --- a/cobc/config.def +++ b/cobc/config.def @@ -194,6 +194,9 @@ CB_CONFIG_BOOLEAN (cb_device_mnemonics, "device-mnemonics", CB_CONFIG_SUPPORT (cb_comment_paragraphs, "comment-paragraphs", _("comment paragraphs in IDENTIFICATION DIVISION (AUTHOR, DATE-WRITTEN, ...)")) +CB_CONFIG_SUPPORT (cb_control_division, "control-division", + _("CONTROL DIVISION")) + CB_CONFIG_SUPPORT (cb_partial_replacing_with_literal, "partial-replacing-with-literal", _("partial replacing with literal")) diff --git a/cobc/pplex.l b/cobc/pplex.l index a3807216e..408c25f43 100644 --- a/cobc/pplex.l +++ b/cobc/pplex.l @@ -187,6 +187,8 @@ DEFNUM_LITERAL [+-]?[0-9]*[\.]*[0-9]+ %x COBOL_WORDS_DIRECTIVE_STATE %x COPY_STATE %x PSEUDO_STATE +%x CONTROL_DIVISION_STATE +%x SUBSTITUTION_SECTION_STATE %x SOURCE_DIRECTIVE_STATE %x DEFINE_DIRECTIVE_STATE %x ON_OFF_DIRECTIVE_STATE @@ -447,7 +449,47 @@ DEFNUM_LITERAL [+-]?[0-9]*[\.]*[0-9]+ return CONTROL_STATEMENT; } +"CONTROL"[ ,;\n]+"DIVISION" { + /* Syntax extension for GCOS: such a division may include a SUBSTITUTION + SECTION that records source text replacement statements, along with a + DEFAULT SECTION where compile-time implicits are defined. */ + /* cf `ppparse.y`, grammar entry `program_with_control_division`. */ + cb_verify (cb_control_division, "CONTROL DIVISION"); + yy_push_state (CONTROL_DIVISION_STATE); + return CONTROL_DIVISION; +} + +"SUBSTITUTION"[ ,;\n]+"SECTION" { + yy_push_state (SUBSTITUTION_SECTION_STATE); + return SUBSTITUTION_SECTION; +} + +"REPLACE" { + yy_push_state (COPY_STATE); + return REPLACE; +} + +{ + [,;]?\n { + ECHO; + check_listing (yytext, 0); + cb_source_line++; + } + [,;]?[ ]+ { /* ignore */ } + \. { + return DOT; + } +} + + ("ID"|"IDENTIFICATION")[ ,;\n]+"DIVISION" { + /* Pop any control division-related start condition state. */ + while (YY_START == CONTROL_DIVISION_STATE || + YY_START == SUBSTITUTION_SECTION_STATE) + yy_pop_state (); /* Allow comment sentences/paragraphs */ comment_allowed = 1; ppecho (yytext, 0, (int)yyleng); diff --git a/cobc/ppparse.y b/cobc/ppparse.y index 7c44fcec9..033df9144 100644 --- a/cobc/ppparse.y +++ b/cobc/ppparse.y @@ -620,6 +620,9 @@ ppparse_clear_vars (const struct cb_define_struct *p) %token LEAP_SECOND_DIRECTIVE +%token CONTROL_DIVISION "CONTROL DIVISION" +%token SUBSTITUTION_SECTION "SUBSTITUTION SECTION" + %token SOURCE_DIRECTIVE %token FORMAT %token IS @@ -739,13 +742,46 @@ ppparse_clear_vars (const struct cb_define_struct *p) %% +program_structure: + CONTROL_DIVISION DOT program_with_control_division +| statement_list +; + +/* GCOS 7 COBOL85 ref. manual p. 136: [...] If the replace-entry is present in +the Substitution Section of the Control Division of a source program, that +source program, including all contained programs, must contain no REPLACE +statement. Thankfully this helps avoiding some conflicts. */ +program_with_control_division: + statement_list +| control_division_no_replace statement_no_replace statement_list +| control_division_no_replace +| control_division_with_replace DOT statement_no_replace_list +; + +control_division_no_replace: + SUBSTITUTION_SECTION DOT +; + +control_division_with_replace: + /* The period could be optional. */ + SUBSTITUTION_SECTION DOT replace_statement +; + statement_list: | statement_list statement ; +statement_no_replace_list: +| statement_no_replace_list statement_no_replace +; + statement: - copy_statement DOT + statement_no_replace | replace_statement DOT +; + +statement_no_replace: + copy_statement DOT | directive TERMINATOR | listing_statement | CONTROL_STATEMENT control_options _dot TERMINATOR diff --git a/config/ChangeLog b/config/ChangeLog index 7c26a6ab9..fc5050674 100644 --- a/config/ChangeLog +++ b/config/ChangeLog @@ -49,6 +49,10 @@ * gcos-strict.conf, gcos.conf, gcos.words: added config files for GCOS 7 (Bull) dialect +2022-01-27 Nicolas Berthier + + * general: added option control-division + 2021-11-14 Ron Norman * mf.words: Add MF specific names B-EXOR, B-LEFT, B-RIGHT for bit diff --git a/config/acu-strict.conf b/config/acu-strict.conf index 8d53a3bb0..65ee947ff 100644 --- a/config/acu-strict.conf +++ b/config/acu-strict.conf @@ -199,6 +199,7 @@ dpc-in-data: xml # verify alter-statement: obsolete comment-paragraphs: obsolete # not verified yet partial-replacing-with-literal: ok +control-division: unconformable call-overflow: ok data-records-clause: obsolete # not verified yet debugging-mode: ok diff --git a/config/bs2000-strict.conf b/config/bs2000-strict.conf index 045d528ef..e5b4eb5ca 100644 --- a/config/bs2000-strict.conf +++ b/config/bs2000-strict.conf @@ -195,6 +195,7 @@ dpc-in-data: xml alter-statement: obsolete comment-paragraphs: unconformable +control-division: unconformable # not verified yet partial-replacing-with-literal: unconformable # not verified yet call-overflow: ok data-records-clause: obsolete diff --git a/config/cobol2002.conf b/config/cobol2002.conf index 259541e9a..06686d141 100644 --- a/config/cobol2002.conf +++ b/config/cobol2002.conf @@ -194,6 +194,7 @@ dpc-in-data: xml alter-statement: unconformable comment-paragraphs: unconformable +control-division: unconformable partial-replacing-with-literal: unconformable call-overflow: archaic data-records-clause: unconformable diff --git a/config/cobol2014.conf b/config/cobol2014.conf index 5c192ed37..9a3051600 100644 --- a/config/cobol2014.conf +++ b/config/cobol2014.conf @@ -194,6 +194,7 @@ dpc-in-data: xml alter-statement: unconformable comment-paragraphs: unconformable +control-division: unconformable partial-replacing-with-literal: unconformable call-overflow: archaic data-records-clause: unconformable diff --git a/config/cobol85.conf b/config/cobol85.conf index 25a8c5bfc..4780c80c1 100644 --- a/config/cobol85.conf +++ b/config/cobol85.conf @@ -194,6 +194,7 @@ dpc-in-data: xml alter-statement: obsolete comment-paragraphs: obsolete +control-division: unconformable partial-replacing-with-literal: unconformable call-overflow: ok data-records-clause: obsolete diff --git a/config/default.conf b/config/default.conf index 94875679b..ce863dbbc 100644 --- a/config/default.conf +++ b/config/default.conf @@ -214,6 +214,7 @@ dpc-in-data: xml alter-statement: obsolete comment-paragraphs: obsolete +control-division: unconformable partial-replacing-with-literal: obsolete call-overflow: archaic data-records-clause: obsolete diff --git a/config/gcos-strict.conf b/config/gcos-strict.conf index b34fb9c2f..3eb687574 100644 --- a/config/gcos-strict.conf +++ b/config/gcos-strict.conf @@ -196,6 +196,7 @@ dpc-in-data: xml alter-statement: obsolete comment-paragraphs: obsolete +control-division: ok partial-replacing-with-literal: ok call-overflow: archaic data-records-clause: obsolete diff --git a/config/ibm-strict.conf b/config/ibm-strict.conf index 42aa87ab3..f8d16f708 100644 --- a/config/ibm-strict.conf +++ b/config/ibm-strict.conf @@ -193,6 +193,7 @@ dpc-in-data: xml alter-statement: obsolete comment-paragraphs: obsolete +control-division: unconformable partial-replacing-with-literal: unconformable call-overflow: ok data-records-clause: obsolete diff --git a/config/lax.conf-inc b/config/lax.conf-inc index 1c34a1c9e..96039f63c 100644 --- a/config/lax.conf-inc +++ b/config/lax.conf-inc @@ -65,6 +65,7 @@ screen-section-rules: gc alter-statement: +obsolete comment-paragraphs: ok +control-division: +obsolete call-overflow: ok data-records-clause: +obsolete debugging-mode: ok diff --git a/config/mf-strict.conf b/config/mf-strict.conf index f962d8cc8..00e1172ba 100644 --- a/config/mf-strict.conf +++ b/config/mf-strict.conf @@ -196,6 +196,7 @@ dpc-in-data: xml alter-statement: obsolete comment-paragraphs: obsolete +control-division: unconformable partial-replacing-with-literal: unconformable call-overflow: ok data-records-clause: obsolete diff --git a/config/mvs-strict.conf b/config/mvs-strict.conf index fe3dbee7f..360bea670 100644 --- a/config/mvs-strict.conf +++ b/config/mvs-strict.conf @@ -194,6 +194,7 @@ dpc-in-data: xml alter-statement: obsolete comment-paragraphs: obsolete partial-replacing-with-literal: unconformable +control-division: unconformable call-overflow: ok # not verified yet data-records-clause: obsolete debugging-mode: ok diff --git a/config/realia-strict.conf b/config/realia-strict.conf index 139551441..e7bb3b102 100644 --- a/config/realia-strict.conf +++ b/config/realia-strict.conf @@ -198,6 +198,7 @@ dpc-in-data: xml alter-statement: obsolete comment-paragraphs: ok +control-division: unconformable # not verified yet partial-replacing-with-literal: unconformable # not verified yet call-overflow: ok data-records-clause: ignore diff --git a/config/rm-strict.conf b/config/rm-strict.conf index 653bd40e8..1d7c77ad3 100644 --- a/config/rm-strict.conf +++ b/config/rm-strict.conf @@ -199,6 +199,7 @@ dpc-in-data: xml alter-statement: obsolete comment-paragraphs: obsolete +control-division: unconformable # not verified yet partial-replacing-with-literal: unconformable # not verified yet call-overflow: ok data-records-clause: obsolete diff --git a/config/xopen.conf b/config/xopen.conf index 2c1af5a44..e594e5cc1 100644 --- a/config/xopen.conf +++ b/config/xopen.conf @@ -204,6 +204,7 @@ dpc-in-data: xml alter-statement: warning # should not be used ... comment-paragraphs: warning # should not be used ... partial-replacing-with-literal: unconformable +control-division: unconformable call-overflow: ok data-records-clause: warning # should not be used ... debugging-mode: ok diff --git a/tests/testsuite.src/configuration.at b/tests/testsuite.src/configuration.at index c76c21b75..1bfae3c6f 100644 --- a/tests/testsuite.src/configuration.at +++ b/tests/testsuite.src/configuration.at @@ -409,7 +409,7 @@ name: "Empty Conf" ]) # check if incomplete configuration result in error -AT_CHECK([$COMPILE_ONLY -conf=test.conf prog.cob], [1], [], +AT_CHECK([$COMPILE_ONLY -conf=test.conf prog.cob], [97], [], [configuration error: test.conf: missing definitions: no definition of 'reserved-words' @@ -459,6 +459,7 @@ test.conf: missing definitions: no definition of 'implicit-assign-dynamic-var' no definition of 'device-mnemonics' no definition of 'comment-paragraphs' + no definition of 'control-division' no definition of 'partial-replacing-with-literal' no definition of 'memory-size-clause' no definition of 'multiple-file-tape-clause' @@ -539,6 +540,9 @@ test.conf: missing definitions: no definition of 'vsam-status' no definition of 'self-call-recursive' no definition of 'record-contains-depending-clause' +cobc: too many errors + +cobc: aborting ]) AT_CLEANUP diff --git a/tests/testsuite.src/syn_misc.at b/tests/testsuite.src/syn_misc.at index 5712541bb..d84c17b2b 100644 --- a/tests/testsuite.src/syn_misc.at +++ b/tests/testsuite.src/syn_misc.at @@ -8689,3 +8689,37 @@ AT_CLEANUP # TODO: add missing tests for syntax errors in >>IF/ELSE/END + +AT_SETUP([CONTROL DIVISION]) +AT_KEYWORDS([control gcos]) + +AT_DATA([empty.cob], [ + CONTROL DIVISION. + IDENTIFICATION DIVISION. + PROGRAM-ID. empty. +]) + +AT_CHECK([$COMPILE_ONLY -fcontrol-division=ok empty.cob], [0], [], []) + +AT_DATA([replace.cob], [ + CONTROL DIVISION. + SUBSTITUTION SECTION. + REPLACE ==TEST-VAR== BY ==VAR==. + IDENTIFICATION DIVISION. + PROGRAM-ID. replace. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 TEST-VAR PIC X(2) VALUE "OK". + PROCEDURE DIVISION. + DISPLAY VAR NO ADVANCING + END-DISPLAY. + STOP RUN. +]) + +AT_CHECK([$COMPILE -fcontrol-division=ok replace.cob], [0], [], []) +AT_CHECK([$COBCRUN_DIRECT ./replace], [0], [OK], []) +AT_CHECK([$COMPILE replace.cob], [1], [], +[replace.cob:2: error: CONTROL DIVISION does not conform to GnuCOBOL +]) + +AT_CLEANUP