[gcc r17-2762] cobol: Cleanse lexer of "dangerous trailing context" warnings.

"James K. Lowden via Gcc-cvs" <[email protected]>
Newsgroups gmane.comp.gcc.cvs
Message-ID <[email protected]>
https://gcc.gnu.org/g:9d8f85ca3335a49aba5177620d7f23ebdc88c7a2

commit r17-2762-g9d8f85ca3335a49aba5177620d7f23ebdc88c7a2
Author: James K. Lowden <[email protected]>
Date:   Tue Jul 28 15:26:33 2026 -0400

    cobol: Cleanse lexer of "dangerous trailing context" warnings.
    
    Remove r/s patterns from scan.l where they provoke warnings, notably
    while scanning a PICTURE in the field_state start condition.  Instead,
    scan rs and then find the end of r in user action.  Adjust location
    and scanner position accordingly.
    
    Revise parser picture-validation to use new lexer token sequence.
    Add unimplemented diagnostic for XML GENERATE.  Fixes RT 3580.
    
    Also answer gcc warning by not including <stdbool> .
    
    gcc/cobol/ChangeLog:
    
            * cbldiag.h (location_dump): Only declare function.
            * parse.y: Update numeric PICTURE parse, and better diagnostic.
            * scan.l: Rewrite numeric and numeric-edited PICTURE scan.
            * scan_ante.h (myless): Use "unique" local variable name.
            (length_upto): New function.
            (is_name_char): New function.
            (length_of_name): New function.
            (trim_location): Set location endpoint by addition, not subtraction.
            (ndigit): Allow 'V' at beginning or end of PICTURE string.
            * util.cc (gcc_location_set): Indentation, and more verbose debugging.
            (yy_flex_debug): Undefine tree.h symbol.
            (location_dump): Define function in .cc file, now public.
    
    libgcobol/ChangeLog:
    
            * io.cc: Remove reference to cstdbool, now obsolete.

Diff:
---
 gcc/cobol/cbldiag.h   | 21 ++----------
 gcc/cobol/parse.y     | 53 +++++++++++++++++++++++------
 gcc/cobol/scan.l      | 76 +++++++++++++++++++++++++++---------------
 gcc/cobol/scan_ante.h | 92 +++++++++++++++++++++++++++++++++++----------------
 gcc/cobol/util.cc     | 64 +++++++++++++++++++++++------------
 libgcobol/io.cc       |  1 -
 6 files changed, 199 insertions(+), 108 deletions(-)

diff --git a/gcc/cobol/cbldiag.h b/gcc/cobol/cbldiag.h
index a3f5f70b4388..7a6d25e52a4f 100644
--- a/gcc/cobol/cbldiag.h
+++ b/gcc/cobol/cbldiag.h
@@ -286,22 +286,7 @@ void gcc_location_set( const cbl_loc_t& loc );
 
 void gcc_location_dump();
 
