Skip to content

Commit

Permalink
Merge SVN 4645
Browse files Browse the repository at this point in the history
  • Loading branch information
@ddeclerck
ddeclerck committed Jun 19, 2024
1 parent c395768 commit 1d83105
Show file tree
Hide file tree
Showing 6 changed files with 222 additions and 14 deletions.
5 changes: 5 additions & 0 deletions cobc/ChangeLog
View file
Original file line number Diff line number Diff line change
Expand Up @@ -246,6 +246,11 @@
* cobc.c: drop source format-related macros
* cobc.c (cobc_print_info): silence a warning with string indexing

2022-07-05 Nicolas Berthier <[email protected]>

* pplex.l, parser.y: parse DISPLAY and ACCEPT statements in DEFAULT
SECTION (GCOS 7 extension)

2022-07-04 Nicolas Berthier <[email protected]>

FR #29 support for ACUCOBOL-GT Terminal format
Expand Down
46 changes: 46 additions & 0 deletions cobc/parser.y
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3372,6 +3372,7 @@ nested_list:
depth = 0;
setup_from_identification = 0;
}
_control_division /* GCOS extension */
source_element_list
;

Expand Down Expand Up @@ -3559,6 +3560,51 @@ _prototype_procedure_division_header:
}
;

/* CONTROL DIVISION (GCOS extension) */

_control_division:
/* empty */
| CONTROL DIVISION TOK_DOT
{
cb_verify (cb_control_division, "CONTROL DIVISION");
}
_default_section
;

_default_section:
/* empty */
| DEFAULT SECTION TOK_DOT
_default_clauses
{
cobc_cs_check = 0;
}
;

_default_clauses:
/*empty*/
| _default_accept_clause
_default_display_clause
TOK_DOT
;

_default_accept_clause:
/* empty */
| ACCEPT _is word_or_terminal
{
CB_PENDING ("ACCEPT statement in DEFAULT SECTION");
/* TODO: setup_default_accept ($3); */
}
;

_default_display_clause:
/* empty */
| DISPLAY _is word_or_terminal
{
CB_PENDING ("DISPLAY statement in DEFAULT SECTION");
/* TODO: setup_default_display ($3); */
}
;

/* PROGRAM body */

_program_body:
Expand Down
42 changes: 30 additions & 12 deletions cobc/pplex.l
View file
Original file line number Diff line number Diff line change
Expand Up @@ -459,34 +459,52 @@ DEFNUM_LITERAL [+-]?[0-9]*[\.]*[0-9]+
"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");
DEFAULT SECTION where compile-time defaults are specified. */
/* cf `ppparse.y`, grammar entry `program_with_control_division`, along
with `parser.y`, entry `_control_division`. */
ppecho (yytext, 0, (int)yyleng);
yy_push_state (CONTROL_DIVISION_STATE);
return CONTROL_DIVISION;
}

<CONTROL_DIVISION_STATE>"SUBSTITUTION"[ ,;\n]+"SECTION" {
yy_push_state (SUBSTITUTION_SECTION_STATE);
return SUBSTITUTION_SECTION;
<CONTROL_DIVISION_STATE>{
"SUBSTITUTION"[ ,;\n]+"SECTION" {
yy_push_state (SUBSTITUTION_SECTION_STATE);
return SUBSTITUTION_SECTION;
}
\. {
/* Pass dots to the parser to handle DEFAULT SECTION. */
ppecho (yytext, 0, (int)yyleng);
return DOT;
}
}

<SUBSTITUTION_SECTION_STATE>"REPLACE" {
yy_push_state (COPY_STATE);
return REPLACE;
<SUBSTITUTION_SECTION_STATE>{
"REPLACE" {
yy_push_state (COPY_STATE);
return REPLACE;
}
\. {
/* Intercept dots within the SUBSTITUTION SECTION */
return DOT;
}
}

<CONTROL_DIVISION_STATE,
SUBSTITUTION_SECTION_STATE>{
"DEFAULT"[ ,;\n]+"SECTION" {
/* Pop any control division-related start condition state. */
while (YY_START == CONTROL_DIVISION_STATE ||
YY_START == SUBSTITUTION_SECTION_STATE)
yy_pop_state ();
ppecho (yytext, 0, (int)yyleng);
}
[,;]?\n {
ECHO;
check_listing (yytext, 0);
cb_source_line++;
}
[,;]?[ ]+ { /* ignore */ }
\. {
return DOT;
}
}

<INITIAL,
Expand Down
2 changes: 1 addition & 1 deletion config/bs2000-strict.conf
View file
Original file line number Diff line number Diff line change
Expand Up @@ -195,7 +195,7 @@ dpc-in-data: xml

alter-statement: obsolete
comment-paragraphs: unconformable
control-division: unconformable # not verified yet
control-division: unconformable
partial-replacing-with-literal: unconformable # not verified yet
call-overflow: ok
data-records-clause: obsolete
Expand Down
2 changes: 1 addition & 1 deletion config/rm-strict.conf
View file
Original file line number Diff line number Diff line change
Expand Up @@ -199,7 +199,7 @@ dpc-in-data: xml

alter-statement: obsolete
comment-paragraphs: obsolete
control-division: unconformable # not verified yet
control-division: unconformable
partial-replacing-with-literal: unconformable # not verified yet
call-overflow: ok
data-records-clause: obsolete
Expand Down
139 changes: 139 additions & 0 deletions tests/testsuite.src/syn_misc.at
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8723,3 +8723,142 @@ AT_CHECK([$COMPILE replace.cob], [1], [],
])

AT_CLEANUP


AT_SETUP([CONTROL: empty default section])
AT_KEYWORDS([control gcos])

AT_DATA([prog.cob], [
CONTROL DIVISION.
DEFAULT SECTION.
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 VAR PIC X(2) VALUE "OK".
PROCEDURE DIVISION.
DISPLAY VAR NO ADVANCING
END-DISPLAY.
STOP RUN.
])

AT_CHECK([$COMPILE -fcontrol-division=ok prog.cob], [0], [], [])
AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], [])
AT_CHECK([$COMPILE prog.cob], [1], [],
[prog.cob:2: error: CONTROL DIVISION does not conform to GnuCOBOL
])

