From: James K. Lowden Date: Sun, 5 Jul 2026 18:32:08 +0000 (-0400) Subject: cobol: Correct "included from" location. X-Git-Url: http://git.ipfire.org/gitweb.cgi?a=commitdiff_plain;h=da2385e53a08b59db6769eef93199a7fdd0ee00f;p=thirdparty%2Fgcc.git cobol: Correct "included from" location. When an error occurred in a copybook, the diagnostic reported the location of the COPY directive incorrectly. It now reports the line of the directive. The symbol table was recording paragraph/section relationships incorrectly, which was only a problem if the last section PERFORMed. Corrected. Fixes PR #33 Fixes RT 3569. gcc/cobol/ChangeLog: * cbldiag.h (struct cbl_loc_t): Add as_first_line() function. (location_dump): Shorten diagnostic message. * cdf-copy.cc (copybook_elem_t::open_file): Same. * copybook.h (class copybook_t): Remove debug message. * lexio.cc (parse_copy_directive): Clarify comment. (cdftext::lex_open): Set please_push_filename boolean for open_input. (cdftext::open_input): Issue push directive where COPY appeared. (cdftext::output_push_directive): New function. (cdftext::process_file): Relocate PUSH/POP directives. * lexio.h (class cdftext): Add please_push_filename and output_push_directive(). * parse.y: Improve PERFORM diagnostics. * parse_ante.h (ast_enter_exit_section): Correct paragraph section ancestor. * scan.l: Update gcc location for PUSH directive. * symbols.cc (cbl_perform_tgt_t::recurses): New validation function. * symbols.h (struct cbl_perform_tgt_t): Same. * util.cc (cobol_filename): Clarify diagnostic message. (gcc_location_set_impl): Remove function. (gcc_location_set): Implement directly. (gcc_location_dump): Add newline to output. --- diff --git a/gcc/cobol/cbldiag.h b/gcc/cobol/cbldiag.h index 338c47ed38a..d2919201bf8 100644 --- a/gcc/cobol/cbldiag.h +++ b/gcc/cobol/cbldiag.h @@ -116,17 +116,30 @@ struct cbl_loc_t : public cbl_loc_base_t { last_line, last_column } {} - cbl_loc_t( const cbl_loc_base_t& base ) : cbl_loc_base_t(base) // cppcheck-suppress noExplicitConstructor + cbl_loc_t( const cbl_loc_base_t& base ) + : cbl_loc_base_t(base) // cppcheck-suppress noExplicitConstructor {} -#if 0 - cbl_loc_t( int first_line, int first_column, - int last_line, int last_column ) - : first_line(first_line) - , first_column(first_column) - , last_line(last_line) - , last_column(last_column) + + explicit cbl_loc_t( int line ) + : cbl_loc_base_t { + line, 1, line, 1 + } {} -#endif + + cbl_loc_t& operator=( int lineno ) { + first_line = last_line = lineno; + first_column = last_column = 1; + return *this; + } + + // Represent a multi-line location as the first line, so "included from" + // reflects where the COPY statement appears, not where it ends. + cbl_loc_t as_first_line() const { + cbl_loc_t loc(*this); + loc.last_line = first_line; + loc.last_column = first_column; + return loc; + } }; const cbl_loc_t& cobol_location(); @@ -275,9 +288,9 @@ location_dump( const char func[], int line, const char tag[], const LOC& loc) { 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)\n", + 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); + loc.first_line, loc.first_column, loc.last_line, loc.last_column, detail[0]); if( *detail == '2' ) gcc_location_dump(); } } diff --git a/gcc/cobol/cdf-copy.cc b/gcc/cobol/cdf-copy.cc index 304360d5257..f88357b1e90 100644 --- a/gcc/cobol/cdf-copy.cc +++ b/gcc/cobol/cdf-copy.cc @@ -293,15 +293,27 @@ copybook_elem_t::open_file( const char directory[], bool literally ) { gcc_assert( ! literally ); free(copier); + + extern int yydebug; + if( yydebug ) { + std::string pattern(path); + pattern += "{"; + auto comma = ""; + for( const auto suffix : suffixes ) { + pattern += comma; + pattern += suffix; + comma = ","; + } + pattern += "}"; + dbgmsg("%s: trying %s", __func__, pattern.c_str()); + } for( auto suffix : suffixes ) { std::string pattern(path); pattern += suffix; - dbgmsg("%s: trying %s", __func__, pattern.c_str()); - auto filename = pattern.c_str(); + if( (this->fd = open(filename, O_RDONLY)) != -1 ) { - dbgmsg("found copybook file %s", filename); this->source.name = xstrdup(filename); if( ! cobol_filename(this->source.name, inode_of(fd)) ) { error_msg(source.loc, "recursive copybook: '%s' includes itself", diff --git a/gcc/cobol/copybook.h b/gcc/cobol/copybook.h index 9688ab789bf..84b0cc63ff9 100644 --- a/gcc/cobol/copybook.h +++ b/gcc/cobol/copybook.h @@ -198,10 +198,6 @@ class copybook_t { this->source(loc, name); for( auto dir : directories ) { - dbgmsg("copybook_t::open '%s' OF '%s' %s", - book.source.name, - dir? dir: ".", - book.literally.source? ", literally" : "" ); if( (fd = book.open_file(dir, book.literally.source)) != -1 ) break; } return fd; diff --git a/gcc/cobol/lexio.cc b/gcc/cobol/lexio.cc index 34686082c21..fb0c5cfc56f 100644 --- a/gcc/cobol/lexio.cc +++ b/gcc/cobol/lexio.cc @@ -1052,7 +1052,7 @@ parse_copy_directive( filespan_t& mfile ) { } } - // If the parse failed, pass it through to the parser for analysis. + // If the parse succeeded, erase it, else pass it through to the parser for analysis. if( outcome.parsed ) { erase_line( const_cast(copy_stmt.p), const_cast(copy_stmt.pend)); @@ -1526,6 +1526,7 @@ cdftext::lex_open( const char filename[] ) { cobol_filename(name, inode_of(input)); filespan_t mfile( free_form_reference_format( input ) ); + please_push_filename = true; process_file( mfile, output ); dbgmsg("lex_open: processed %zu of %zu: '%s'", n, included_files.size(), name); @@ -1612,7 +1613,7 @@ cdftext::open_input( const char filename[] ) { verbose_file_reader = NULL != getenv("GCOBOL_TEMPDIR"); if( verbose_file_reader ) { - cbl_message(LexInputN, "verbose: opening %s for input", filename); + cbl_message(LexInputN, "opening %s for input", filename); } return fd; } @@ -1851,6 +1852,20 @@ cdftext::free_form_reference_format( int input ) { return source_buffer; } +bool cdftext::please_push_filename = false; + +void +cdftext::output_push_directive( const char filename[], + std::ostream_iterator& ofs ) +{ + static const char file_push[] = "\f#FILE PUSH "; + static const char delimiter[] = "\f"; + + std::copy(file_push, file_push + strlen(file_push), ofs); + std::copy(filename, filename + strlen(filename), ofs); + std::copy(delimiter, delimiter + strlen(delimiter), ofs); +} + /* * process_file is a recursive routine that opens and processes * included files. It uses the input file stack in two ways: to check @@ -1885,21 +1900,28 @@ cdftext::free_form_reference_format( int input ) { void cdftext::process_file( filespan_t mfile, int output, bool second_pass ) { static size_t nfiles = 0; - + __gnu_cxx::stdio_filebuf outbuf(fdopen(output, "a"), std::ios::out); std::ostream out(&outbuf); std::ostream_iterator ofs(out); - // indicate current file - static const char file_push[] = "\f#FILE PUSH ", file_pop[] = "\f#FILE POP\f"; + if( please_push_filename ) { + assert(!second_pass); + output_push_directive( cobol_filename(), ofs ); + please_push_filename = false; + } + +#if 0 + { + auto fd = open("/tmp/I", O_CREAT | O_WRONLY, S_IRWXU); + auto n = write(fd, mfile.data, mfile.size()); + if( n < 0 ) perror("write error"); + close(fd); + } +#endif if( !included_files.empty() ) { ++nfiles; }; // force push/pop of included filename if( !second_pass && nfiles++ ) { - static const char delimiter[] = "\f"; - const char *filename = cobol_filename(); - std::copy(file_push, file_push + strlen(file_push), ofs); - std::copy(filename, filename + strlen(filename), ofs); - std::copy(delimiter, delimiter + strlen(delimiter), ofs); out.flush(); } @@ -1909,8 +1931,8 @@ cdftext::process_file( filespan_t mfile, int output, bool second_pass ) { auto copied = parse_copy_directive(mfile); if( copied.parsed && copied.fd != -1 ) { gcc_assert(copied.erased_lines.p); - std::copy_if(copied.erased_lines.p, copied.erased_lines.pend, ofs, - []( char ch ) { return ch == '\n'; } ); + output_push_directive( cobol_filename(), ofs ); + struct { int in, out; filespan_t mfile; } copy; dbgmsg("%s:%d: line " HOST_SIZE_T_PRINT_UNSIGNED ", opening %s on fd %d", __func__, __LINE__, (fmt_size_t)mfile.lineno(), @@ -1936,7 +1958,19 @@ cdftext::process_file( filespan_t mfile, int output, bool second_pass ) { process_file(copy.mfile, output, true); // COPY statement is erased from input if processed successfully } + /* + * After returning from the recursive call, restore the global current + * filename and output blank lines representing the erased COPY + * statement. Do not be confused: the POP directive is produced by the + * recursed function after processing the copybook file. Here we output + * the blank lines after that directive is produced, representing the + * lines where the COPY statement appeared. + */ cobol_filename_restore(); + unsigned long n = std::count(copied.erased_lines.p, copied.erased_lines.pend, '\n'); + std::copy_if(copied.erased_lines.p, copied.erased_lines.pend, ofs, + []( char ch ) { return ch == '\n'; } ); + dbgmsg("%s:%d: %lu blank lines erased", __func__, __LINE__, n); } auto erased = parse_replace_directive(mfile); @@ -1959,6 +1993,7 @@ cdftext::process_file( filespan_t mfile, int output, bool second_pass ) { } // end of file if( !second_pass && --nfiles ) { + static const char file_pop[] = "\f#FILE POP\f"; std::copy(file_pop, file_pop + strlen(file_pop), ofs); out.flush(); } diff --git a/gcc/cobol/lexio.h b/gcc/cobol/lexio.h index 4a7496ef9ee..f58470d97e2 100644 --- a/gcc/cobol/lexio.h +++ b/gcc/cobol/lexio.h @@ -272,9 +272,13 @@ struct replace_t { #include class cdftext { + static bool please_push_filename; static filespan_t free_form_reference_format( int fd ); static void process_file( filespan_t, int output, bool second_pass = false ); + static void output_push_directive( const char filename[], + std::ostream_iterator& ofs); + static filespan_t map_file( int fd ); static void echo_input( int input, const char filename[] ); diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index 5d22df96c2f..38205262ad2 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -8332,11 +8332,45 @@ perform_proc: perform_names %prec NAME perform_names: label_1[para] { - perform_tgt_set($para); + auto perf = perform_tgt_set($para); + const auto sect = current.section(); + const auto para = current.paragraph(); + const cbl_label_t *curr = perf->tgt.recurses(para, sect); // disabled + + if( sect && curr && curr->type == LblParagraph ) { + // It's not recursion if OF NAME does not match the current section. + if( curr->parent ) { + auto tgt_sect = cbl_label_of(symbol_at(curr->parent)); + if( 0 != strcasecmp(sect->name, tgt_sect->name) ) { + curr = nullptr; + } + } + } + if( curr ) { + error_msg(@$, "would recurse through current procedure %s", + curr->name); + } } | label_1[para1] THRU label_1[para2] { - perform_tgt_set($para1, $para2); + auto perf = perform_tgt_set($para1, $para2); + const auto sect = current.section(); + const auto para = current.paragraph(); + const cbl_label_t *curr = perf->tgt.recurses(para, sect); // disabled + + if( sect && curr && curr->type == LblParagraph ) { + // It's not recursion if OF NAME does not match the current section. + if( curr->parent ) { + auto tgt_sect = cbl_label_of(symbol_at(curr->parent)); + if( 0 != strcasecmp(sect->name, tgt_sect->name) ) { + curr = nullptr; + } + } + } + if( curr ) { + error_msg(@$, "would recurse through current procedure %s", + curr->name); + } } ; @@ -13201,8 +13235,14 @@ label_add( const cbl_loc_t& loc, auto p = std::find_if(symbols_begin(PROGRAM), symbols_end(), paragraph_named(PROGRAM, name)); if( p != symbols_end() ) { - error_msg(loc, "section %s conflicts with paragraph %s on line %d", - name, cbl_label_of(p)->name, cbl_label_of(p)->line); + const auto& para(*cbl_label_of(p)); + if( 0 < para.line ) { + error_msg(loc, "section %s conflicts with paragraph %s on line %d", + name, para.name, para.line); + } else { + error_msg(loc, "section %s would conflict with paragraph of same name", + name); + } } } struct cbl_label_t label = { type, parent, loc.first_line }; diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h index 62bd812c731..db574def42e 100644 --- a/gcc/cobol/parse_ante.h +++ b/gcc/cobol/parse_ante.h @@ -3498,31 +3498,38 @@ implicit_section() static void // cppcheck-suppress constParameterPointer ast_enter_exit_section( cbl_label_t * section ) { - auto implicit = section? implicit_paragraph() : NULL; - - struct { cbl_label_t *para, *sect; + // Add the next section and paragraph to the symbol table, capturing the prior ones. + struct { cbl_label_t *sect, *para; inline bool exists() const { return sect != NULL && para != NULL; } } prior = { - current.new_paragraph(implicit), + // Add the section before the paragraph because label_add() depends on + // current.program_section(). But leave the current paragraph before + // leaving the current section. current.new_section(section) }; + + cbl_label_t *paragraph = nullptr; + + if( section ) { + paragraph = implicit_paragraph(); + prior.para = current.new_paragraph(paragraph); + } + dbgmsg( "%s:%d: leaving section %s paragraph %s (line %d)", __func__, __LINE__, prior.sect? prior.sect->name : "''", prior.para? prior.para->name : "''", yylineno ); - if( section ) { - dbgmsg( "%s:%d: entering section %s", __func__, __LINE__, - section->name ); - } if( prior.exists() ) { parser_leave_paragraph(prior.para); parser_leave_section(prior.sect); } if( section ) { + dbgmsg( "%s:%d: entering section %s", __func__, __LINE__, + section->name ); parser_enter_section(section); - parser_enter_paragraph(implicit); + parser_enter_paragraph(paragraph); } } diff --git a/gcc/cobol/scan.l b/gcc/cobol/scan.l index 1f9f3dd2b08..85604b505f2 100644 --- a/gcc/cobol/scan.l +++ b/gcc/cobol/scan.l @@ -2466,11 +2466,6 @@ BASIS { yy_push_state(basis); return BASIS; } <*>{ {PUSH_FILE} { yy_set_bol(true); - auto top_file = cobol_lineno(yylineno); - if( top_file ) { - if( yy_flex_debug ) dbgmsg(" saving line %4d of %s", - yylineno, top_file); - } // "\f#file push ": name starts at offset 13. char *filename = xstrdup(yytext); filename[yyleng - 1] = '\0'; // kill the trailing formfeed @@ -2479,6 +2474,18 @@ BASIS { yy_push_state(basis); return BASIS; } dbgmsg("logic warning: filename was adjusted to %s", --filename); } + /* + * Update the GCC location so that it reflects the + * location of the COPY directive in the file when + * the parser calls input_file_status_notify(). That + * function leads to gcc's linemap_add, starting a + * new location sequence for the copybook text. When + * it does that, if the current file's location is + * only the parser's last location, the "included + * from" message reflects where the parser last + * parsed, not where the scanner found the COPY. + */ + gcc_location_set(yylloc.as_first_line()); input_file_status.enter(filename); yylineno = 1; reset_location(); @@ -2489,6 +2496,8 @@ BASIS { yy_push_state(basis); return BASIS; } yylineno = input_file_status.pending().lineno; input_file_status.leave(); dbgmsg("banged yylineno to %d", yylineno); + gcc_location_set(yylloc = yylineno); + location_dump("lexer", __LINE__, "POP_FILE", yylloc); } {LINE_DIRECTIVE} { diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index 2513892b0b2..565abb51799 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -2676,6 +2676,28 @@ symbol_registers_add() { } } +const cbl_label_t * +cbl_perform_tgt_t::recurses( const cbl_label_t *para __attribute__ ((unused)), + const cbl_label_t *sect __attribute__ ((unused)) ) const +{ + // Mon Jul 6 11:14:12 2026 + // Decided not to enforce until we enforce EC-FLOW-IMP-RECURSION or + // possibly EC-PROGRAM-RECURSIVE-CALL. +#if 0 + if( from() ) { + auto tgt = from(); + if( para && 0 == strcasecmp(tgt->name, para->name) ) return tgt; + if( sect && 0 == strcasecmp(tgt->name, sect->name) ) return tgt; + } + if( to() ) { + auto tgt = to(); + if( para && 0 == strcasecmp(tgt->name, para->name) ) return tgt; + if( sect && 0 == strcasecmp(tgt->name, sect->name) ) return tgt; + } +#endif + return nullptr; +} + cbl_label_t * cbl_perform_tgt_t::finally( size_t program ) { assert(0 < ito); diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h index dd04ed93c35..5fd2f0917fe 100644 --- a/gcc/cobol/symbols.h +++ b/gcc/cobol/symbols.h @@ -2685,7 +2685,8 @@ struct cbl_perform_tgt_t { return ito? cbl_label_of(symbol_at(ito)) : NULL; } - + const cbl_label_t * recurses( const cbl_label_t *para, + const cbl_label_t *sect ) const; void dump() const { assert(ifrom); if( !ito ) { diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc index 8cc7e146801..0d8c88a03af 100644 --- a/gcc/cobol/util.cc +++ b/gcc/cobol/util.cc @@ -2629,28 +2629,15 @@ namespace match_proc { found_t() : n(0), isym(0) {} found_t(size_t n, size_t isym) : n(n), isym(isym) {} }; - void error(const cbl_name_t program_name, + void error(const cbl_loc_t& loc, const tgt_t&tgt, const found_t& found) const { const char *clause = tgt == tgts.first? "" : "THRU "; + assert( 1 != found.n ); + const char *status = found.n == 0? "procedure not found" : "ambiguous reference"; - switch( found.n ) { - case 1: - gcc_unreachable(); - break; - case 0: - // error: not found - dbgmsg("%s:%d PERFORM %s%s not resolved", - program_name, line, clause, tgt.name.c_str()); - break; - default: - assert( 1 < found.n ); - // error: ambiguous - dbgmsg("%s:%d PERFORM %s%s ambiguous", - program_name, line, clause, tgt.name.c_str()); - break; - } + error_msg(loc, "%s: PERFORM %s%s", status, clause, tgt.name.c_str()); } }; @@ -2664,7 +2651,15 @@ namespace match_proc { bool operator<( const sect_t& that ) const { return name < that.name; } + const sect_t& ambiguous() { + isym = 0; + return *this; + } + bool is_unique() const { + return isym != 0; + } }; + struct para_t { size_t isym, parent; std::string name; @@ -2679,12 +2674,17 @@ namespace match_proc { } return name < that.name; } + const para_t& ambiguous() { + isym = 0; + return *this; + } std::string parent_name() const { if( ! parent ) return std::string(); const auto f = cbl_label_of(symbol_at(parent)); return lcase(f->name); } }; + struct proc_t { size_t n, isym; // index of first of n matching pairs std::string para, sect; @@ -2699,6 +2699,9 @@ namespace match_proc { } return para < that.para; } + static bool implicit( const std::string& input ) { + return input[0] == '_'; + } }; class procedures_t { @@ -2706,6 +2709,17 @@ namespace match_proc { std::set paras; std::set procs; friend bool statements_verify(); + template + // If the element name is not unique, set its isym to 0 so it can't be referenced. + static void update_set( T& names, size_t isym ) { + auto p = names.insert(isym); + if( ! p.second ) { + auto ambig = *p.first; + names.erase(p.first); + p = names.insert(ambig.ambiguous()); + assert(p.second); + } + } public: procedures_t( size_t program ) { // find sections and paragraphs @@ -2714,11 +2728,11 @@ namespace match_proc { const auto& L = *cbl_label_of(e); auto isym = e - symbols_begin(); switch(L.type) { - case LblSection: - sects.insert(isym); + case LblSection: + update_set(sects, isym); break; case LblParagraph: - paras.insert(isym); + update_set(paras, isym); break; default: continue; @@ -2726,12 +2740,13 @@ namespace match_proc { } } // join sections and paragraphs, unreduced - std::list all; + std::vector all; for( const auto& para : paras ) { std::set parents; std::copy_if( sects.begin(), sects.end(), std::inserter(parents, parents.begin()), [para]( const auto& sect ) { - return para.parent_name() == sect.name; + return sect.is_unique() + && para.parent_name() == sect.name; } ); std::transform( parents.begin(), parents.end(), std::back_inserter(all), [para]( const auto& sect ) { @@ -2751,13 +2766,19 @@ namespace match_proc { }; std::map nprocs; for( const auto& proc : all ) { - auto& stat = nprocs[proc]; - stat.update( proc.isym ); + if( ! proc.implicit(proc.para) ) { + auto& stat = nprocs[proc]; + stat.update( proc.isym ); + } } std::transform(nprocs.begin(), nprocs.end(), std::inserter(procs, procs.begin()), []( const auto& elem ) { proc_t proc ( elem.second.n, elem.second.isym, elem.first.para, elem.first.sect ); + const char * para = proc.para.empty()? "" : proc.para.c_str(); + const char * sect = proc.sect.empty()? "" : proc.sect.c_str(); + dbgmsg("%s: insert para #%ld %s of %s", __func__, + proc.isym, para, sect); return proc; } ); // insert section procedures @@ -2770,6 +2791,10 @@ namespace match_proc { []( const auto& elem ) { proc_t proc ( elem.second.n, elem.second.isym, std::string(), elem.first.name ); + const char * para = proc.para.empty()? "" : proc.para.c_str(); + const char * sect = proc.sect.empty()? "" : proc.sect.c_str(); + dbgmsg("%s: insert sect #%ld %s of %s", __func__, + proc.isym, para, sect); return proc; } ); } @@ -2778,29 +2803,75 @@ namespace match_proc { find( const stmt_t& stmt, const stmt_t::tgt_t& tgt ) { if( tgt.empty() ) return stmt_t::found_t(); std::string curr ( lcase( cbl_label_of(symbol_at(stmt.curr))->name ) ); + std::set matched; + + // Match a paragraph name tgt.proc within curr, the current section. + std::copy_if(procs.cbegin(), procs.cend(), + std::inserter(matched, matched.begin()), + [curr, tgt](const auto& proc) { + return match_in_section(proc, tgt, curr); + }); + // Match a section name if unqualified and unique. + if( matched.empty() && tgt.qual.empty() ) { + // target does not name a paragraph + if( std::none_of(procs.cbegin(), procs.cend(), + [tgt](const auto& proc) { + return match_any_paragraph(proc, tgt); + }) ) { + // target may name a section + if( ! sects.empty() ) { + auto fake = *sects.begin(); + fake.isym = 0; + fake.name = tgt.name; + auto p = sects.find(fake); // matches by name only, not isym + if( p != sects.end() && p->is_unique()) { + proc_t proc ( 1, p->isym, std::string(), p->name ); + matched.insert(proc); + } + } + } + } + if( matched.empty() ){ + // Match a paragraph or section anywhere in the program. + std::copy_if(procs.cbegin(), procs.cend(), + std::inserter(matched, matched.begin()), + [tgt](const auto& proc) { + return match(proc, tgt); + }); + }; - auto p = std::find_if(procs.cbegin(), procs.cend(), - [curr, tgt](auto proc) { - return match(proc, tgt, curr); - }); - size_t n = std::count_if(p, procs.end(), - [curr, tgt](const auto& proc) { - return match(proc, tgt, curr); - }); + size_t n = matched.size(); stmt_t::found_t found = {n, 0}; if( n ) { - assert(p != procs.end()); - found.isym = p->isym; + const proc_t& proc(*matched.begin()); + found.isym = proc.isym; } return found; } protected: - static bool match( const proc_t& proc, const stmt_t::tgt_t& tgt, const std::string& curr ) { - return ( proc.para == tgt.name && tgt.qual.empty() ) - || ( proc.sect == tgt.name && tgt.qual.empty() ) - || ( proc.para == tgt.name && proc.sect == tgt.qual ) - || ( proc.para == tgt.name && proc.sect == curr ); - } + static bool match_in_section( const proc_t& proc, + const stmt_t::tgt_t& tgt, + const std::string& curr ) + { + return proc.para == tgt.name && proc.sect == curr + && (tgt.qual == curr || tgt.qual.empty()); + } + static bool match_any_paragraph( const proc_t& proc, + const stmt_t::tgt_t& tgt ) + { + assert( tgt.qual.empty() ); + return proc.para == tgt.name; + } + static bool match( const proc_t& proc, + const stmt_t::tgt_t& tgt ) + { + if( tgt.qual.empty() ) { + return proc.sect == tgt.name + || proc.para == tgt.name; + } + return proc.para == tgt.name + && proc.sect == tgt.qual; + } void dump(const stmt_t& stmt) { std::string target( stmt.tgts.first.name ); @@ -2850,11 +2921,11 @@ namespace match_proc { // Verify each PERFORM statement target is a unique reference for( const auto& stmt : stmts ) { + if( symbol_at(stmt.curr)->program != iprog ) continue; stmt_t::found_t found = procedures.find(stmt, stmt.tgts.first.lcase()); stmt_t::found_t thru = procedures.find(stmt, stmt.tgts.second.lcase()); if( found.n == 1 && (thru.n == 1 || stmt.tgts.second.empty()) ) { - // update proc call list if( stmt.tgts.first.qual.empty() ) { dbgmsg("%s:%d PERFORM %s is ok", program_name, stmt.line, stmt.tgts.first.name.c_str()); @@ -2866,15 +2937,15 @@ namespace match_proc { continue; } nerr++; - + cbl_loc_t loc(stmt.line); if( found.n != 1 ) { - stmt.error(program_name, stmt.tgts.first, found); + stmt.error(loc, stmt.tgts.first, found); if( nerr == 1 && yydebug ) { procedures.dump(stmt); } } if( thru.n != 1 && ! stmt.tgts.second.empty() ) { - stmt.error(program_name, stmt.tgts.second, thru); + stmt.error(loc, stmt.tgts.second, thru); } } return nerr == 0; @@ -3401,7 +3472,6 @@ void cobol_trunc_binary( int cobol_trunc_binary ) { * to enforce uniqueness, and the scanner to maintain line numbers. */ bool cobol_filename( const char *name, ino_t inode ) { - //const line_map *lines = NULL; if( inode == 0 ) { auto p = old_filenames.find(name); if( p == old_filenames.end() ) { @@ -3416,10 +3486,14 @@ bool cobol_filename( const char *name, ino_t inode ) { assert(inode != 0); } } + linemap_add(line_table, LC_ENTER, sysp, name, 1); input_filename_vestige = name; bool pushed = input_filenames.push( input_file_t(name, inode, 1) ); - dbgmsg("%s: %s %s", __func__, pushed? "pushed" : "set to", name); + dbgmsg("%s: %s %s line %d-%d inode %ld", __func__, + pushed? "pushed" : "set to", name, + cobol_location().first_line, + cobol_location().last_line, inode); return pushed; } @@ -3505,8 +3579,8 @@ void current_location_minus_one_clear() * with start and caret at the first line/column of LOC, and finishing at the * last line/column of LOC. */ -static void -gcc_location_set_impl( const cbl_loc_t& loc ) { +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 @@ -3532,16 +3606,6 @@ gcc_location_set_impl( const cbl_loc_t& loc ) { location_dump(__func__, __LINE__, "parser", loc); } -void gcc_location_set( const cbl_loc_t& loc ) { - gcc_location_set_impl(loc); -} - -#if 0 -void gcc_location_set( const YDFLTYPE& loc ) { - gcc_location_set_impl(loc); -} -#endif - #ifdef NDEBUG # define verify_format(M) #else @@ -3575,6 +3639,7 @@ static const diagnostics::option_id option_zero; void gcc_location_dump() { linemap_dump_location( line_table, token_location, stderr ); + fprintf(stderr, "\n"); }