-// tree.h defines yy_flex_debug as a macro because options.h
-#if ! defined(yy_flex_debug)
-template <typename LOC>
-static void
-location_dump( const char func[], int line, const char tag[], const LOC& loc) {
-  extern int yy_flex_debug; // cppcheck-suppress shadowVariable
-  if( yy_flex_debug ) {
-    const char *detail = gcobol_getenv("update_location");
-    if( detail ) { // cppcheck-suppress knownConditionTrueFalse
-      fprintf(stderr, "%s:%d: %s location (%d,%d) to (%d,%d) '%c'\n",
-              func, line, tag,
-              loc.first_line, loc.first_column, loc.last_line, loc.last_column, detail[0]);
-      if( *detail == '2' ) gcc_location_dump();
-    }
-  }
-}
-#endif // defined(yy_flex_debug)
-
+void
+location_dump( const char func[], int line, const char tag[],
+               const cbl_loc_t& loc, bool force = false);
 #endif
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 728d8d164a83..e25275d2242d 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -398,7 +398,7 @@ class locale_tgt_t {
 			NUMED     "NUMERIC-EDITED picture"
 			NUMED_CR  "NUMERIC-EDITED CR picture"
 			NUMED_DB  "NUMERIC-EDITED DB picture"
-%token  <number>        NINEDOT NINES NINEV PIC_P ONES
+%token  <number>        NINEDOT NINES NINEV PIC_P "PICTURE P symbol" ONES
 %token  <string>        SPACES EQ "EQUAL"
 %token  <literal>       LITERAL
 %token  <number>        END EOP
@@ -4759,7 +4759,7 @@ data_clause:    any_length        { $$ = any_length_e; }
         |       volatile_clause      { $$ = volatile_clause_e; }
                 ;
 
-picture_clause: PIC signed nps[fore] nines nps[aft]
+picture_clause: PIC signed PIC_P[fore] nines
                 {
                   cbl_field_t *field = current_field();
                   if( ! field->codeset.set() ) {
@@ -4784,13 +4784,44 @@ picture_clause: PIC signed nps[fore] nines nps[aft]
                   auto nchar = type_capacity(field->type, $nines);
                   field->set_capacity(nchar);
                   field->blank_initial(nchar);
-                  if( $fore && $aft ) { // leading and trailing P's
-                    error_msg(@2, "PIC cannot have both leading and trailing P");
+                  assert($fore);
+                  field->attr |= scaled_e;
+                  field->data.rdigits = $fore;
+                  
+                  if( ! field->reasonable_capacity() ) {
+                    error_msg(@2, "%s limited to capacity of %d (would need %u)",
+			     field->name, MAX_FIXED_POINT_DIGITS, field->char_capacity());
+                  }
+                }
+
+        |       PIC signed nines nps[aft]
+                {
+                  cbl_field_t *field = current_field();
+                  if( ! field->codeset.set() ) {
+                    error_msg(@nines, "PICTURE inconsistent with encoding %s",
+                              cbl_alphabet_t::encoding_str(field->codeset.encoding));
+                  }
+                  if( !field_type_update(field, FldNumericDisplay, @$) ) {
                     YYERROR;
                   }
-                  if( $fore || $aft ) {
+                  ERROR_IF_CAPACITY(@PIC, field);
+                  // If signable_e is inherited from the group, it is effective
+                  // regardless of an 'S' in PICTURE.
+                  if( field->has_attr(signable_e) && ! $signed ) {
+                    dbgmsg("%s PICTURE must be signed for SIGN IS", field->name);
+                  }
+                  if( field->type == FldNumericEdited && $signed ) {
+                    gcc_assert(field->has_attr(blank_zero_e));
+                    error_msg(@signed, "%<S%> in PICTURE invalid with BLANK WHEN ZERO");
+                  }
+                  field->attr |= $signed;
+                  field->data.digits = $nines;
+                  auto nchar = type_capacity(field->type, $nines);
+                  field->set_capacity(nchar);
+                  field->blank_initial(nchar);
+                  if( $aft ) {
                     field->attr |= scaled_e;
-                    field->data.rdigits = $fore? $fore : -$aft;
+                    field->data.rdigits = -$aft;
                   }
                   if( ! field->reasonable_capacity() ) {
                     error_msg(@2, "%s limited to capacity of %d (would need %u)",
@@ -8734,8 +8765,8 @@ subtract_body:  sum FROM rnames
                     corresponding_arith_fields( $sum->refers.front().field,
                                                 rhs.front().refer.field );
                     if( pairs.empty() ) {
-                      cbl_message(ParNoCorrespondingW,
-                                  "%s and %s have no corresponding fields",
+                      cbl_message(@$, ParNoCorrespondingW,
+                                  "%qs and %qs have no corresponding fields",
                                   $sum->refers.front().field->name,
                                   rhs.front().refer.field->name );
                     }
@@ -12550,7 +12581,7 @@ xmlgen_impl:
 xmlgen_cond:    XMLGENERATE xmlgen_body[body] xmlexcepts[err]
                 ;
 
-xmlgen_body:    XMLGENERATE name[id1] FROM name[id2]
+xmlgen_body:    name[id1] FROM name[id2]
                 xmlgen_count xmlencoding xmlgen_decl xmlgen_namespace
                 xmlgen_nameof xmlgen_typeof xmlgen_suppress
                 ;
@@ -12740,8 +12771,8 @@ xmlexcept:      EXCEPTION
                 }
                 ;
 
-end_xml:        %empty     %prec XMLPARSE
-        |       END_XML    %prec XMLPARSE
+end_xml:        %empty   %prec XMLPARSE
+        |       END_XML  %prec XMLPARSE
                 ;
 %%
 
diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l
index eaa323d6d9a4..ee85883ebf88 100644
--- a/gcc/cobol/scan.l
+++ b/gcc/cobol/scan.l
@@ -101,6 +101,7 @@ DOTEOL    [[:blank:]]*[.]{BLANK_EOL}
 	   *  (without an intervening separator space) by the separator period."
 	   */
 NONPIC	  [,]{DOTSEP} 
+EOPIC	  [.,;]?[[:space:]]
 
 SKIP	  [[:blank:]]*SKIP[123][[:blank:]]*[.]?{BLANK_EOL}
 TITLE	  [[:blank:]]*TITLE($|[.]|[^\n]*)
@@ -131,7 +132,7 @@ ALPHED   {ALPHEDREQ}([AX9B0/]{COUNT}?)*
 			 */
 NUMEDCHAR  [BPVZ90/,]+{COUNT}?
 NUMEDCHARS {NUMEDCHAR}([.]?{NUMEDCHAR})*
-NUMED     ([+-]{NUMEDCHARS}+)|({NUMEDCHARS}+[+-])
+NUMED     ([+-]{NUMEDCHARS}+)|({NUMEDCHARS}+[+-]?)
 CURRENCY [A-Zfhijklmoqtuwy\x80-\xFF]{-}[ABCDEGNPRSVXZ]
 NUMEDCUR (([.]?[$0B/Z*+,P9()V+-]|{CURRENCY}+|{COUNT})+([.][$0B/Z*+P9()V+-])*)+
 
@@ -1288,27 +1289,40 @@ USE({SPC}FOR)?		{ return USE; }
 
   [[:blank:]]+[-+]/{EDITED} 	{ return picset(yytext[yyleng-1]); }
 
-  S/({N9}|{NP}|V)+ { return picset('S'); }
-  V?{NP}/{N9}      { yylval.number = ndigit(yyleng);     return picset(PIC_P); }
-  {N9}/{N9}*{NP}V? { yylval.number = ndigit(yyleng);     return picset(NINES); }
-  {NP}V?/[,.]?     { yylval.number = ndigit(yyleng);     return picset(PIC_P); }
-  {N9}*V/{N9}*     { yylval.number = ndigit(yyleng - 1); return picset(NINEV); }
-  {N9}/{N9}*[,.]?  { yylval.number = ndigit(yyleng);     return picset(NINES); }
-  P+/[,.]?{EOL}    { yylval.number = yyleng;             return picset(PIC_P); }
+  /* Sign, if any, first */
+  S/({NP}|{N9}|V)+{EOPIC} { return picset('S'); }
+  /* P's either lead (after sign) or trail, with any V adjacent, see Table 10. */
+  V?{NP}/{N9}*{EOPIC}   { yylval.number =   ndigit(yyleng); return picset(PIC_P); }
+  {NP}V?/{EOPIC}        { yylval.number =   ndigit(yyleng); return picset(PIC_P); }
+  /* Parser accepts any sequence of 9's with one optional V. */
+  {N9}?V/{N9}*{EOPIC}   { yylval.number = ndigit(yyleng - 1); return picset(NINEV); }
+  {N9}/{NP}?V?{EOPIC}   { yylval.number = ndigit(yyleng); return picset(NINES); }
+  /* Match 99(5) as 9 and 9(5) */
+  99+{COUNT}/(V|{N9})*{EOPIC} {
+    auto len = length_upto('(');
+    yylval.number = len;
+    myless(len);
+    return picset(NINES);
+  }
+  [9P]+[(]{NAME}[)] {
+    cbl_unimplemented_at(yylloc, "unimplemented: symbolic count for numeric PICTURE" );
+  }
 
   1{1,31}/({COUNT}|[(]{NAME}[)]) {
                          yy_push_state(picture_count);
                          yylval.string = xstrdup(yytext); return picset(ONES); }
   1{1,31} {              yylval.string = xstrdup(yytext); return picset(ONES); }
 
-  {ALNUM}/{COUNT}({ALNUM}{COUNT}?)+ {
+  {ALNUM}{COUNT}/({ALNUM}{COUNT}?)* {
+			 auto len = length_upto('(');
+			 myless(len); // avoid dangerous trailing context
                          yy_push_state(picture_count);
                          yylval.string = xstrdup(yytext); return picset(ALNUM); }
-  {ALNUM}/{COUNT}      { yy_push_state(picture_count);
-                         yylval.string = xstrdup(yytext); return picset(ALNUM); }
-  {ALNUM}/[(]{NAME}[)] { yy_push_state(picture_count);
+  {ALNUM}[(]{NAME}[)] { auto len = length_upto('(');
+			 myless(len); // avoid dangerous trailing context
+                         yy_push_state(picture_count);
                          yylval.string = xstrdup(yytext); return picset(ALNUM); }
-  {ALNUM}/{NONPIC}?    { yylval.string = xstrdup(yytext); return picset(ALNUM); }
+  {ALNUM}/{EOPIC}?     { yylval.string = xstrdup(yytext); return picset(ALNUM); }
 
   {ALPHED}             { yylval.string = xstrdup(yytext); return picset(ALPHED); }
   {NUMEDITED}          { yylval.string = xstrdup(yytext); return picset(NUMED); }
@@ -1883,9 +1897,11 @@ USE({SPC}FOR)?		{ return USE; }
   STACK                 { return STACK; }
   TOP-LEVEL             { return TOP_LEVEL; }
 
-  {NAME}/{SPC}SECTION{OSPC}{DOTSEP} {
-				    yylval.string = xstrdup(yytext);
-				    return NAME; }
+  {NAME}{SPC}SECTION{OSPC}{DOTSEP} { // Keep only {NAME}.
+				     auto len = length_upto(0x20);
+			 	     myless(len); // avoid dangerous trailing context
+                         	     yylval.string = xstrdup(yytext);
+				     return NAME; }
 
   (IS{SPC})?POSITIVE/[)[:space:]]  { yylval.number =  IS; return POSITIVE; }
   (IS{SPC})?NEGATIVE/[)[:space:]]  { yylval.number =  IS; return NEGATIVE; }
@@ -1976,8 +1992,10 @@ USE({SPC}FOR)?		{ return USE; }
   [.]+({SPC}(EJECT|SKIP[123]))*{SPC}EXIT{OSPC}/{DOTSEP} {
                    // EXIT format-1 is a "continue" statement
                  }
-  {NAME}/{OSPC}{DOTSEP} {
-		   assert(YY_START == procedure_div);
+  {NAME}{OSPC}{DOTSEP} { // Keep only {NAME}.
+		   auto len = length_of_name();
+		   myless(len); // avoid dangerous trailing context
+                   assert(YY_START == procedure_div);
 		   int token;
 		   if( 0 != (token = binary_integer_usage(yytext)) ) return token;
                    if( 0 != (token = keyword_tok(yytext)) ) return token;
@@ -1987,15 +2005,9 @@ USE({SPC}FOR)?		{ return USE; }
                    return typed_name(yytext);
                  }
   LENGTH{SPC}OF/{SPC}{NAME}	 { return LENGTH_OF; }
-  {NAME}/{SPC}(IN|OF){SPC}{NAME}{SPC}(IN|OF)[[:space:]] {
-                    int token = keyword_tok(yytext);
-                    if( token ) return token;
-                    if( is_integer_token() ) return numstr_of(yytext);
-		    myless(0);
-	            yy_push_state(partial_name);
-		    tee_up_empty();
-		}
-  {NAME}/{SPC}(IN|OF){SPC}{NAME} {
+  {NAME}{SPC}(IN|OF){SPC}{NAME} { // Keep only {NAME}.
+		    auto len = length_upto(0x20);
+		    myless(len); // avoid dangerous trailing context
                     int token = keyword_tok(yytext);
                     if( token ) return token;
                     if( is_integer_token() ) return numstr_of(yytext);
@@ -2036,6 +2048,16 @@ USE({SPC}FOR)?		{ return USE; }
 	            yy_push_state(partial_name);
 		    tee_up_empty();
 		}
+  {NAME}({SPC}(IN|OF){SPC}{NAME})+ { // Keep only {NAME}.
+		    auto len = length_upto(0x20);
+		    myless(len); // avoid dangerous trailing context
+                    int token = keyword_tok(yytext);
+                    if( token ) return token;
+                    if( is_integer_token() ) return numstr_of(yytext);
+		    myless(0);
+	            yy_push_state(partial_name);
+		    tee_up_empty();
+		}
 }
 
 <partial_name>{
diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h
index e502e45a041b..fa55b9b17984 100644
--- a/gcc/cobol/scan_ante.h
+++ b/gcc/cobol/scan_ante.h
@@ -356,16 +356,43 @@ static void level_found() {
 }
 
 /*
- * Trim the scanned location by the amount about to re-scanned. 
+ * Return all but the first N characters, to be rescanned by the nexst yylex.
+ * IOW, keep N characters as the token, and relinquish the rest. 
  * Must be a macro because it expands yyless. 
  */
 #define myless(N)				\
   do {						\
-    auto n(N);					\
-    trim_location(n);				\
-    yyless(n);					\
+    auto _n(N);					\
+    trim_location(_n);				\
+    yyless(_n);					\
   } while(0)
 
+static inline int
+length_upto( char ch ) {
+    auto pend = std::find( yytext, yytext + yyleng, ch );
+    return pend - yytext;
+}
+
+static inline bool
+is_name_char( char ch ) {
+  switch(ch) {
+  case '-': case '_':
+    return true;
+  }
+  return ISALNUM(ch);
+}
+
+static inline int
+length_of_name() {
+  // Find first character in yyext that is not a name character.
+  auto pend = std::find_if( yytext, yytext + yyleng,
+                            []( char ch ) {
+                              return ! is_name_char(ch);
+                            } );
+  assert(yytext < pend); // scanner ensures yytext begins with {NAME}
+  return pend - yytext;
+}
+
 class enter_leave_t {
   typedef void( parser_enter_file_f)(const char *filename);
   typedef void (parser_leave_file_f)();
@@ -474,36 +501,41 @@ reset_location() {
 
 #define YY_USER_ACTION update_location();
 
+/*
+ * Before calling yyless to tell the generated scanner to rescan nkeep
+ * characters, set the scanner's location to reflect the cbl_loc_t of what
+ * we're keeping.  Set last_line and last_column by adding the newline count
+ * and characters after the last newline (if any) of the kept region to the
+ * first_line and first_column.
+ */
 static void
 trim_location( int nkeep) {
   gcc_assert( 0 <= nkeep && nkeep <= yyleng );
-  struct { char *p, *pend;
-    size_t size() const { return pend - p; }
-  } rescan = { yytext + nkeep, yytext + yyleng };
-
-  auto nline = std::count(rescan.p, rescan.pend, '\n');
-  dbgmsg("%s:%d: yyless(%d), rescan '%.*s' (" HOST_SIZE_T_PRINT_UNSIGNED
-         " lines, " HOST_SIZE_T_PRINT_UNSIGNED " bytes)",
-         __func__, __LINE__,
-         nkeep,
-         int(rescan.size()), rescan.p,
-         (fmt_size_t)nline, (fmt_size_t)rescan.size());
-  if( nline ) {
-    gcc_assert( yylloc.first_line + nline <= yylloc.last_line );
-    yylloc.last_line -= int(nline);
-    gcc_assert( yylloc.first_line <= yylloc.last_line );
-    char *p = static_cast<char*>(memrchr(rescan.p, '\n', rescan.size()));
-    yylloc.last_column = rescan.pend - ++p;
-    return;
+  auto nline = std::count(yytext, yytext + nkeep, '\n');
+  auto ntoss = yyleng - nkeep;
+  dbgmsg("%s:%d: yyless(%d), rescan '%.*s' (%d bytes)",
+         __func__, __LINE__, nkeep, ntoss, yytext + nkeep, ntoss);
+
+  gcc_assert( yylloc.first_line + nline <= yylloc.last_line );
+  yylloc.last_line = yylloc.first_line + int(nline);
+  gcc_assert( yylloc.first_line <= yylloc.last_line );
+
+  if( nline == 0) {
+    yylloc.last_column = yylloc.first_column + nkeep;
+  } else {
+    auto eokeep = yytext + nkeep;
+    std::reverse_iterator beg(eokeep);
+    std::reverse_iterator end(yytext);
+    auto nl = std::find(beg, end, '\n');
+    gcc_assert( nl != end );
+    gcc_assert( nl.base() != yytext );
+    yylloc.last_column = 1 + (eokeep - nl.base());
   }
 
-  gcc_assert( int(rescan.size()) < yylloc.last_column );
-  yylloc.last_column -= rescan.size();
-  if( yylloc.last_column < yylloc.first_column ) {
-    yylloc.first_column = 1;
-  }
+  gcc_assert( yylloc.first_line <= yylloc.last_line );    
+  gcc_assert( 0 < yylloc.last_column );    
 
-  location_dump(__func__, __LINE__, "yylloc", yylloc);
+  location_dump(__func__, __LINE__, "yylloc", yylloc, true);
 }
 
 static void
@@ -678,9 +710,11 @@ level_of( const char input[] ) {
   return output;
 }
 
+// Called by lexer with leading or trailing V, which is ignored.
 static inline int
 ndigit(int len) {
-  char *input = TOUPPER(yytext[0]) == 'V'? yytext + 1 : yytext;
+  const char *input = yytext + (TOUPPER(yytext[0]) == 'V'? 1 : 0);
+  if( input == yytext + yyleng ) return 0; // Only the V
   int n = repeat_count(input);
   return n == -1? len : n;
 }
diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc
index b0f08f2c9f3d..9e0fb368d042 100644
--- a/gcc/cobol/util.cc
+++ b/gcc/cobol/util.cc
@@ -3501,28 +3501,28 @@ void current_location_minus_one_clear()
 void
 gcc_location_set( const cbl_loc_t& loc ) {
   // Set the position to the first line & column in the location.
- static location_t loc_m_1 = 0;
- const location_t
-   start_line   = linemap_line_start( line_table, loc.first_line, 80 ),
-   token_start  = linemap_position_for_column( line_table, loc.first_column),
-   finish_line  = linemap_line_start( line_table, loc.last_line, 80 ),
-   token_finish = linemap_position_for_column( line_table, loc.last_column);
- token_location = make_location (token_start, token_start, token_finish);
-
- if( loc.first_line > first_line_minus_1 ) {
-   // In order for GDB-COBOL to be able to step through COBOL code properly,
-   // it is sometimes necessary for the code at the beginning of a COBOL
-   // line to be using the location_t of the previous line.  This is true, for
-   // example, when laying down the infrastructure code between the last
-   // statement of a paragraph and the code created at the beginning of the
-   // following paragragh.  This code assumes that token_location values of
-   // interest are monotonic, and stores that prior value.
-   first_line_minus_1 = loc.first_line;
-   token_location_minus_1 = loc_m_1;
-   loc_m_1 = token_location;
- }
-
-  location_dump(__func__, __LINE__, "parser", loc);
+  static location_t loc_m_1 = 0;
+  const location_t
+    start_line   = linemap_line_start( line_table, loc.first_line, 80 ),
+    token_start  = linemap_position_for_column( line_table, loc.first_column),
+    finish_line  = linemap_line_start( line_table, loc.last_line, 80 ),
+    token_finish = linemap_position_for_column( line_table, loc.last_column);
+  token_location = make_location (token_start, token_start, token_finish);
+  
+  if( loc.first_line > first_line_minus_1 ) {
+    // In order for GDB-COBOL to be able to step through COBOL code properly,
+    // it is sometimes necessary for the code at the beginning of a COBOL
+    // line to be using the location_t of the previous line.  This is true, for
+    // example, when laying down the infrastructure code between the last
+    // statement of a paragraph and the code created at the beginning of the
+    // following paragragh.  This code assumes that token_location values of
+    // interest are monotonic, and stores that prior value.
+    first_line_minus_1 = loc.first_line;
+    token_location_minus_1 = loc_m_1;
+    loc_m_1 = token_location;
+  }
+  
+  location_dump(__func__, __LINE__, "parser", loc, true);
 }
 
 #ifdef NDEBUG
@@ -3561,6 +3561,25 @@ void gcc_location_dump() {
     fprintf(stderr, "\n");
 }
 
+// tree.h defines yy_flex_debug as a macro because options.h
+#ifdef yy_flex_debug
+#undef yy_flex_debug
+#endif
+void
+location_dump( const char func[], int line, const char tag[],
+               const cbl_loc_t& loc, bool force) {
+  extern int yy_flex_debug; // cppcheck-suppress shadowVariable
+  if( yy_flex_debug ) {
+    const char *detail = gcobol_getenv("update_location");
+    if( force || detail ) { // cppcheck-suppress knownConditionTrueFalse
+      bool gcc_detail = force || (detail && detail[0] == '2');
+      fprintf(stderr, "%s:%d: %s location (%d,%d) to (%d,%d)\n",
+              func, line, tag,
+              loc.first_line, loc.first_column, loc.last_line, loc.last_column);
+      if( gcc_detail ) gcc_location_dump();
+    }
+  }
+}
 
 void ydferror( const char gmsgid[], ... ) ATTRIBUTE_GCOBOL_DIAG(1, 2);
 
@@ -4201,6 +4220,7 @@ static const std::set<std::string> reserved_words = {
   "END-SUBTRACT",
   "END-UNSTRING",
   "END-WRITE",
+  "END-XML",
   "ENVIRONMENT",
   "EO",
   "EOP",
diff --git a/libgcobol/io.cc b/libgcobol/io.cc
index ceffa2570feb..40f780e34536 100644
--- a/libgcobol/io.cc
+++ b/libgcobol/io.cc
@@ -35,7 +35,6 @@
 
 #include <cassert>
 #include <cerrno>
-#include <cstdbool>
 #include <cstdint>
 #include <cstdio>
 #include <cstdlib>
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.