diff --git a/gcc/cobol/UAT/testsuite.src/syn_misc.at b/gcc/cobol/UAT/testsuite.src/syn_misc.at
index 28a10e25db1edfe19d81252ef79861b1ddb6d398..7a8956d18495e1c46bbfaa2eebba67c04c0f2fe6 100644
--- a/gcc/cobol/UAT/testsuite.src/syn_misc.at
+++ b/gcc/cobol/UAT/testsuite.src/syn_misc.at
@@ -480,7 +480,6 @@ AT_DATA([prog2.cob], [
AT_CHECK([$COMPILE_ONLY prog.cob], [1], [],
[prog.cob:7: ANY LENGTH valid only for 01 in LINKAGE SECTION of a contained program at 'LENGTH'
prog.cob:9: 1 errors in DATA DIVISION, compilation ceases at 'PROCEDURE DIVISION'
-prog.cob:9: error: symbol 'str' not found
cobol1: error: failed compiling prog.cob
])
AT_CHECK([$COMPILE_ONLY prog2.cob], [1], [],
@@ -509,7 +508,6 @@ AT_DATA([prog.cob], [
AT_CHECK([$COMPILE_ONLY prog.cob], [1], [],
[prog.cob:7: ANY LENGTH valid only for 01 in LINKAGE SECTION of a contained program at 'LENGTH'
prog.cob:9: 1 errors in DATA DIVISION, compilation ceases at 'PROCEDURE DIVISION'
-prog.cob:9: error: symbol 'str' not found
cobol1: error: failed compiling prog.cob
])
AT_CLEANUP
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index bceb76bcf0dba644fcd4b413a5338257f62092c9..fe271bed0acdd67d2ffc3b3964c3050d1f40ae93 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -1656,7 +1656,10 @@ symbols_update( size_t first, bool parsed_ok ) {
switch(field->level) {
case 0:
- if( field->is_key_name() ) continue;
+ if( field->is_key_name() ) {
+ update_symbol_map2(p);
+ continue;
+ }
break;
case 1:
pend = calculate_capacity(p);
@@ -1746,6 +1749,7 @@ symbols_update( size_t first, bool parsed_ok ) {
cbl_field_t *field = cbl_field_of(p);
if( field->type == FldForward ) continue;
if( field->type == FldSwitch ) continue;
+ if( field->level == 0 && field->is_key_name() ) continue;
if( is_literal(field) && field->var_decl_node != NULL ) continue;
if( field->is_typedef() ) {
@@ -1771,12 +1775,10 @@ symbols_update( size_t first, bool parsed_ok ) {
assert( ! field->is_typedef() );
- update_symbol_map2( p );
- if( field->level == 0 && field->is_key_name() ) continue;
-
if( parsed_ok ) parser_symbol_add(field);
}
+ finalize_symbol_map2();
if( yydebug ) dump_symbol_map2();
build_symbol_map();
@@ -2144,6 +2146,12 @@ symbol_table_init(void) {
// Initialize symbol table.
symbols = table;
+ for( auto e = symbols.elems; e < symbols.elems + symbols.nelem; e++ ) {
+ if( e->type == SymField ) {
+ update_symbol_map2(e);
+ }
+ }
+
symbols.first_program = symbols.nelem;
symbols.registers.linage_counter = symbol_index(symbol_field(0,0,
@@ -2425,6 +2433,8 @@ symbol_field_add( size_t program, struct cbl_field_t *field )
numeric_constants[program][lname] = symbol_index(e);
}
+ update_symbol_map2( e );
+
return e;
}
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index 3de3b73a67c8c31fe6a76fefca2191ac8f581899..f3c399e613b8ac2c7ff318dfab469033ed351ad7 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -1847,6 +1847,7 @@ void build_symbol_map();
bool update_symbol_map( symbol_elem_t *e );
void update_symbol_map2( const symbol_elem_t *elem );
+void finalize_symbol_map2();
void dump_symbol_map2();
std::pair<symbol_elem_t *, bool>
diff --git a/gcc/cobol/symfind.cc b/gcc/cobol/symfind.cc
index 022d66a24ef78e3f13c7213ebbfa8ff4be4899a2..5ecfbb0f641f7fa025351252b8f54b9d5f949dcf 100644
--- a/gcc/cobol/symfind.cc
+++ b/gcc/cobol/symfind.cc
@@ -97,13 +97,55 @@ static symbol_map_t symbol_map;
typedef std::map <field_key_t, std::list<size_t> > field_keymap_t;
static field_keymap_t symbol_map2;
+/*
+ * As each field is added to the symbol table, add its name and index
+ * to the name map. Initially the type is FldInvalid. Those are
+ * removed by symbols_update();
+ */
void
update_symbol_map2( const symbol_elem_t *e ) {
auto field = cbl_field_of(e);
+
+ if( ! field->is_typedef() ) {
+ switch( field->type ) {
+ case FldForward:
+ case FldLiteralN:
+ return;
+ case FldLiteralA:
+ if( ! field->is_key_name() ) return;
+ break;
+ default:
+ break;
+ }
+ }
+
field_key_t fk( e->program, field );
symbol_map2[fk].push_back(symbol_index(e));
}
+/*
+ * Purge any field whose type is FldInvalid. Remove any names that do
+ * not map to any field.
+ */
+void
+finalize_symbol_map2() {
+ std::set<field_key_t> empties;
+
+ for( auto& elem : symbol_map2 ) {
+ auto& fields( elem.second );
+ std::remove_if( fields.begin(), fields.end(),
+ []( auto isym ) {
+ auto f = cbl_field_of(symbol_at(isym));
+ return f->type == FldInvalid;
+ } );
+ if( fields.empty() ) empties.insert(elem.first);
+ }
+
+ for( const auto& key : empties ) {
+ symbol_map2.erase(key);
+ }
+}
+
static void
dump_symbol_map2( const field_key_t& key, const std::list<size_t>& candidates ) {
if( !yydebug ) return;
@@ -128,7 +170,7 @@ dump_symbol_map2() {
for( const auto& elem : symbol_map2 ) {
const field_key_t& key( elem.first );
const std::list<size_t>& candidates( elem.second);
- if( key.program <= candidates.front() ) {
+ if( key.program != 0 ) {
dump_symbol_map2( key, candidates );
n++;
}
@@ -425,10 +467,13 @@ symbol_match2( size_t program,
field_key_t key(program, names.back());
- for( auto candidate : symbol_map2[key] ) {
- auto e = symbol_at(candidate);
- if( name_has_names( e, names, local ) ) {
- fields.push_back( symbol_index(e) );
+ auto plist = symbol_map2.find(key);
+ if( plist != symbol_map2.end() ) {
+ for( auto candidate : plist->second ) {
+ auto e = symbol_at(candidate);
+ if( name_has_names( e, names, local ) ) {
+ fields.push_back( symbol_index(e) );
+ }
}
}
@@ -439,7 +484,7 @@ symbol_match2( size_t program,
}
}
- if( yydebug && ! fields.empty() ) {
+ if( yydebug ) {
char *ancestry = NULL;
const char *sep = "";
for( auto name : names ) {
@@ -450,21 +495,26 @@ symbol_match2( size_t program,
free(partial);
}
- char *fieldstr = NULL;
- sep = "";
- for( auto field : fields ) {
- char *partial = fieldstr;
- asprintf(&fieldstr, "%s%s%zu", partial? partial : "", sep, field);
- sep = ", ";
- assert(fieldstr);
- free(partial);
- }
+ if( fields.empty() ) {
+ warnx("%s: '%s' matches no fields", __func__, ancestry);
+ dump_symbol_map2();
+ } else {
+ char *fieldstr = NULL;
+ sep = "";
+ for( auto field : fields ) {
+ char *partial = fieldstr;
+ asprintf(&fieldstr, "%s%s%zu", partial? partial : "", sep, field);
+ sep = ", ";
+ assert(fieldstr);
+ free(partial);
+ }
- warnx("%s: '%s' matches %zu fields: {%s}", __func__, ancestry, fields.size(), fieldstr);
+ warnx("%s: '%s' matches %zu fields: {%s}", __func__, ancestry, fields.size(), fieldstr);
+ free(fieldstr);
+ }
free(ancestry);
- free(fieldstr);
}
-
+
return fields;
}