diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index b477b92f74b21e948e09815213f15f02ceadf521..67cbd6fea55f78d5356bbfdba87305be350868df 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -2938,11 +2938,11 @@ data_descr1: level_name assert($field == current_field()); if( $data_clauses == value_clause_e ) { // only VALUE, no PIC // Error unless VALUE is a figurative constant or (quoted) string. - if( !has_field_attr($field->attr, quoted_e) && + if( $field->type != FldPointer && + ! has_field_attr($field->attr, quoted_e) && normal_value_e == cbl_figconst_of($field->data.initial) ) { - yyerrorv("syntax error: " - "%s numeric VALUE %s requires PICTURE", + yyerrorv("error: %s numeric VALUE %s requires PICTURE", $field->name, $field->data.initial); } $field->type = FldAlphanumeric; @@ -3514,7 +3514,25 @@ usage_clause1: usage COMPUTATIONAL[comp] native $$ = symbol_field_index_set( current_field() )->type; } // We should enforce data/code pointers with a different type. - | usage POINTER { $$ = FldPointer; } + | usage POINTER + { + $$ = FldPointer; + auto field = current_field(); + auto redefined = symbol_redefines(field); + + field->data.capacity = sizeof(void *); + + if( dialect_ibm() && redefined && + is_numeric(redefined->type) && redefined->size() == 4) { + // For now, we allow POINTER to expand a 32-bit item to 64 bits. + if( yydebug ) { + warnx("%s: expanding #%zu %s capacity %u => %u", __func__, + field_index(redefined), redefined->name, + redefined->data.capacity, field->data.capacity); + } + redefined->data.capacity = field->data.capacity; + } + } | usage POINTER TO error { yyerror("error: unimplemented: TYPEDEF"); @@ -3627,6 +3645,7 @@ redefines_clause: REDEFINES NAME[orig] orig->level, name_of(orig), field->level, name_of(field)); } + if( valid_redefine(field, orig) ) { /* * Defer "inheriting" the parent's description until the diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index 12adfda716bf51caed69ecfd18740ca21e2b89de..98644f11b586d48aee6fa8fa254db1fc073e5736 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -1266,31 +1266,35 @@ static struct symbol_elem_t * * referenced by data- name-2 has been specified with level * number 1 and without the EXTERNAL clause. */ - if( redefined && redefined->type == FldGroup && redefined->level > 1 ) { - if( field->type != FldGroup && redefined->type != FldGroup ) { - if( field_memsize(redefined) < field_memsize(field) ) { - yyerrorv("error: line %d: %s (size %u) larger than REDEFINES %s (size %u)", - field->line, - field->name, field_memsize(field), - redefined->name, field_memsize(redefined)); + if( redefined ) { + if( redefined->type == FldGroup && redefined->level > 1 ) { + if( field->type != FldGroup && redefined->type != FldGroup ) { + assert(false); + // don't know what this intended, but redefined->type can't be FldGroup and not. + if( field_memsize(redefined) < field_memsize(field) ) { + yyerrorv("error: line %d: %s (size %u) larger than REDEFINES %s (size %u)", + field->line, + field->name, field_memsize(field), + redefined->name, field_memsize(redefined)); + } } } - } + + if( redefined != group) { + if( group->our_index != redefined->parent ) { + if( yydebug ) yyerrorv("%s:%d: our index %zu != redefined parent %zu", + __func__, __LINE__, group->our_index, redefined->parent); + continue; + } - if( redefined && redefined != group) { - if( group->our_index != redefined->parent ) { - if( yydebug ) yyerrorv("%s:%d: our index %zu != redefined parent %zu", - __func__, __LINE__, group->our_index, redefined->parent); + redefined->data.memsize = std::max(field_memsize(redefined), + field_memsize(field)); + field->data.memsize = 0; + if( redefined->data.memsize == redefined->data.capacity ) { + redefined->data.memsize = 0; + } continue; } - - redefined->data.memsize = std::max(field_memsize(redefined), - field_memsize(field)); - field->data.memsize = 0; - if( redefined->data.memsize == redefined->data.capacity ) { - redefined->data.memsize = 0; - } - continue; } members.push_back(field);