https://gcc.gnu.org/g:fda1343ae84090a78a40a7c9b34b11c146985061

commit r17-2266-gfda1343ae84090a78a40a7c9b34b11c146985061
Author: James K. Lowden <[email protected]>
Date:   Wed Jul 8 15:41:04 2026 -0400

    cobol: Support non-unique section names.
    
    Correct section->paragraph map in the symbol table.  Allow section
    names to be repeated and for paragraphs in them to be PERFORMed if the
    name-pair is unique. Verify all referenced procedures are defined.
    
    gcc/cobol/ChangeLog:
    
            * genapi.cc (parser_call_targets_dump): Remove function.
            * genapi.h (parser_call_targets_dump): Same.
            * parse.y: Instantiate forward labels consistently.
            (label_add) Capture forward references for efficiency.
            (paragraph_reference) Use forward reference.
            (label_add_once): New function.
            * parse_ante.h (label_add_once): Declare function.
            (label_instantiate): New function.
            (ast_enter_exit_section): Improve debug message.
            * symbols.cc (label_cmp): Allow forward reference to have a parent.
            (cbl_label_ref_t): Remove class.
            (symbol_label): Whitespace.
            (symbols_dump): Add information to output.
            (symbol_add): Remove program label symbol-assignment to 
symbol_label_add.
            (cbl_label_t::str): Add information to output.
            (symbol_label_add): Assign id to program label.
            * symbols.h (class cbl_label_ref_t): Remove.
            (struct symbol_elem_t): Remove struct keyword.
            (struct cbl_label_t): Same.
            (struct cbl_special_name_t): Same.
            (struct cbl_field_t): Same.
            (symbol_typedef): Same.
            (symbol_field): Same.
            (symbol_label): Same.
            (symbol_function): Same.
            (symbol_function_any): Same.
            (symbol_program): Same.
            (symbol_literalA): Same.
            (symbol_special): Same.
            (symbol_locale): Same.
            (symbol_alphabet): Same.
            (symbol_file): Same.
            (symbol_file_record): Same.
            (struct cbl_section_t): Same.
            (symbol_section): Same.
            (parent_of): Same.
            * util.cc: (match_proc::find) Use only section and paragraph names.

Diff:
---
 gcc/cobol/genapi.cc    |  23 ---------
 gcc/cobol/genapi.h     |   1 -
 gcc/cobol/parse.y      | 130 ++++++++++++++++++++++++++++++++++++++++---------
 gcc/cobol/parse_ante.h |  23 +++++++--
 gcc/cobol/symbols.cc   |  93 +++++++++++------------------------
 gcc/cobol/symbols.h    |  69 +++++++++-----------------
 gcc/cobol/util.cc      | 122 ++++++++++++----------------------------------
 7 files changed, 207 insertions(+), 254 deletions(-)

diff --git a/gcc/cobol/genapi.cc b/gcc/cobol/genapi.cc
index 3e2b251969b3..62efc19a0ea6 100644
--- a/gcc/cobol/genapi.cc
+++ b/gcc/cobol/genapi.cc
@@ -737,29 +737,6 @@ parser_call_target_convention( tree func )
   return cbl_call_cobol_e;
   }
 
