diff --git a/gcc/cobol/UAT/testsuite.src/syn_definition.at b/gcc/cobol/UAT/testsuite.src/syn_definition.at
index e73e5950aad38bdce24a7e9a56997f553d87bcdd..a0d25a9e6bbba3755bfbf101c9ab8cafe60e3178 100644
--- a/gcc/cobol/UAT/testsuite.src/syn_definition.at
+++ b/gcc/cobol/UAT/testsuite.src/syn_definition.at
@@ -157,9 +157,9 @@ AT_DATA([prog.cob], [
# better: prog.cob:8: error: 'X IN X' is not defined
AT_CHECK([$COMPILE_ONLY prog.cob], [1], [],
-[prog.cob:8:25: error: DATA-ITEM 'X' not found
+[prog.cob:8:20: error: DATA-ITEM 'X' not found
8 | DISPLAY X IN X
- | ^
+ | ^
cobol1: error: failed compiling prog.cob
])
diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index 0adefd0256ec0927348dd21664a659d3d3e32c91..d55e1eef12e51b1a72fb4271e62d84ed96409882 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -4828,7 +4828,17 @@ scalar88s: scalar88 { $$ = new refer_list_t($1); }
;
name88: NAME88 {
- $$ = cbl_field_of(symbol_find(@1, $1));
+ name_queue.qualify(@1, $1);
+ auto namelocs( name_queue.pop() );
+ auto names( name_queue.namelist_of(namelocs) );
+ if( ($$ = field_find(names)) == NULL ) {
+ if( procedure_div_e == current_division ) {
+ error_msg(namelocs.back().loc,
+ "DATA-ITEM '%s' not found", names.back() );
+ YYERROR;
+ }
+ }
+ assert($$->level == 88);
}
;
@@ -5987,10 +5997,12 @@ typename: NAME
name: qname
{
build_symbol_map();
- auto names( name_queue.pop_as_names() );
+ auto namelocs( name_queue.pop() );
+ auto names( name_queue.namelist_of(namelocs) );
if( ($$ = field_find(names)) == NULL ) {
if( procedure_div_e == current_division ) {
- error_msg(@1, "DATA-ITEM '%s' not found", names.back() );
+ error_msg(namelocs.back().loc,
+ "DATA-ITEM '%s' not found", names.back() );
YYERROR;
}
/*
@@ -12694,15 +12706,15 @@ literal_subscripts_valid( YYLTYPE loc, const cbl_refer_t& name ) {
}
static void
-subscript_dimension_error( YYLTYPE loc, size_t nsub, const cbl_refer_t *name ) {
- if( 0 == dimensions(name->field) ) {
+subscript_dimension_error( YYLTYPE loc, size_t nsub, const cbl_refer_t *scalar ) {
+ if( 0 == dimensions(scalar->field) ) {
error_msg(loc, "%zu subscripts provided for %s, "
"which has no dimensions",
- nsub, name->name() );
+ nsub, scalar->name() );
} else {
error_msg(loc, "%zu subscripts provided for %s, "
"which requires %zu dimensions",
- nsub, name->name(), dimensions(name->field) );
+ nsub, scalar->name(), dimensions(scalar->field) );
}
}
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index 24762f9cf8909c03253525b2066081518011b622..c037625b6b35278776523da07ea21e827e6857d1 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -873,6 +873,21 @@ list_add( list<cbl_num_result_t>& list, cbl_refer_t refer, int round ) {
static list<cbl_domain_t> domains;
typedef list<cbl_domain_t>::iterator domain_iter;
+/*
+ * The name queue is a queue of lists of data-item names recognized by the
+ * lexer, but not returned to the parser. These lists are "teed up" by the
+ * lexer until no more qualifiers are found. At that point, the last name is
+ * returned as a NAME or NAME88 token. NAME88 is returned only if a correctly,
+ * uniquely specified Level 88 data item is found in the symbol table (because
+ * else we can't know).
+ *
+ * When the parser gets a NAME or NAME88 token, it retrieves the pending list
+ * of qualifiers, if any, from the name queue. It adds the returned name to
+ * the list and calls symbol_find() to search the name map. For correctly
+ * specified names, the lexer has already done that work, which is now
+ * unfortunately repeated. For incorrect names, the parser emits a most useful
+ * diagnostic.
+ */
static name_queue_t name_queue;
void
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index a803d45c4494ff26a82db620216604f866572b7e..b55ec8d9f6f29b120ae2d736402eb3cec2639226 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -1981,6 +1981,7 @@ struct cbl_nameloc_t {
: loc(loc), name(name)
{}
};
+
/*
* The lexer pushes qualified names unilaterally, regardless of the
* state of the parser, because it runs ahead of the parser. The
@@ -1994,13 +1995,12 @@ typedef std::list<cbl_nameloc_t> cbl_namelocs_t;
class name_queue_t : private std::queue<cbl_namelocs_t>
{
friend void tee_up_empty();
- friend cbl_namelist_t teed_up_names();
cbl_namelocs_t recent;
void allocate() {
std::queue<cbl_namelocs_t>::push( cbl_namelocs_t() );
}
- protected:
+ public:
static cbl_namelist_t
namelist_of( const cbl_namelocs_t& namelocs ) {
cbl_namelist_t names;
@@ -2010,7 +2010,6 @@ class name_queue_t : private std::queue<cbl_namelocs_t>
} );
return names;
}
- public:
size_t push( const YYLTYPE& loc, const char name[] ) {
assert( !empty() );
back().push_front( cbl_nameloc_t(loc, name) );
diff --git a/gcc/cobol/symfind.cc b/gcc/cobol/symfind.cc
index 93551a1d4cb477c886cad0217bb2265cb8da4d0d..0665b9253dfbc9146e0c49c65f13e9a1fff1f6fc 100644
--- a/gcc/cobol/symfind.cc
+++ b/gcc/cobol/symfind.cc
@@ -533,7 +533,7 @@ symbol_match( size_t program, std::list<const char *> names ) {
auto inserted = output.insert(*p);
if( ! inserted.second ) {
yyerror("%s is not a unique reference", key.name);
- }
+ }
}
return output;
}