https://gcc.gnu.org/g:0bffd1dd17133367b3a8580a30cb4599ce1f98b2
commit r17-4012-g0bffd1dd17133367b3a8580a30cb4599ce1f98b2 Author: James K. Lowden <[email protected]> Date: Wed Sep 2 18:51:00 2026 -0400 cobol: Revise TAB policy and resume passing NIST tests. If a TAB appears in the sequence-number area (columns 1-6) of a fixed-format input, pretend columns 1-7 are blank. Previously that applied only to the indicator column; now everything after the TAB is considered COBOL input. Modify the new fast symbol-lookup for the lexer to find CLASS types. gcc/cobol/ChangeLog: * lexio.cc (source_format_t::indicated): Return pointer to TAB if found. (cdftext::free_form_reference_format): Drop unnecessary TOUPPER. * lexio.h (TAB): Define symbol. * scan.l: Ignore text in comment_entries start condition. * scan_ante.h (symbol_exists): Use single-name lookup as fallback. * symbols.cc (field_str): Print partially-defined FldSwitch. Diff: --- gcc/cobol/lexio.cc | 13 +++++++------ gcc/cobol/lexio.h | 1 + gcc/cobol/scan.l | 2 ++ gcc/cobol/scan_ante.h | 11 ++++++++--- gcc/cobol/symbols.cc | 3 ++- 5 files changed, 20 insertions(+), 10 deletions(-) diff --git a/gcc/cobol/lexio.cc b/gcc/cobol/lexio.cc index 398a4cd514e4..e6e8ffcf6531 100644 --- a/gcc/cobol/lexio.cc +++ b/gcc/cobol/lexio.cc @@ -81,9 +81,8 @@ source_format_t::indicated( char *bol, const char *eol, char ch ) { auto ind = bol + left_margin(); if( eol <= ind ) return NULL; // left margin would be after end of line // If TAB is in the line-number region, nothing is in the indicator column. - bool has_tab = std::any_of(bol, ind, - [](const char ch) { return ch == '\t'; } ); - if( has_tab ) return NULL; + auto ptab = std::find(bol, ind, '\t'); + if( ptab != ind) return ptab; if( (bol += left_margin()) > eol ) return NULL; return ch == '\0' || ch == *bol? bol : NULL; } @@ -1765,8 +1764,8 @@ cdftext::free_form_reference_format( int input, if( mfile.is_blank_line() ) continue; - char *indcol = format.top().indicated(mfile.cur, mfile.eol); // true only for fixed - // // format + // indcol is true only for fixed format + char *indcol = format.top().indicated(mfile.cur, mfile.eol); if( format.top().is_fixed() && !indcol ) { // short line erase_source(mfile.cur, mfile.eol); @@ -1782,7 +1781,7 @@ cdftext::free_form_reference_format( int input, } } - switch( TOUPPER(*indcol) ) { + switch(*indcol) { case '-': gcc_assert(0 < current.line.size()); /* @@ -1805,8 +1804,10 @@ cdftext::free_form_reference_format( int input, } gcc_assert( ! mfile.line_contains_nul() ); continue; + case TAB: case SPACE: break; + case 'd': case 'D': /* * Pass the D to the lexer as 0x8D, because WITH DEBUGGING MODE is diff --git a/gcc/cobol/lexio.h b/gcc/cobol/lexio.h index ccfdcf3a0a29..76af58d96022 100644 --- a/gcc/cobol/lexio.h +++ b/gcc/cobol/lexio.h @@ -40,6 +40,7 @@ #ifndef _LEXIO_H_ #define _LEXIO_H_ +#define TAB '\t' #define SPACE ' ' bool lexer_echo(); diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l index 2645020658a2..9f44703c4792 100644 --- a/gcc/cobol/scan.l +++ b/gcc/cobol/scan.l @@ -299,6 +299,8 @@ PROGRAM-ID{OSPC}{DOTSEP}? { yy_push_state(ident_state); <comment_entries>{ (ENVIRONMENT|DATA|PROCEDURE){SPC}DIVISION { myless(0); yy_pop_state(); } {COMMENTARY}.* + [[:blank:]]+ + [[:graph:]]+ {BLANK_EOL} } diff --git a/gcc/cobol/scan_ante.h b/gcc/cobol/scan_ante.h index 6e0898d42e84..115dbff07eac 100644 --- a/gcc/cobol/scan_ante.h +++ b/gcc/cobol/scan_ante.h @@ -1177,11 +1177,16 @@ symbol_exists( const char name[] ) { auto names = teed_up_names(); names.push_front(name); auto found = symbol_find( PROGRAM, names, false); - return found.second? found.first : nullptr; + if( found.second ) return found.first; + // try again with just one name in case of e.g. FldClass + names.clear(); + names.push_front(name); + found = symbol_find( PROGRAM, names, false); + if( found.second ) return found.first; } /* - * Before data division has been defined and the cache populated, search the - * symbol table in case of named literal. + * Before data division has been defined and the cache populated, or if the + * map search failes, search the symbol table in case of named literal. */ symbol_elem_t *e = symbol_field( PROGRAM, 0, name ); return e; diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index acc2bca25846..7b64212990a2 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -1642,7 +1642,8 @@ field_str( const cbl_field_t *field ) { } } else { init = "NULL"; - if( field->type == FldSwitch ) { + if( field->type == FldSwitch + && field->data.etc_type == cbl_field_data_t::upsi_e ) { init = xasprintf("0x%02x", field->data.upsi_mask_of()->value); } }
