diff --git a/cobc/ChangeLog b/cobc/ChangeLog index af1c7df65..84c7e332e 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -404,6 +404,10 @@ * codegen.c: removed check for "has condition a reference" or disabled this within [COB_TREE_DEBUG] +2022-02-07 David Declerck + + * config.def, parser.y: allow DEPENDING clause in RECORD CONTAINS + 2022-02-06 Ron Norman * codegen.c: if verb changes then emit trace/debug code, too diff --git a/cobc/config.def b/cobc/config.def index 9ff74108e..e1091fe43 100644 --- a/cobc/config.def +++ b/cobc/config.def @@ -437,3 +437,5 @@ CB_CONFIG_SUPPORT (cb_vsam_status, "vsam-status", CB_CONFIG_SUPPORT (cb_self_call_recursive, "self-call-recursive", _("CALL to own PROGRAM-ID implies RECURSIVE attribute")) +CB_CONFIG_SUPPORT (cb_record_contains_depending_clause, "record-contains-depending-clause", + _("DEPENDING clause in RECORD CONTAINS")) diff --git a/cobc/parser.y b/cobc/parser.y index 521c72694..38ffc563f 100644 --- a/cobc/parser.y +++ b/cobc/parser.y @@ -6232,12 +6232,19 @@ record_clause: } } | RECORD _contains integer TO integer _characters + _record_depending /* GCOS extension */ { check_repeated ("RECORD", SYN_CLAUSE_4, &check_duplicate); if (current_file->organization == COB_ORG_LINE_SEQUENTIAL) { cb_warning (cb_warn_additional, _("RECORD clause ignored for LINE SEQUENTIAL")); } else { set_record_size ($3, $5); + if ($7) { + cb_verify (cb_record_contains_depending_clause, "RECORD CONTAINS DEPENDING"); + current_file->record_depending = $7; + current_file->flag_check_record_varying_limits = + current_file->record_min == 0 || current_file->record_max == 0; + } } } | RECORD _is VARYING _in _size _from_integer _to_integer _characters @@ -6245,16 +6252,15 @@ record_clause: { check_repeated ("RECORD", SYN_CLAUSE_4, &check_duplicate); set_record_size ($6, $7); + current_file->record_depending = $9; current_file->flag_check_record_varying_limits = current_file->record_min == 0 || current_file->record_max == 0; } ; _record_depending: -| DEPENDING _on reference - { - current_file->record_depending = $3; - } + /* empty */ { $$ = NULL; } +| DEPENDING _on reference { $$ = $3; } ; _from_integer: diff --git a/config/ChangeLog b/config/ChangeLog index 99bc8ffcc..7c26a6ab9 100644 --- a/config/ChangeLog +++ b/config/ChangeLog @@ -39,6 +39,11 @@ the support of the STOP ERROR statement +2022-02-07 David Declerck + + * general: add a record-contains-depending-clause option to allow + configuring the support of the DEPENDING clause in RECORD CONTAINS + 2022-02-07 David Declerck * gcos-strict.conf, gcos.conf, gcos.words: added config files for diff --git a/config/acu-strict.conf b/config/acu-strict.conf index 29a464fea..8d53a3bb0 100644 --- a/config/acu-strict.conf +++ b/config/acu-strict.conf @@ -276,6 +276,7 @@ assign-ext-dyn: ok assign-disk-from: unconformable vsam-status: ignore self-call-recursive: skip +record-contains-depending-clause: unconformable align-record: 4 align-opt: no defaultbyte: 32 diff --git a/config/bs2000-strict.conf b/config/bs2000-strict.conf index 0359edc25..045d528ef 100644 --- a/config/bs2000-strict.conf +++ b/config/bs2000-strict.conf @@ -273,6 +273,7 @@ assign-ext-dyn: unconformable assign-disk-from: unconformable vsam-status: ok self-call-recursive: skip +record-contains-depending-clause: unconformable align-record: 8 align-opt: no defaultbyte: ignore diff --git a/config/cobol2002.conf b/config/cobol2002.conf index 8d4acca0b..259541e9a 100644 --- a/config/cobol2002.conf +++ b/config/cobol2002.conf @@ -271,6 +271,7 @@ assign-ext-dyn: unconformable assign-disk-from: unconformable vsam-status: unconformable self-call-recursive: skip +record-contains-depending-clause: unconformable align-record: 0 align-opt: no defaultbyte: ignore diff --git a/config/cobol2014.conf b/config/cobol2014.conf index f86f61f8f..5c192ed37 100644 --- a/config/cobol2014.conf +++ b/config/cobol2014.conf @@ -271,6 +271,7 @@ assign-ext-dyn: unconformable assign-disk-from: unconformable vsam-status: unconformable self-call-recursive: skip +record-contains-depending-clause: unconformable align-record: 0 align-opt: no defaultbyte: ignore diff --git a/config/cobol85.conf b/config/cobol85.conf index 74212b8ae..25a8c5bfc 100644 --- a/config/cobol85.conf +++ b/config/cobol85.conf @@ -271,6 +271,7 @@ assign-ext-dyn: unconformable assign-disk-from: unconformable vsam-status: unconformable self-call-recursive: skip +record-contains-depending-clause: unconformable align-record: 0 align-opt: no defaultbyte: ignore diff --git a/config/default.conf b/config/default.conf index 2c8bd621e..94875679b 100644 --- a/config/default.conf +++ b/config/default.conf @@ -296,6 +296,7 @@ self-call-recursive: skip align-record: 0 align-opt: no defaultbyte: ignore +record-contains-depending-clause: unconformable # use complete word list; synonyms and exceptions are specified below reserved-words: default diff --git a/config/gcos-strict.conf b/config/gcos-strict.conf index 5bd4b440e..b34fb9c2f 100644 --- a/config/gcos-strict.conf +++ b/config/gcos-strict.conf @@ -273,6 +273,7 @@ assign-ext-dyn: unconformable assign-disk-from: unconformable vsam-status: unconformable self-call-recursive: skip +record-contains-depending-clause: obsolete align-record: 0 # TODO: verify align-opt: no # TODO: verify defaultbyte: ignore diff --git a/config/ibm-strict.conf b/config/ibm-strict.conf index de64f7468..42aa87ab3 100644 --- a/config/ibm-strict.conf +++ b/config/ibm-strict.conf @@ -270,6 +270,7 @@ assign-ext-dyn: unconformable assign-disk-from: unconformable vsam-status: ok self-call-recursive: skip +record-contains-depending-clause: unconformable align-record: 8 align-opt: yes defaultbyte: ignore diff --git a/config/mf-strict.conf b/config/mf-strict.conf index cc90c72e2..f962d8cc8 100644 --- a/config/mf-strict.conf +++ b/config/mf-strict.conf @@ -274,6 +274,7 @@ assign-ext-dyn: ok assign-disk-from: ok vsam-status: ok self-call-recursive: skip +record-contains-depending-clause: unconformable align-record: 8 align-opt: yes defaultbyte: 32 diff --git a/config/mvs-strict.conf b/config/mvs-strict.conf index d0f3e35f6..fe3dbee7f 100644 --- a/config/mvs-strict.conf +++ b/config/mvs-strict.conf @@ -270,6 +270,7 @@ assign-ext-dyn: unconformable assign-disk-from: unconformable vsam-status: ok self-call-recursive: skip +record-contains-depending-clause: unconformable align-record: 8 align-opt: yes defaultbyte: ignore diff --git a/config/realia-strict.conf b/config/realia-strict.conf index 25d8572a7..139551441 100644 --- a/config/realia-strict.conf +++ b/config/realia-strict.conf @@ -276,6 +276,7 @@ assign-ext-dyn: unconformable assign-disk-from: unconformable vsam-status: ok self-call-recursive: skip +record-contains-depending-clause: unconformable align-record: 0 align-opt: no defaultbyte: ignore diff --git a/config/rm-strict.conf b/config/rm-strict.conf index f86002adc..653bd40e8 100644 --- a/config/rm-strict.conf +++ b/config/rm-strict.conf @@ -277,6 +277,7 @@ assign-ext-dyn: unconformable assign-disk-from: unconformable vsam-status: unconformable self-call-recursive: skip +record-contains-depending-clause: unconformable align-record: 4 align-opt: no defaultbyte: ignore diff --git a/config/xopen.conf b/config/xopen.conf index 79923d3b9..2c1af5a44 100644 --- a/config/xopen.conf +++ b/config/xopen.conf @@ -284,6 +284,7 @@ align-record: 0 align-opt: no defaultbyte: ignore self-call-recursive: skip +record-contains-depending-clause: obsolete # obsolete in COBOL85 and currently not available as dialect features: # 1: All literal with numeric or numeric edited item diff --git a/tests/testsuite.src/configuration.at b/tests/testsuite.src/configuration.at index 8fcce56a3..c76c21b75 100644 --- a/tests/testsuite.src/configuration.at +++ b/tests/testsuite.src/configuration.at @@ -538,6 +538,7 @@ test.conf: missing definitions: no definition of 'assign-disk-from' no definition of 'vsam-status' no definition of 'self-call-recursive' + no definition of 'record-contains-depending-clause' ]) AT_CLEANUP diff --git a/tests/testsuite.src/syn_file.at b/tests/testsuite.src/syn_file.at index 252f26060..c1b24c960 100644 --- a/tests/testsuite.src/syn_file.at +++ b/tests/testsuite.src/syn_file.at @@ -862,6 +862,27 @@ AT_DATA([prog.cob], [ STOP RUN. ]) +AT_DATA([prog2.cob], [ + IDENTIFICATION DIVISION. + PROGRAM-ID. prog. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT TEST-FILE ASSIGN TO 'FILE-TEST' + ORGANIZATION IS SEQUENTIAL. + DATA DIVISION. + FILE SECTION. + FD TEST-FILE + RECORD CONTAINS 12 TO 125 CHARACTERS + DEPENDING ON RECORDSIZE. + 01 TEST-REC. + 05 FILLER PIC X(40). + PROCEDURE DIVISION. + OPEN INPUT TEST-FILE. + CLOSE TEST-FILE. + STOP RUN. +]) + # FIXME: the check misses "prog.cob:40: error: RECORD DEPENDING item must be unsigned numeric" AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], [prog.cob:20: error: 'RECORDSIZE' is not defined @@ -875,6 +896,13 @@ prog.cob:26: error: RECORD DEPENDING must reference a data-item prog.cob:34: warning: RECORD DEPENDING item 'RECORDSIZE3' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION prog.cob:40: warning: RECORD DEPENDING item 'RECORDSIZE4' should be defined in WORKING-STORAGE, LOCAL-STORAGE or LINKAGE SECTION ]) +AT_CHECK([$COMPILE_ONLY -frecord-contains-depending-clause=error prog2.cob], [1], [], +[prog2.cob:13: error: RECORD CONTAINS DEPENDING used +prog2.cob:13: error: 'RECORDSIZE' is not defined +]) +AT_CHECK([$COMPILE_ONLY -frecord-contains-depending-clause=ok prog2.cob], [1], [], +[prog2.cob:13: error: 'RECORDSIZE' is not defined +]) AT_CLEANUP