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>
