Merge SVN 4736

Author: ddeclerck

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 <[email protected]>
+
+	* pplex.l, parser.y: fix AREACHECK in DEFAULT SECTION of CONTROL DIVISON
+
 2022-10-04  Simon Sobisch <[email protected]>
 
 	* codegen.c (output_internal_function): only close files on CANCEL-callback

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); */

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}		{}
 }
 
 <INITIAL,
@@ -1004,7 +1003,6 @@ ENDIF_DIRECTIVE_STATE>{
 	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;

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