diff --git a/cobc/ChangeLog b/cobc/ChangeLog index f80b3086d..71d6306fc 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -175,6 +175,10 @@ * typeck.c (validate_occurs): change level 01/77 check back to plain dialect verification fixing #854 +2022-10-04 Nicolas Berthier + + * pplex.l, parser.y: fix AREACHECK in DEFAULT SECTION of CONTROL DIVISON + 2022-10-04 Simon Sobisch * codegen.c (output_internal_function): only close files on CANCEL-callback diff --git a/cobc/parser.y b/cobc/parser.y index e82e8b558..b6986ca7c 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -3618,7 +3618,8 @@ _default_clauses: _default_accept_clause: /* empty */ -| ACCEPT _is word_or_terminal +| ACCEPT { check_non_area_a ($1); } + _is word_or_terminal { CB_PENDING ("ACCEPT statement in DEFAULT SECTION"); /* TODO: setup_default_accept ($3); */ @@ -3627,7 +3628,8 @@ _default_accept_clause: _default_display_clause: /* empty */ -| DISPLAY _is word_or_terminal +| DISPLAY { check_non_area_a ($1); } + _is word_or_terminal { CB_PENDING ("DISPLAY statement in DEFAULT SECTION"); /* TODO: setup_default_display ($3); */ diff --git a/cobc/pplex.l b/cobc/pplex.l index 70caa5ec8..cc6f72e70 100644 --- a/cobc/pplex.l +++ b/cobc/pplex.l @@ -492,16 +492,16 @@ MAYBE_AREA_A [ ]?#? return CONTROL_STATEMENT; } -^{AREA_A} { +<*>^{AREA_A} { /* Output a special marker that precedes lines starting in area A. This - is required to detect missing periods. + is required to detect some missing periods. See "(*area-a*)" in `ppinput' function below for the code that emits the `#'. - The optional space before '#' in the rule above is only needed to - properly handle the first line in each buffer, that for some reason - always starts with a space. + The optional space before '#' in the definition of AREA_A is only + needed to properly handle the first line in each buffer, that for + some reason always starts with a space. */ fprintf (ppout, "\n#area_a\n"); } @@ -555,7 +555,6 @@ SUBSTITUTION_SECTION_STATE>{ cb_source_line++; } [,;]?[ ]+ { /* ignore */ } - ^{AREA_A} {} } { cb_source_line++; } [,;]?[ ]+ { /* ignore */ } - ^{AREA_A} {} [_0-9A-Z\x80-\xFF-]+(\.[_0-9A-Z\x80-\xFF-]+)+ { /* special case to allow copybook names with periods without a literal @@ -1047,12 +1045,6 @@ ENDIF_DIRECTIVE_STATE>{ cb_source_line++; } - ^{AREA_A} { - /* Pseudo-text words that start in area-a retain that property, and - should thus be preceded with the marker. */ - pplval.s = cobc_plex_strdup ("\n#area_a\n"); - } - [,;]?[ ]+ { pplval.s = cobc_plex_strdup (" "); return TOKEN; diff --git a/tests/testsuite.src/syn_misc.at b/tests/testsuite.src/syn_misc.at index c2c08d35c..3779403a8 100644 --- a/tests/testsuite.src/syn_misc.at +++ b/tests/testsuite.src/syn_misc.at @@ -9290,6 +9290,42 @@ AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], []) AT_CLEANUP +AT_SETUP([CONTROL DIVISION & AREACHECK]) +AT_KEYWORDS([gcos]) + +AT_DATA([prog.cob], [ + CONTROL DIVISION. + SUBSTITUTION SECTION. + *> This REPLACE in Area A is ignored for now: + REPLACE IISS BY IS + TERM BY TERMINAL + "KO" BY "OK". + DEFAULT SECTION. + ACCEPT ALTERNATE CONSOLE + DISPLAY IISS TERM + . + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + DATA DIVISION. + WORKING-STORAGE SECTION. + 01 VAR PIC X(2) VALUE "KO". + PROCEDURE DIVISION. + DISPLAY VAR + STOP RUN. +]) + +AT_CHECK([$COMPILE -std=gcos-strict prog.cob], [0], [], +[prog.cob:9: warning: start of statement in Area A +prog.cob:9: warning: ACCEPT statement in DEFAULT SECTION is not implemented +prog.cob:10: warning: start of statement in Area A +prog.cob:10: warning: DISPLAY statement in DEFAULT SECTION is not implemented +prog.cob:18: warning: start of statement in Area A +prog.cob:19: warning: start of statement in Area A +]) + +AT_CLEANUP + + AT_SETUP([PICTURE L]) AT_KEYWORDS([extensions gcos picture-l])