-void
-parser_call_targets_dump()
-  {
-    dbgmsg( "call targets for #" HOST_SIZE_T_PRINT_UNSIGNED " NOT dumping",
-            (fmt_size_t)current_program_index() );
-#if 0 // A change to call_targets rendered this routine useless.  Until we get
-      // around to repairing it, this code is left for reference.
-    for( const auto& elem : call_targets ) {
-      const auto& k = elem.first;
-      const auto& v = elem.second;
-      fprintf(stderr, "\t#%-3" GCC_PRISZ "u %s calls %s ",
-              (fmt_size_t)k.caller, cbl_label_of(symbol_at(k.caller))->name,
-              k.called);
-      char ch = '[';
-      for( auto func : v ) {
-        fprintf( stderr, "%c %s", ch, IDENTIFIER_POINTER(DECL_NAME(func)) );
-        ch = ',';
-      }
-      fprintf(stderr, " ]\n");
-    }
-#endif
-  }
-
 size_t
 parser_call_target_update( size_t caller,
                            const char plain_name[],
diff --git a/gcc/cobol/genapi.h b/gcc/cobol/genapi.h
index 773edacb7752..10bbf0074376 100644
--- a/gcc/cobol/genapi.h
+++ b/gcc/cobol/genapi.h
@@ -582,7 +582,6 @@ void parser_clear_exception();
 void parser_push_exception();
 void parser_pop_exception();
 
-void parser_call_targets_dump();
 size_t parser_call_target_update( size_t caller,
                                   const char extant[],
                                   const char mangled_tgt[] );
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 7eed35c1a015..22445ed5b4c5 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -5647,10 +5647,11 @@ sentences:      sentence {
         |       paragraph_name[para] '.'
                 {
                   location_set(@para);
-                  cbl_label_t *label = label_add(@para, LblParagraph, $para);
-                  if( !label ) {
-                    YYERROR;
-                  }
+                  cbl_label_t
+                    *label = label_instantiate(@para, PROGRAM, LblParagraph,
+                                               current.program_section(),
+                                               $para);
+                  assert(label);
                   ast_enter_paragraph(@para, label);
                   current.new_paragraph(label);
                   apply_declaratives();
@@ -5664,10 +5665,11 @@ sentences:      sentence {
         |       sentences paragraph_name[para] '.'
                 {
                   location_set(@para);
-                  cbl_label_t *label = label_add(@para, LblParagraph, $para);
-                  if( !label ) {
-                    YYERROR;
-                  }
+                  cbl_label_t
+                    *label = label_instantiate(@para, PROGRAM, LblParagraph,
+                                               current.program_section(),
+                                               $para);
+                  assert(label);
                   ast_enter_paragraph(@para, label);
                   current.new_paragraph(label);
                   apply_declaratives();
@@ -7048,7 +7050,7 @@ if_statements:  %empty        %prec ADD
         |       statements    %prec ADD
         |       NEXT SENTENCE %prec ADD
                 {
-                  next_sentence = label_add(LblNone, "next_sentence", 0);
+                  next_sentence = label_add_once(LblNone, "next_sentence");
                   parser_label_goto(next_sentence);
                 }
                 ;
@@ -7110,7 +7112,7 @@ eval_case:      eval_objects statements %prec ADD {
                 {
                  auto& ev( eval_stack.current() );
                  ev.write_when_label();
-                  next_sentence = label_add(LblNone, "next_sentence", 0);
+                  next_sentence = label_add_once(LblNone, "next_sentence");
                   parser_label_goto(next_sentence);
                 }
                 ;
@@ -8017,14 +8019,14 @@ cce_factor:     NUMSTR {
 section_name:  NAME section_kw '.'
                 {
                   statement_begin(@1, SECTION);
-                 $$ = label_add(@1, LblSection, $1);
+                 $$ = label_instantiate(@1, PROGRAM, LblSection, 0, $1);
                   ast_enter_section(@1, $$);
                   apply_declaratives();
                 }
        |       NAME section_kw // lexer swallows '.' before USE
                 <label>{
                   statement_begin(@1, SECTION);
-                 $$ = label_add(@1, LblSection, $1);
+                 $$ = label_instantiate(@1, PROGRAM, LblSection, 0, $1);
                   ast_enter_section(@1, $$);
                   apply_declaratives();
                 } [label]
@@ -9812,7 +9814,7 @@ search_2_case:  WHEN { 
parser_bsearch_conditional(search_current()); }
 
 search_stmts:   statements    %prec ADD
         |       NEXT SENTENCE %prec ADD {
-                  next_sentence = label_add(LblNone, "next_sentence", 0);
+                  next_sentence = label_add_once(LblNone, "next_sentence");
                   parser_label_goto(next_sentence);
                 }
                 ;
@@ -10891,13 +10893,16 @@ label_1:        qname
 
                   if( namelocs.size() == 2 ) {
                    auto nameloc = namelocs.front();
-                    cbl_label_t *sect = label_add(nameloc.loc, LblSection, 
nameloc.name);
+                    cbl_label_t *sect = symbol_label(PROGRAM,
+                                                     LblSection, 0, 
nameloc.name);
+                    if( !sect ) sect = label_add(nameloc.loc, LblNone, 
nameloc.name);
                     isect = symbol_index(symbol_elem_of(sect));
                   }
 
                   $$ = paragraph_reference(@1, para, isect);
                   assert($$);
-                  dbgmsg( "using procedure %s of line %d", $$->name, $$->line 
);
+                  size_t isym = symbol_index(symbol_elem_of($$));
+                  dbgmsg( "using procedure #%lu %s of line %d", isym, 
$$->name, $$->line );
                 }
         |       NUMSTR
                 {
@@ -13213,7 +13218,7 @@ class label_named {
 typedef label_named<LblSection> section_named;
 typedef label_named<LblParagraph> paragraph_named;
 
-static struct cbl_label_t *
+static cbl_label_t *
 label_add( const cbl_loc_t& loc,
           enum cbl_label_type_t type, const char name[] ) {
   size_t parent = 0;
@@ -13256,20 +13261,86 @@ label_add( const cbl_loc_t& loc,
 
   assert( !(p->type == LblSection && p->parent > 0) );
 
+  if( type == LblNone ) {
+    auto isym = symbol_index(symbol_elem_of(p));
+    current.forward_add(isym);
+    dbgmsg("%s: add forward %s %s #%lu", __func__,
+           p->type_str(), p->name, (unsigned long)isym);
+  }
   return p;
 }
 
+/*
+ * Special treatment for the "next_sentence" label, which the compiler creates 
and
+ * remains LblNone.
+ */
+static cbl_label_t *
+label_add_once( cbl_label_type_t type, const char name[] ) {
+  cbl_label_t *L = symbol_label(PROGRAM, type, 0, name);
+  if( L ) return L;
+
+  cbl_label_t label = { type, 0, 0 }; // no parent, line 0
+  strcpy(label.name, name);
+  
+  return symbol_label_add(PROGRAM, &label);
+}
+
 /*
  * Many label names are defined statically and so are guaranteed to be in
  * bounds. Often they are created far away from the yacc metavariables, so
  * there's no location to access.
  */
-static struct cbl_label_t *
+static cbl_label_t *
 label_add( enum cbl_label_type_t type, const char name[], int line ) {
   cbl_loc_t loc { line, 1, line, 1 };
   return label_add(loc, type, name);
 }
 
+// When a Section or Paragraph is defined, first see if a LblNone exists for
+// it.  If so, imbue it as now defined. Else create one.  
+static cbl_label_t *
+label_instantiate( const cbl_loc_t& loc, size_t program,
+                          cbl_label_type_t type, size_t section,
+                          const char name[] )
+{
+  cbl_label_t *label = symbol_label(program, type, section, name);
+  if( ! label && type == LblParagraph ) {
+    // A forward reference could be mistakenly attached to a section with no
+    // such paragraph.
+    auto& forwards = current.forwards();
+
+    for( auto isym : forwards ) {
+      auto para = cbl_label_of(symbol_at(isym));
+      if( para->type == LblNone ) {
+        if( 0 == strcasecmp(para->name, name) ) {
+          assert(para->parent);
+          auto sect = cbl_label_of(symbol_at(para->parent));            
+          if( 0 == strcasecmp(sect->name, current.section()->name) ) {
+            // The current section has the same name as a prior one, and that
+            // prior one was parsed without instantiating a forward reference
+            // that was attached to it.  So, use it.  
+            label = para;
+            forwards.erase(isym);
+            break;
+          }
+        }
+      }
+    }
+  }
+  if( label && label->type == LblNone ) {
+    label->type = type;
+    label->parent = section;
+    label->line = loc.first_line;
+    dbgmsg("%s:%d: instantiated %s", __func__, __LINE__, label->str());
+    return label;
+  }
+
+  label = label_add(loc, type, name);
+  dbgmsg("%s:%d: add %s", __func__, __LINE__, label->str());
+  
+  return label;
+}
+
 cbl_label_t *
 perform_t::ec_labels_t::new_label( cbl_label_type_t type,
                                   const cbl_name_t role )
@@ -13309,15 +13380,28 @@ perform_t::ec_labels_t::new_label( cbl_label_type_t 
type,
 static struct cbl_label_t *
 paragraph_reference( const cbl_loc_t& loc, const char name[], size_t section )
 {
-  // A reference has line == 0.  It is LblParagraph if the section is
-  // explicitly named, else LblNone (because we don't know).
-  struct cbl_label_t *p, label = { section? LblParagraph : LblNone, section };
+  dbgmsg("%s: find '%s' in section #%lu", __func__, name, (unsigned 
long)section);
+  // A reference has line == 0.  It is LblNone, possibly with a parent, until 
instantiated.
+  cbl_label_t label = { LblNone, section };
   assert(strlen(name) < sizeof(label.name)); // caller ensures
   strcpy(label.name, name);
-  if( label.type == LblNone ) assert(label.parent == 0);
 
-  p = symbol_label_add(PROGRAM, &label);
-  assert(p);
+  auto p = symbol_label(PROGRAM, LblParagraph, label.parent, label.name);
+  if( !p && section == 0 ) {
+    p = symbol_label(PROGRAM, LblSection, label.parent, label.name);
+  }
+  if( ! p  ) {
+    p = symbol_label_add(PROGRAM, &label);
+    assert(p);
+    if( p->type == LblNone ) {
+      auto isym = symbol_index(symbol_elem_of(p));
+      current.forward_add(isym);
+      dbgmsg("%s: add forward %s %s #%lu in section %lu", __func__,
+             p->type_str(), p->name,
+             (unsigned long)isym, (unsigned long)p->parent);
+    }
+  }
+  
   const char *para_name = p->name;
   const char *sect_name = section? cbl_label_of(symbol_at(section))->name : 
NULL;
   
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index db574def42e7..01d546cb85ae 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -941,10 +941,15 @@ struct tgt_list_t {
   list<cbl_num_result_t> targets;
 };
 
-static struct cbl_label_t *
+static cbl_label_t *
 label_add( const cbl_loc_t& loc, enum cbl_label_type_t type, const char name[] 
);
-static struct cbl_label_t *
+static cbl_label_t *
+label_add_once( cbl_label_type_t type, const char name[] );
+static cbl_label_t *
 label_add( enum cbl_label_type_t type, const char name[], int line );
+static cbl_label_t *
+label_instantiate( const cbl_loc_t& loc, size_t program,
+                   cbl_label_type_t type, size_t section, const char name[]);
 
 static struct cbl_label_t *
 paragraph_reference( const cbl_loc_t& loc, const char name[], size_t section );
@@ -1714,6 +1719,7 @@ static class current_t {
   program_stack_t programs;
   unique_typedefs_t typedefs;
   std::set<function_descr_t> udfs;
+  std::set<size_t> undefined_labels;
   int first_statement;
   bool in_declaratives;
   // from command line or early TURN
@@ -1979,6 +1985,14 @@ static class current_t {
     return client->second;
   }
 
+  void forward_add( size_t isym ) {
+    assert( LblNone == cbl_label_of(symbol_at(isym))->type );
+    undefined_labels.insert(isym);
+  }
+  auto& forwards() {
+    return undefined_labels;
+  }
+
   void alpha_encoding( size_t isym, cbl_encoding_t encoding ) {
     prog_descr_t& program = programs.top();
     program.alphabet.alpha.set(isym, encoding);
@@ -2189,7 +2203,6 @@ static class current_t {
         }
       callers_we_have_seen.insert(caller);
       }
-      if( yydebug ) parser_call_targets_dump();
     }
 
     parser_leave_paragraph( programs.top().paragraph );
@@ -3526,8 +3539,8 @@ ast_enter_exit_section( cbl_label_t * section ) {
     parser_leave_section(prior.sect);
   }
   if( section ) {
-    dbgmsg( "%s:%d: entering section %s", __func__, __LINE__,
-            section->name );
+    dbgmsg( "%s:%d: entering section #%lu %s", __func__, __LINE__,
+            (unsigned long)symbol_index(symbol_elem_of(section)), 
section->name );
     parser_enter_section(section);
     parser_enter_paragraph(paragraph);
   }
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index 565abb51799b..951eac6a955d 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -386,6 +386,7 @@ special_pair_cmp( const cbl_special_name_t& key,
  * Key                 Element       New    Effect
  * type  parent  line  type  parent  type
  * None     -          None     -           unqualified ref matches decl
+ * None     S          Para     -             qualified ref matches forward 
decl
  * None     -          Sect     -           unqualified ref matches section
  * None     -          Para     x           unqualified ref matches any para
  * Sect     -          None     -    Sect   section definition updates decl
@@ -407,14 +408,13 @@ static bool label_cmp( const cbl_label_t& key,
   switch( key.type ) {
 
   case LblNone:
-    assert(0 == key.explicit_parent());
     assert(0 == key.line);
     switch( elem.type ) {
-    case LblNone:
     case LblSection:
       assert(!elem.explicit_parent());
       return true;
       break;
+    case LblNone:
     case LblParagraph:
       return true;
       break;
@@ -427,6 +427,7 @@ static bool label_cmp( const cbl_label_t& key,
     assert(0 == key.explicit_parent());
     switch( elem.type ) {
     case LblNone:
+      return true;
     case LblSection:
       assert(!elem.explicit_parent());
       return true;
@@ -439,17 +440,18 @@ static bool label_cmp( const cbl_label_t& key,
   case LblParagraph:
     switch( elem.type ) {
     case LblNone:
-      if(elem.explicit_parent()) {
-        cbl_errx( "%s:%d: LblNone '%s' has parent #%zu",
-             __func__, __LINE__, elem.name, elem.parent );
+      // dbgmsg("%s:%d: para %s: key parent %zu, LblNone elem parent %zu", 
__func__, __LINE__, 
+      //        key.name, key.parent, elem.parent);
+      // Undefined label element with matching parent or no parent.
+      if( key.parent == elem.parent || elem.parent == 0 ) { 
+        return key.line == 0 || elem.line == 0 || key.line == elem.line;
       }
-      assert(!elem.explicit_parent());
-      return true;
       break;
     case LblParagraph:
-      if( key.parent == elem.parent ) { // explicit or implicit
+      // dbgmsg("%s:%d: para %s: key parent %zu, elem parent %zu", __func__, 
__LINE__, 
+      //        key.name, key.parent, elem.parent);
+      if( key.parent == 0 || key.parent == elem.parent ) { // explicit or 
implicit
         return key.line == 0 || elem.line == 0 || key.line == elem.line;
-        // negative key.line never matches (causing insertion)
       }
       break;
     default:
@@ -562,24 +564,7 @@ symbol_elem_cmp( const void *K, const void *E )
   return strcasecmp(cbl_field_of(k)->name, cbl_field_of(e)->name);
 }
 
-cbl_label_ref_t::
-cbl_label_ref_t( size_t program, const cbl_label_t& context, int line,
-                 const char name[], size_t isect )
-  : qualified(isect != 0)
-  , context(context)
-  , line(line)
-  , handle(NULL)
-{
-  cbl_label_type_t type = isect? LblParagraph : LblNone;
-  struct cbl_label_t label = { type, isect, line };
-  assert(strlen(name) < sizeof(label.name));
-  strcpy(label.name, name);
-
-  target = symbol_label_add(program, &label);
-  assert(target);
-}
-
-struct cbl_label_t *
+cbl_label_t *
 symbol_label( size_t program, cbl_label_type_t type, size_t section,
               const char name[],
               const char os_name[] )
@@ -608,7 +593,7 @@ symbol_label( size_t program, cbl_label_type_t type, size_t 
section,
                       break;
                     case LblNone: case LblSection: case LblParagraph:
                       return label_cmp(key, elem, true);
-                        break;
+                      break;
                     default:
                       if( key.parent != elem.parent ) { // allow zero parent 
of LblNone
                         if( !(elem.type == LblNone && elem.explicit_parent() 
== 0) ) return false;
@@ -1141,8 +1126,9 @@ symbols_dump( size_t first, bool header ) {
       }
       break;
     case SymLabel:
+      if( cbl_label_of(e)->type == LblLoop ) continue;
       s = xasprintf("%4" GCC_PRISZ "u %-18s %s", (fmt_size_t)e->program,
-                    "Labe1l", e->elem.label.str());
+                    "Label", e->elem.label.str());
       if( LblProgram == cbl_label_of(e)->type ) {
         const auto& L = *cbl_label_of(e);
         if( L.os_name ) {
@@ -2584,21 +2570,9 @@ symbol_add( struct symbol_elem_t *elem )
     cbl_field_of(elem)->our_index = symbols.nelem;
   }
 
-  struct symbol_elem_t *p =
-    static_cast<struct symbol_elem_t *>(lsearch( elem, symbols.elems,
+  auto p = static_cast<symbol_elem_t *>(lsearch( elem, symbols.elems,
                                                  &symbols.nelem, sizeof(*elem),
                                                  symbol_elem_cmp ) );
-  assert(symbols.nelem > 1);
-
-  if( is_program(*p) ) {
-    assert(p->program == 0 || p->elem.label.os_name != NULL);
-    p->program = p - symbols.elems;
-  }
-
-  if( p->program == 0 ) {
-    p->program = p[-1].program;
-  }
-
   return p;
 }
 
@@ -4408,7 +4382,7 @@ cbl_label_t::str() const {
   char *buf;
   switch(type) {
   case LblParagraph:
-    buf = xasprintf("%-12s %s OF '%s', line %d", type_str() + 3, name,
+    buf = xasprintf("%-12s %s OF #%ld %s, line %d", type_str() + 3, name, 
parent, 
                     parent? cbl_label_of(symbol_at(parent))->name : "", line);
     break;
   case LblProgram:
@@ -4514,40 +4488,29 @@ common_callables_update( const size_t iprog ) {
 cbl_label_t *
 symbol_label_add( size_t program, cbl_label_t *input )
 {
-  cbl_label_t *label = symbol_label(program, input->type,
-                                    input->parent, input->name);
-
-  if( label && label->type == LblNone ) {
-    label->type = input->type;
-    label->parent = input->parent;
-    label->line = input->line;
-
-    return label;
-  }
-
-  // Set the program's mangled name, dehyphenated and uniqified by parent 
index.
   if( input->type == LblProgram ) {
+    // Set the program's mangled name, dehyphenated and uniqified by parent 
index.
     char *psz = cobol_name_mangler(input->name);
     input->mangled_name = xasprintf("%s." HOST_SIZE_T_PRINT_UNSIGNED,
                                     psz, (fmt_size_t)input->parent);
     free(psz);
   }
 
-  struct symbol_elem_t
-    elem { program, *input }, *e = &elem;
+  symbol_elem_t elem { program, *input }, *e = &elem;
 
-  assert(0 <= e->elem.label.line);
-  e->elem.label.line = -e->elem.label.line; // force insertion
+  e = symbol_append(elem);
+  assert(e);
 
-  if( (e = symbol_add(&elem)) == NULL ) {
-    cbl_errx("%s:%d: could not add '%s'", __func__, __LINE__, label->name);
+  if( is_program(*e) ) {
+    assert(e->program == 0 || e->elem.label.os_name != NULL);
+    e->program = e - symbols.elems;
   }
-  assert(e);
 
-  common_callables_update( symbol_index(e) );
+  if( e->program == 0 ) {
+    e->program = e[-1].program;
+  }
 
-  // restore munged line number unless symbol_add returned an existing label
-  if( e->elem.label.line < 0 ) e->elem.label.line = -e->elem.label.line;
+  common_callables_update( symbol_index(e) );
 
   symbols.labelmap_add(e);
   return cbl_label_of(e);
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index 5fd2f0917fed..3744b3a7f616 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -1559,26 +1559,6 @@ struct cbl_label_t {
 
 struct parser_tgt_t;
 
-class cbl_label_ref_t {
-  bool qualified;             // caller mentioned paragraph & section
-  cbl_label_t *target;
-  const cbl_label_t& context; // section called from
-  int line;                   // point of reference
-  parser_tgt_t *handle;
-public:
-  cbl_label_ref_t( size_t program, const cbl_label_t& context, int line,
-                   const char name[], size_t isect = 0 );
-
-  cbl_label_t * target_of() { return target; }
-
-  parser_tgt_t * handle_of(parser_tgt_t *parser_tgt) {
-    return this->handle = parser_tgt;
-  }
-  parser_tgt_t * handle_of() {
-    return this->handle;
-  }
-};
-
 static inline bool
 label_lessthan( const cbl_label_t & a, const cbl_label_t & b ) {
   if ( a.type == LblNone || b.type == LblNone || a.type == b.type ) {
@@ -2867,35 +2847,34 @@ cbl_namelist_t teed_up_names();
 
 size_t end_of_group( size_t igroup );
 
-struct symbol_elem_t * symbol_typedef( size_t program, std::list<const char *> 
names );
-struct symbol_elem_t * symbol_typedef( size_t program, const char name[] );
-struct symbol_elem_t * symbol_field( size_t program,
-                                     size_t parent, const char name[] );
-struct cbl_label_t *   symbol_label( size_t program, cbl_label_type_t type,
-                                     size_t section, const char name[],
-                                     const char os_name[] = NULL );
-struct symbol_elem_t * symbol_function( size_t parent,
-                                        const char name[], bool prototype = 
false );
-struct cbl_label_t *   symbol_function_any( size_t parent, const char name[] );
-struct cbl_label_t *   symbol_program( size_t parent,
-                                       const char name[], bool prototype = 
false );
-
-struct symbol_elem_t * symbol_literalA( size_t program, const char name[] );
-
-struct cbl_special_name_t * symbol_special( special_name_t id );
-struct symbol_elem_t * symbol_special( size_t program, const char name[] );
-struct symbol_elem_t * symbol_locale( size_t program, const char name[] );
-struct symbol_elem_t * symbol_alphabet( size_t program, const char name[] );
-
-struct symbol_elem_t * symbol_file( size_t program, const char name[] );
-struct cbl_field_t   * symbol_file_record( const cbl_file_t *file );
+symbol_elem_t * symbol_typedef( size_t program, std::list<const char *> names 
);
+symbol_elem_t * symbol_typedef( size_t program, const char name[] );
+symbol_elem_t * symbol_field( size_t program, size_t parent, const char name[] 
);
+cbl_label_t *   symbol_label( size_t program, cbl_label_type_t type,
+                              size_t section, const char name[],
+                              const char os_name[] = NULL );
+symbol_elem_t * symbol_function( size_t parent,
+                                 const char name[], bool prototype = false );
+cbl_label_t *   symbol_function_any( size_t parent, const char name[] );
+cbl_label_t *   symbol_program( size_t parent,
+                                const char name[], bool prototype = false );
+
+symbol_elem_t * symbol_literalA( size_t program, const char name[] );
+
+cbl_special_name_t * symbol_special( special_name_t id );
+symbol_elem_t * symbol_special( size_t program, const char name[] );
+symbol_elem_t * symbol_locale( size_t program, const char name[] );
+symbol_elem_t * symbol_alphabet( size_t program, const char name[] );
+
+symbol_elem_t * symbol_file( size_t program, const char name[] );
+cbl_field_t   * symbol_file_record( const cbl_file_t *file );
 cbl_file_t::varying_t symbol_file_record_sizes( struct cbl_file_t *file );
-struct cbl_section_t * symbol_section( size_t program,
-                                       struct cbl_section_t *section );
+cbl_section_t * symbol_section( size_t program,
+                                struct cbl_section_t *section );
 
 size_t symbol_label_id( const cbl_label_t *label );
 
-struct cbl_field_t * parent_of( const cbl_field_t *f );
+cbl_field_t * parent_of( const cbl_field_t *f );
  const cbl_field_t * occurs_in( const cbl_field_t *f );
 
 cbl_field_t *rename_not_ok( const cbl_field_t *first, const cbl_field_t *last);
diff --git a/gcc/cobol/util.cc b/gcc/cobol/util.cc
index 0d8c88a03afd..4cc19c3ac3e7 100644
--- a/gcc/cobol/util.cc
+++ b/gcc/cobol/util.cc
@@ -2685,29 +2685,9 @@ namespace match_proc {
     }
   };
 
-  struct proc_t {
-    size_t n, isym; // index of first of n matching pairs
-    std::string para, sect;
-    proc_t( size_t n, size_t isym,
-            const std::string& para,
-            const std::string& sect )
-      : n(n), isym(isym), para(para), sect(sect)
-    {}
-    bool operator<( const proc_t& that ) const {
-      if( para == that.para ) {
-        return sect < that.sect;
-      }
-      return para < that.para;
-    }
-    static bool implicit( const std::string& input ) {
-      return input[0] == '_';
-    }
-  };
-
   class procedures_t {
     std::set<sect_t> sects;
     std::set<para_t> paras;
-    std::set<proc_t> procs;
     friend bool statements_verify();
     template <typename T>
     // If the element name is not unique, set its isym to 0 so it can't be 
referenced.
@@ -2739,21 +2719,6 @@ namespace match_proc {
           }
         }
       }
-      // join sections and paragraphs, unreduced
-      std::vector<proc_t> all;
-      for( const auto& para : paras ) {
-        std::set<sect_t> parents;
-        std::copy_if( sects.begin(), sects.end(), std::inserter(parents, 
parents.begin()),
-                      [para]( const auto& sect ) {
-                        return sect.is_unique()
-                          &&   para.parent_name() == sect.name;
-                      } );
-        std::transform( parents.begin(), parents.end(), 
std::back_inserter(all), 
-                        [para]( const auto& sect ) {
-                          proc_t proc(1, para.isym, para.name, sect.name);
-                          return proc;
-                        } );
-      }
       // insert paragraph procedures
       struct stat_t {
         size_t n, isym;
@@ -2764,59 +2729,32 @@ namespace match_proc {
           return *this;
         }
       };
-      std::map<proc_t, stat_t> nprocs;
-      for( const auto& proc : all ) {
-        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
       std::map<sect_t, stat_t> nsects;
       for( const auto& sect : sects ) {
         auto& stat = nsects[sect];
         stat.update( sect.isym );
       }
-      std::transform(nsects.begin(), nsects.end(), std::inserter(procs, 
procs.begin()),
-                     []( 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;
-                     } );
     }
 
     stmt_t::found_t
     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<proc_t> matched;
+      std::set<para_t> matched;
 
       // Match a paragraph name tgt.proc within curr, the current section.
-      std::copy_if(procs.cbegin(), procs.cend(),
+      std::copy_if(paras.cbegin(), paras.cend(),
                    std::inserter(matched, matched.begin()),
-                   [curr, tgt](const auto& proc) {
-                     return match_in_section(proc, tgt, curr);
+                   [curr, tgt](const auto& para) {
+                     return match_in_section(para, 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);
+        if( std::none_of(paras.cbegin(), paras.cend(),
+                         [tgt](const auto& para) {
+                           return match_any_paragraph(para, tgt);
                          }) ) {
           // target may name a section
           if( ! sects.empty() ) {
@@ -2825,52 +2763,59 @@ namespace match_proc {
             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);
+              para_t para( p->isym );
+              matched.insert(para);
             }
           }
         }
       }
       if( matched.empty() ){
         // Match a paragraph or section anywhere in the program.
-        std::copy_if(procs.cbegin(), procs.cend(),
+        std::copy_if(paras.cbegin(), paras.cend(),
                      std::inserter(matched, matched.begin()),
-                     [tgt](const auto& proc) {
-                       return match(proc, tgt);
+                     [tgt](const auto& para) {
+                       return match(para, tgt);
                    });
       };
 
       size_t n = matched.size();
       stmt_t::found_t found = {n, 0};
       if( n ) {
-        const proc_t& proc(*matched.begin());
-        found.isym = proc.isym;
+        const para_t& para(*matched.begin());
+        found.isym = para.isym;
+        if( yydebug && 1 < n ) {
+          for( const auto& para : matched ) {
+            fprintf(stderr, "procedures_t::find:%d: ambig: %s of #%lu, %s\n", 
__LINE__,
+                    para.name.c_str(), (unsigned long)para.parent, 
+                    para.parent_name().c_str());
+          }
+        }
       }
       return found;
     }
   protected:
-    static bool match_in_section( const proc_t& proc,
+    static bool match_in_section( const para_t& para,
                                   const stmt_t::tgt_t& tgt,
                                   const std::string& curr )
     {
-      return proc.para == tgt.name && proc.sect == curr
+      return para.name == tgt.name && para.parent_name() == curr
         &&   (tgt.qual == curr || tgt.qual.empty());
     }
-    static bool match_any_paragraph( const proc_t& proc,
+    static bool match_any_paragraph( const para_t& para,
                                      const stmt_t::tgt_t& tgt )
     {
       assert( tgt.qual.empty() ); 
-      return proc.para == tgt.name;
+      return para.name == tgt.name;
     }
-    static bool match( const proc_t& proc,
+    static bool match( const para_t& para,
                        const stmt_t::tgt_t& tgt )
     {
       if( tgt.qual.empty() ) {
-        return proc.sect == tgt.name
-          ||   proc.para == tgt.name;
+        return para.parent_name() == tgt.name
+          ||   para.name == tgt.name;
       } 
-      return proc.para == tgt.name
-        &&   proc.sect == tgt.qual;
+      return para.name == tgt.name
+        &&   para.parent_name() == tgt.qual;
     }
 
     void dump(const stmt_t& stmt) {
@@ -2896,13 +2841,6 @@ namespace match_proc {
         fprintf(stderr, "\t" "#%lu %s of #%lu\n",
                 (unsigned long)para.isym, para.name.c_str(), (unsigned 
long)para.parent);
       }
-      fprintf(stderr, "%lu Procedures:\n", (unsigned long)procs.size());
-      for( auto proc : procs ) {
-        std::string section("");
-        if( ! proc.sect.empty() ) section += "of " + proc.sect;
-        fprintf(stderr, "\t" "n=%lu %s %s\n",
-                (unsigned long)proc.isym, proc.para.c_str(), section.c_str());
-      }
       return;
     }
   }; // procedures

Reply via email to