diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y
index b8968e0abda9da86d179dbb4d3447fa7ca6eef09..c39d84f26fbc171fa42cdad9e0e778568f3d248b 100644
--- a/gcc/cobol/parse.y
+++ b/gcc/cobol/parse.y
@@ -309,7 +309,7 @@
%type <number> star_cbl_opt close_how
%type <number> test_before usage_clause1 might_be
-%type <boolean> all optional sign_leading on_off initialized
+%type <boolean> all optional sign_leading on_off initialized strong
%type <number> count data_clauses data_clause
%type <number> nine nps relop spaces_etc reserved_value signed
%type <number> rounded rounded_mode rounded_type round_between
@@ -326,7 +326,7 @@
%type <refer> rel_operand num_value num_term value factor
%type <field_data> value78
-%type <field> literal name nume
+%type <field> literal name nume typename
%type <field> advance_by num_literal signed_literal
%type <refer> perform_times
%type <perf> perform_verb perform_inline
@@ -808,6 +808,7 @@ statement_begin( const YYLTYPE& loc, int token ) {
cbl_enabled_exceptions_array_t enabled(enabled_exceptions);
parser_exception_prepare( keyword_str(token), &enabled );
}
+ if( getenv(__func__) ) symbol_temporaries_free();
}
%}
@@ -3845,15 +3846,28 @@ sign_separate: %empty { $$ = false; }
/*
* "The effect of the TYPE clause is as though the data description identified
- * by type-name- 1 had been coded in place of the TYPE clause, excluding the
+ * by type-name-1 had been coded in place of the TYPE clause, excluding the
* level-number, name, alignment, and the GLOBAL, SELECT WHEN, and TYPEDEF
* clauses specified for type-name-1;"
+ *
+ * The essential characteristics of a type, which is identified by its
+ * type-name, are the:
+ * — relative positions and lengths of the elementary items
+ * — ALIGNED clause
+ * — BLANK WHEN ZERO clause
+ * — JUSTIFIED clause
+ * — PICTURE clause
+ * — SIGN clause
+ * — SYNCHRONIZED clause
+ * — USAGE clause
*/
-type_clause: is TYPE strong
+type_clause: TYPE to typename
{
cbl_field_t *field = current_field();
- field->attr |= typedef_e;
- yywarn("warning: TYPEDEF not implemented");
+ if( $typename ) {
+ symbol_field_same_as(field, $typename);
+ }
+ yywarn("warning: TYPE TO is provisional");
}
;
@@ -3861,7 +3875,8 @@ typedef_clause: is TYPEDEF strong
{
cbl_field_t *field = current_field();
field->attr |= typedef_e;
- yywarn("warning: TYPEDEF not implemented");
+ if( $strong ) field->attr |= strongdef_e;
+ yywarn("warning: TYPEDEF is provisional");
}
;
@@ -5316,6 +5331,19 @@ refmod: LPAREN expr[from] ':' expr[len] ')' %prec NAME
}
;
+typename: qname
+ {
+ auto e = symbol_typedef(PROGRAM, names);
+ if( ! e ) {
+ yyerrorv("error: symbol '%s' not found", names.back() );
+ names.clear();
+ YYERROR;
+ }
+ $$ = cbl_field_of(e);
+ names.clear();
+ }
+ ;
+
name: qname
{
$$ = NULL;
@@ -9387,8 +9415,8 @@ sign: %empty
status: %empty
| STATUS
;
-strong: %empty
- | STRONG
+strong: %empty { $$ = true; }
+ | STRONG { $$ = false; }
;
times: %empty
diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc
index 95b3316c69b8cc3b34658c9cc9525598042a4ae7..928ee0961f9cb6fbb9893b07e3069cb929b1fd8b 100644
--- a/gcc/cobol/symbols.cc
+++ b/gcc/cobol/symbols.cc
@@ -2462,7 +2462,7 @@ symbol_field_add( size_t program, struct cbl_field_t *field )
* TYPEDEF is relevant only in Data Division.
*/
struct symbol_elem_t *
-symbol_typedef( size_t program, size_t parent, const char name[] )
+symbol_typedef_DNU( size_t program, size_t parent, const char name[] )
{
class match_field {
size_t program, parent;
diff --git a/gcc/cobol/symbols.h b/gcc/cobol/symbols.h
index ee87d2908205617fe9c5a129fe806ca4d4668cdd..17ca9f3fc9fc5703bd6a4bb58615849444296f14 100644
--- a/gcc/cobol/symbols.h
+++ b/gcc/cobol/symbols.h
@@ -2091,8 +2091,7 @@ size_t current_program_index();
const char * current_declarative_section_name();
-struct symbol_elem_t * symbol_typedef( size_t program,
- size_t parent, const char name[] );
+struct symbol_elem_t * symbol_typedef( size_t program, std::list<const char *> names );
struct symbol_elem_t * symbol_field( size_t program,
size_t parent, const char name[] );
struct cbl_label_t * symbol_program( size_t parent, const char name[] );
diff --git a/gcc/cobol/symfind.cc b/gcc/cobol/symfind.cc
index 0dd6646601a06c7db9d389b628f879867af73bf3..3100e4054b75de17ec48a559b28b87156f1d99dd 100644
--- a/gcc/cobol/symfind.cc
+++ b/gcc/cobol/symfind.cc
@@ -386,7 +386,7 @@ size_t end_of_group( size_t igroup );
static std::vector<size_t>
symbol_match2( size_t program,
std::list<const char *> names,
- bool local = true )
+ bool local = true, bool want_type = false )
{
std::vector<size_t> fields;
@@ -397,19 +397,23 @@ symbol_match2( size_t program,
if( e->program != program ) break;
if( e->type != SymField ) continue;
- if( is_typedef(e) ) {
+ bool right_kind = ( want_type && is_typedef(e)) ||
+ (!want_type && !is_typedef(e));
+#if 0
+ if( !right_kind ) {
auto isym = end_of_group( symbol_index(e) );
e = symbol_at(--isym);
continue;
}
-
- if( name_has_names( e, names, local ) ) {
+#endif
+
+ if( right_kind && name_has_names( e, names, local ) ) {
fields.push_back( symbol_index(e) );
}
}
if( fields.empty() ){
- if( program > 0 ) { // try containing program
+ if( program > 0 && !want_type ) { // try containing program
program = cbl_label_of(symbol_at(program))->parent;
return symbol_match2( program, names, program == 0 );
}
@@ -448,7 +452,7 @@ symbol_match2( size_t program,
* The names list is in top-down order, front-to-back. This function
* iterates backwards over the list, looking for the parent of N at
* N-1.
-*/
+ */
static symbol_map_t
symbol_match( size_t program, std::list<const char *> names ) {
auto matched = symbol_match2( program, names );
@@ -469,6 +473,17 @@ symbol_match( size_t program, std::list<const char *> names ) {
return output;
}
+struct symbol_elem_t *
+symbol_typedef( size_t program, std::list<const char *> names ) {
+ auto types = symbol_match2(program, names, true, true);
+ if( types.empty() ) return NULL;
+ if( types.size() > 1 ) {
+ yyerrorv("error: %s is not a unique TYPEDEF name", names.back());
+ return NULL;
+ }
+ return symbol_at( types.front() );
+}
+
std::pair <symbol_elem_t *, bool>
symbol_find( size_t program, std::list<const char *> names ) {
symbol_map_t items = symbol_match(program, names);