Merge SVN 4639

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 <[email protected]>
+
+	* 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 <[email protected]>
 
 	* pplex.l, ppparse.y, config.h: support COPY and REPLACE

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"))

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;
+}
+
+<CONTROL_DIVISION_STATE>"SUBSTITUTION"[ ,;\n]+"SECTION" {
+	yy_push_state (SUBSTITUTION_SECTION_STATE);
+	return SUBSTITUTION_SECTION;
+}
+
+<SUBSTITUTION_SECTION_STATE>"REPLACE"	{
+	yy_push_state (COPY_STATE);
+	return REPLACE;
+}
+
+<CONTROL_DIVISION_STATE,
+SUBSTITUTION_SECTION_STATE>{
+  [,;]?\n		{
+	  ECHO;
+	  check_listing (yytext, 0);
+	  cb_source_line++;
+  }
+  [,;]?[ ]+		{ /* ignore */ }
+  \. 			{
+	  return DOT;
+  }
+}
+
+<INITIAL,
+CONTROL_DIVISION_STATE,
+SUBSTITUTION_SECTION_STATE>
 ("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);

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

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 <[email protected]>
+
+	* general: added option control-division
+
 2021-11-14  Ron Norman <[email protected]>
 
 	* mf.words: Add MF specific names B-EXOR, B-LEFT, B-RIGHT for bit

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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