https://gcc.gnu.org/g:af7d8aa47684edd0a2947face79ace648bd7da96
commit r17-4734-gaf7d8aa47684edd0a2947face79ace648bd7da96 Author: James K. Lowden <[email protected]> Date: Mon Sep 28 19:31:38 2026 -0400 cobol: Maintain lexer state after CDF. When a CDF lookahead token is not a lookahead token, it is reprocessed for the main parser. In some cases the token appears as NAME and needs to be looked up in the token-word list. Also repair a condition where a CDF directive prevented recognition of an implicit PICTURE. gcc/cobol/ChangeLog: * parse_ante.h (struct refer_list_t): Whitespace. (update_prior_invalid_field): Move to symbols.cc. (field_add): Whitespace. * scan_post.h (run_cdf): Better debug messages. (next_token): Same. (prelex): Same. (yylex): Whitespace. * symbols.cc (update_prior_invalid_field): Define with external linkage. (name_queue_t::dump): Tidy up logic. * symbols.h (update_prior_invalid_field): Declare function. * util.cc (cdf_field_add): Use update_prior_invalid_field. Diff: --- gcc/cobol/parse_ante.h | 25 +++---------------------- gcc/cobol/scan_post.h | 34 +++++++++++++++++++--------------- gcc/cobol/symbols.cc | 22 +++++++++++++++++++++- gcc/cobol/symbols.h | 2 ++ gcc/cobol/util.cc | 3 ++- 5 files changed, 47 insertions(+), 39 deletions(-) diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h index ae056d4fc38a..0f190d042d19 100644 --- a/gcc/cobol/parse_ante.h +++ b/gcc/cobol/parse_ante.h @@ -1311,7 +1311,7 @@ struct refer_list_t { } // the source is not always to be deleted explicit refer_list_t( const cbl_refer_t& refer ) : refers(1, refer) {} - + refer_list_t * push_back( cbl_refer_t *refer ) { refers.push_back(*refer); delete refer; @@ -3318,32 +3318,13 @@ group_attr( const cbl_field_t * field ) { return p->attr; } -/* +/* * 13.16.3 Syntax rules * a) if the literal is alphanumeric, 'PICTURE X(length)' * b) if the literal is boolean, 'PICTURE 1(length)' * c) if the literal is national, 'PICTURE N(length)' * (We don't support boolean yet.) */ -static void -update_prior_invalid_field( const cbl_field_t *field = nullptr) { - symbol_elem_t *e = field? symbol_at(field->our_index) : symbols_end(); - e--; - if( e->type == SymDataSection ) e--; - if( (e)->type == SymField ) { - auto f = cbl_field_of(e); - if( ! field ) field = f; // fake it - if( field->level <= f->level ) { - if( f->type == FldInvalid && f->data.has_initial_value() ) { - if( f->has_attr(quoted_e) || is_figconst(f) ) { - f->type = FldAlphanumeric; - assert(0 < f->char_capacity()); - } - } - } - } -} - static struct cbl_field_t * field_add( const cbl_loc_t& loc, cbl_field_t *field ) { switch(current_data_section) { @@ -3378,7 +3359,7 @@ field_add( const cbl_loc_t& loc, cbl_field_t *field ) { return NULL; break; } - } + } update_prior_invalid_field(field); diff --git a/gcc/cobol/scan_post.h b/gcc/cobol/scan_post.h index d7cf5abbe5bf..679826bcfe0a 100644 --- a/gcc/cobol/scan_post.h +++ b/gcc/cobol/scan_post.h @@ -238,7 +238,7 @@ run_cdf( int token ) { parsing.parser_restore(); if( yy_flex_debug ) { - dbgmsg("%s: CDF parser returned %d, scanner SC <%s>", __func__, + dbgmsg("%s: CDF parser returned %d, scanner SC <%s>", __func__, erc, start_condition_is()); } @@ -272,10 +272,10 @@ static int next_token() { if( token != cdf::last_lexed ) { const char *name = 0 < token? keyword_str(token) : "lost"; if( cdf::last_lexed == NAME ) { - dbgmsg("%s:%d: NAME '%s' became '%s' (%d)", __func__, __LINE__, + dbgmsg("%s:%d: NAME '%s' became '%s' (%d)", __func__, __LINE__, yylval.string, name, token); } else { - dbgmsg("%s:%d: %s (%d) became %d for '%s'", __func__, __LINE__, + dbgmsg("%s:%d: %s (%d) became %d for '%s'", __func__, __LINE__, keyword_str(cdf::last_lexed), cdf::last_lexed, token, yytext); } @@ -322,7 +322,7 @@ prelex() { } else { token = next_token(); } - + if( token == NO_CONDITION && parsing.at_eof() ) { dbgmsg("scanner at EOF, apparently (%d)", token); return YYEOF; @@ -333,15 +333,15 @@ prelex() { if( ! parsing.on() && ! is_cdf_condition_token(token) ) break; } - // Do not disturb lexer state while we're not parsing the COBOL. + // Do not disturb lexer state while we're not parsing the COBOL. if( parsing.on() ) { if( YY_START == cdf_state ) { yy_pop_state(); } - // still parsing.on() + // still parsing.on() if( yy_flex_debug ) { - dbgmsg("scanner SC <%s>", start_condition_is()); + dbgmsg("%s:%d: scanner SC <%s>", __func__, __LINE__, start_condition_is()); } switch(YY_START) { @@ -351,18 +351,22 @@ prelex() { case LINKAGE_SECT: BEGIN(field_state); if( yy_flex_debug ) { - dbgmsg("scanner SC now <%s>", start_condition_is()); + dbgmsg("%s:%d: scanner SC now <%s>", __func__, __LINE__, start_condition_is()); } - } - - if( YY_START == copy_state || YY_START == cdf_state ) { + break; + case copy_state: + case cdf_state: + case field_data_item: if( token == NAME ) { auto tok = keyword_tok(ydflval.string); if( tok ) token = tok; } - yy_pop_state(); + break; + } - dbgmsg("%s: scanner SC <%s>, token now %s", __func__, + if( YY_START == copy_state || YY_START == cdf_state ) { + yy_pop_state(); + dbgmsg("%s:%d: scanner SC <%s>, token now %s", __func__, __LINE__, start_condition_is(), keyword_str(token)); } @@ -398,7 +402,7 @@ prelex() { } dbgmsg( ">>CDF parser done, %s returning %s, conditional compilation %s", __func__, - keyword_str(token), + keyword_str(token), parsing.on()? "TRUE" : "FALSE" ); in_cdf = false; return token; @@ -481,7 +485,7 @@ yylex(void) { dbgmsg("%s:%d: ate %d tokens, now returning %s", __func__, __LINE__, ntoken, keyword_str(token)); } - + if( next_sentence && token == '.' ) { produce_next_sentence_target = true; } diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index 35b364221e72..8a4f08362b08 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -2185,6 +2185,25 @@ symbol_parent( const struct symbol_elem_t *e ) { return p; } +void +update_prior_invalid_field( const cbl_field_t *field) { + symbol_elem_t *e = field? symbol_at(field->our_index) : symbols_end(); + e--; + if( e->type == SymDataSection ) e--; + if( (e)->type == SymField ) { + auto f = cbl_field_of(e); + if( ! field ) field = f; // fake it + if( field->level <= f->level ) { + if( f->type == FldInvalid && f->data.has_initial_value() ) { + if( f->has_attr(quoted_e) || is_figconst(f) ) { + f->type = FldAlphanumeric; + assert(0 < f->char_capacity()); + } + } + } + } +} + static bool had_picture( const cbl_field_t *field ) { if( is_elementary(field->type) ) { @@ -2211,7 +2230,7 @@ had_picture( const cbl_field_t *field ) { void name_queue_t::dump( const char tag[] ) const { - if( ! (yydebug ) ) return; + if( yydebug ) { int i=0; for( const auto& namelocs : this->c ) { static char line[256]; @@ -2227,6 +2246,7 @@ name_queue_t::dump( const char tag[] ) const { dbgmsg("name_queue: %s: is empty", tag); } } +} #if 0 /* diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h index a14d2e13c43d..82dbddf605df 100644 --- a/gcc/cobol/symbols.h +++ b/gcc/cobol/symbols.h @@ -3285,6 +3285,8 @@ enum cbl_field_type_t symbol_field_type( size_t program, const char name[] ); struct symbol_elem_t * symbol_parent( const symbol_elem_t *e ); +void update_prior_invalid_field( const cbl_field_t *field = nullptr); + int length_of_picture(const char *picture); int rdigits_of_picture(const char *picture); int digits_of_picture(const char *picture, bool for_rdigits); diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc index 44fb1f794fea..d2d627f7d146 100644 --- a/gcc/cobol/util.cc +++ b/gcc/cobol/util.cc @@ -343,7 +343,8 @@ void cdf_field_add( const cbl_loc_t& loc, const std::string& name, const cdfval_t& value ) { if( symbols_begin() < symbols_end() ) { cbl_field_t field = cdf_literalize(loc, name, value); - symbol_field_add(current_program_index(), &field); + auto e = symbol_field_add(current_program_index(), &field); + update_prior_invalid_field( cbl_field_of(e) ); } }