AT_CLEANUP


AT_SETUP([CONTROL: default section])
AT_KEYWORDS([control gcos])

AT_DATA([prog.cob], [
CONTROL DIVISION.
DEFAULT SECTION.
ACCEPT ALTERNATE CONSOLE
DISPLAY IS TERMINAL
.
IDENTIFICATION DIVISION.
PROGRAM-ID. prog.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 VAR PIC X(2) VALUE "OK".
PROCEDURE DIVISION.
DISPLAY VAR NO ADVANCING
END-DISPLAY.
STOP RUN.
])

AT_CHECK([$COMPILE -fcontrol-division=ok prog.cob], [0], [],
[prog.cob:4: warning: ACCEPT statement in DEFAULT SECTION is not implemented
prog.cob:5: warning: DISPLAY statement in DEFAULT SECTION is not implemented
])
AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], [])
AT_CHECK([$COMPILE prog.cob], [1], [],
[prog.cob:2: error: CONTROL DIVISION does not conform to GnuCOBOL
prog.cob:4: warning: ACCEPT statement in DEFAULT SECTION is not implemented
prog.cob:5: warning: DISPLAY statement in DEFAULT SECTION is not implemented
])

AT_CLEANUP


AT_SETUP([CONTROL: substitution & default section])
AT_KEYWORDS([control gcos])

AT_DATA([empties.cob], [
CONTROL DIVISION.
SUBSTITUTION SECTION.
DEFAULT SECTION.
IDENTIFICATION DIVISION.
PROGRAM-ID. empties.
PROCEDURE DIVISION.
STOP RUN.
])

AT_CHECK([$COMPILE -fcontrol-division=ok empties.cob], [0], [], [])

AT_DATA([empty0.cob], [
CONTROL DIVISION.
SUBSTITUTION SECTION.
DEFAULT SECTION.
ACCEPT ALTERNATE CONSOLE
.
IDENTIFICATION DIVISION.
PROGRAM-ID. empty0.
PROCEDURE DIVISION.
STOP RUN.
])

AT_CHECK([$COMPILE -fcontrol-division=ok empty0.cob], [0], [],
[empty0.cob:5: warning: ACCEPT statement in DEFAULT SECTION is not implemented
])

AT_DATA([empty1.cob], [
CONTROL DIVISION.
SUBSTITUTION SECTION.
REPLACE "KO" BY "OK".
DEFAULT SECTION.
IDENTIFICATION DIVISION.
PROGRAM-ID. empty1.
DATA DIVISION.
WORKING-STORAGE SECTION.
01 VAR PIC X(2) VALUE "KO".
PROCEDURE DIVISION.
DISPLAY VAR NO ADVANCING
STOP RUN.
])

AT_CHECK([$COMPILE -fcontrol-division=ok empty1.cob], [0], [], [])
AT_CHECK([$COBCRUN_DIRECT ./empty1], [0], [OK], [])

AT_DATA([prog.cob], [
CONTROL DIVISION.
SUBSTITUTION SECTION.
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 NO ADVANCING
END-DISPLAY.
STOP RUN.
])

AT_CHECK([$COMPILE -fcontrol-division=ok prog.cob], [0], [],
[prog.cob:8: warning: ACCEPT statement in DEFAULT SECTION is not implemented
prog.cob:9: warning: DISPLAY statement in DEFAULT SECTION is not implemented
])
AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [OK], [])

AT_CLEANUP

0 comments on commit 1d83105

Please sign in to comment.