https://gcc.gnu.org/g:f32d925b9b770c7264aeb5a59e67843342efbfc4
commit r17-4792-gf32d925b9b770c7264aeb5a59e67843342efbfc4 Author: Xavier Del Campo Romero <[email protected]> Date: Tue Sep 29 23:22:23 2026 +0200 cobol: Do not add 78-level entries to groups Previously, a 78-level entry appearing after a group definition would be also included into the group, therefore incorrectly increasing the LENGTH OF the group itself. On the other hand, if a 78-level entry appeared between group item subordinates, the one below the 78-level entry was rejected because it was assigned no parent. Now, 78-level entries do not affect groups in any way. gcc/cobol/ChangeLog: * symbols.cc (calculate_capacity): Exclude 78-level entries. (symbol_field_parent_set): Likewise. gcc/testsuite/ChangeLog: * cobol.dg/group2/LENGTH_OF_FILLER_GROUP_with_MF_constants.cob: New test. * cobol.dg/group2/LENGTH_OF_GROUP_with_MF_constants.cob: New test. Diff: --- gcc/cobol/symbols.cc | 8 ++++++- .../LENGTH_OF_FILLER_GROUP_with_MF_constants.cob | 26 ++++++++++++++++++++++ .../group2/LENGTH_OF_GROUP_with_MF_constants.cob | 25 +++++++++++++++++++++ 3 files changed, 58 insertions(+), 1 deletion(-) diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index 13fd073c25b5..ffa24cbc7b49 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -1344,6 +1344,9 @@ calculate_capacity( struct symbol_elem_t *e) { // Stop if field isn't a member of the group. if( end_of_group(group, field) ) break; + // Exclude 78-level entries from groups. + if (field->level == 78) continue; + if( field->type == FldGroup ) { e = calculate_capacity(e); e--; // set e to last symbol processed (not next one, because ++e) @@ -2291,7 +2294,10 @@ symbol_field_parent_set( cbl_field_t *field ) case 66: case 88: break; default: - return NULL; // 77/78 cannot be a parent + // 77 cannot be a parent + if (prior->level == 77) return NULL; + // 78 cannot be a parent, try previous element + if (prior->level == 78) continue; } } diff --git a/gcc/testsuite/cobol.dg/group2/LENGTH_OF_FILLER_GROUP_with_MF_constants.cob b/gcc/testsuite/cobol.dg/group2/LENGTH_OF_FILLER_GROUP_with_MF_constants.cob new file mode 100644 index 000000000000..b7f4025eedec --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/LENGTH_OF_FILLER_GROUP_with_MF_constants.cob @@ -0,0 +1,26 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do run } + *> { dg-options "-dialect mf" } +[ + identification division. + program-id. prog. + data division. + working-storage section. + 01 filler. + 03 filler occurs 2. + 05 group1. + 07 filler pic x(10). + + 78 cnt1 value 2. + 01 group2. + 05 element pic x(10) occurs cnt1. + 77 expected-length binary-long. + + procedure division. + compute expected-length = length of group2 / cnt1. + if length of group1 <> expected-length + display "expected length " expected-length + ", got " length of group1 + end-if. + end program prog. +] diff --git a/gcc/testsuite/cobol.dg/group2/LENGTH_OF_GROUP_with_MF_constants.cob b/gcc/testsuite/cobol.dg/group2/LENGTH_OF_GROUP_with_MF_constants.cob new file mode 100644 index 000000000000..10ffb5a4335f --- /dev/null +++ b/gcc/testsuite/cobol.dg/group2/LENGTH_OF_GROUP_with_MF_constants.cob @@ -0,0 +1,25 @@ + *> Do not edit this generated file. See README.txt + *> { dg-do run } + *> { dg-options "-dialect mf" } +[ + identification division. + program-id. prog. + data division. + working-storage section. + 01 group1. + 03 member1 binary-long. + * ensure 78-level entries between group items does not affect + * parsing. + 78 cnt1 value 0. + 03 member2 binary-long. + 78 cnt2 value 0. + 78 cnt3 value 0. + 77 total-length binary-long. + procedure division. + compute total-length = length of member1 + length of member2. + if length of group1 <> total-length + display "length mismatch, expected " total-length + ", got " length of group1 + end-if. + end program prog. +]
