diff --git a/cobc/ChangeLog b/cobc/ChangeLog index 77d64e71..e6acf8b3 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -3,6 +3,10 @@ Reverted change 2022-02-20 to integrate change from GnuCOBOL 3.1 2023-04-04 + * tree.h (cb_field): new flag_above_unbounded + * tree.c (cb_field_has_unbounded), tree.h: removed; use + flag_above_unbounded in callers (typeck.c, cobc.c) instead + * parser.y (occurs_clause): set flag_above_unbounded in parents 2024-10-23 David Declerck diff --git a/cobc/cobc.c b/cobc/cobc.c index 4238418c..3a290de5 100644 --- a/cobc/cobc.c +++ b/cobc/cobc.c @@ -5845,7 +5845,7 @@ print_fields (struct cb_field *top, int *found) got_picture = set_picture (top, picture, picture_len); } - if (top->flag_any_length || cb_field_has_unbounded (top)) { + if (top->flag_any_length || top->flag_above_unbounded) { pd_off = sprintf (print_data, "????? "); } else if (top->flag_occurs && !got_picture) { pd_off = sprintf (print_data, "%05d ", top->size * top->occurs_max); diff --git a/cobc/parser.y b/cobc/parser.y index 5fa7aa75..2e478406 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -781,9 +781,16 @@ setup_occurs (void) } if (current_field->flag_unbounded) { - if (current_field->storage != CB_STORAGE_LINKAGE) { - cb_error_x (CB_TREE(current_field), _("'%s' is not in LINKAGE SECTION"), - cb_name (CB_TREE(current_field))); + if (current_field->storage == CB_STORAGE_LINKAGE) { + struct cb_field *p = current_field; + while (p) { + p->flag_above_unbounded = 1; + p = p->parent; + } + } else { + cb_tree x = CB_TREE (current_field); + cb_error_x (x, _("'%s' is not in LINKAGE SECTION"), cb_name (x)); + current_field->flag_above_unbounded = 1; } } @@ -8422,12 +8429,6 @@ occurs_clause: DEPENDING _on reference _occurs_keys_and_indexed { current_field->flag_unbounded = 1; -#if 0 /* Why should we do this? If this is relevant then it likely needs to be done - either to the field founder or to the complete list of parents up to it. */ - if (current_field->parent) { - current_field->parent->flag_unbounded = 1; - } -#endif current_field->depending = $7; /* most of the field attributes are set when parsing the phrases */; setup_occurs (); diff --git a/cobc/tree.h b/cobc/tree.h index 118db958..95ff84d5 100644 --- a/cobc/tree.h +++ b/cobc/tree.h @@ -1002,7 +1002,7 @@ struct cb_field { unsigned int flag_any_numeric : 1; /* Is ANY NUMERIC */ unsigned int flag_is_returning : 1; /* Is RETURNING item */ unsigned int flag_unbounded : 1; /* OCCURS UNBOUNDED */ - unsigned int flag_comp_1 : 1; /* Is USAGE COMP-1 */ + unsigned int flag_above_unbounded : 1; /* either OCCURS UNBOUNDED field or parent of it */ unsigned int flag_volatile : 1; /* VOLATILE */ unsigned int flag_constant : 1; /* Is 01 AS CONSTANT */ unsigned int flag_internal_constant : 1; /* Is an internally generated CONSTANT */ @@ -1033,6 +1033,7 @@ struct cb_field { unsigned int flag_is_typedef : 1; /* TYPEDEF */ unsigned int flag_picture_l : 1; /* Is USAGE PICTURE L */ + unsigned int flag_comp_1 : 1; /* Is USAGE COMP-1 */ }; #define CB_FIELD(x) (CB_TREE_CAST (CB_TAG_FIELD, struct cb_field, x)) @@ -2105,7 +2106,6 @@ extern int cb_tree_type (const cb_tree, const struct cb_field *); extern int cb_category_is_alpha (cb_tree); extern int cb_category_is_national (cb_tree); -extern int cb_field_has_unbounded (struct cb_field *); extern int cb_fits_int (const cb_tree); extern int cb_fits_long_long (const cb_tree); extern int cb_get_int (const cb_tree); diff --git a/cobc/typeck.c b/cobc/typeck.c index e5ed4f1e..e776671c 100644 --- a/cobc/typeck.c +++ b/cobc/typeck.c @@ -2615,7 +2615,7 @@ refmod_checks (cb_tree x, struct cb_field *f, struct cb_reference *r) /* note: child elements under UNBOUNDED are not included! */ pseudosize = f->size; } - if (cb_field_has_unbounded (f)) { + if (f->flag_above_unbounded) { pseudosize *= -1; } }