diff --git a/cobc/ChangeLog b/cobc/ChangeLog index eea759527..fc5fe1b5f 100644 --- a/cobc/ChangeLog +++ b/cobc/ChangeLog @@ -549,6 +549,15 @@ * cobc.c: removed unused aflag_set, renamed gflag_set to source_debugging * cobc.c (process) [__OS400__]: simplified source-debugging handling +2021-10-19 Simon Sobisch + + * config.def (larger-redefines): changed to support option from boolean + larger-redefines-ok + * warning.def (cb_warn_larger_01_redefines): new warning for possibly + problematic but allowed level 01 non-external REDEFINE + * field.c (compute_size): cater for cb_larger_redefines and + cb_warn_larger_01_redefines + 2021-10-18 Simon Sobisch * field.c (cb_build_full_field_reference): fix bug #776 diff --git a/cobc/config.def b/cobc/config.def index 96a32d4c8..760fe6b1d 100644 --- a/cobc/config.def +++ b/cobc/config.def @@ -120,9 +120,6 @@ CB_CONFIG_BOOLEAN (cb_odoslide, "odoslide", CB_CONFIG_BOOLEAN (cb_indirect_redefines, "indirect-redefines", _("allow REDEFINES to other than last equal level number")) -CB_CONFIG_BOOLEAN (cb_larger_redefines_ok, "larger-redefines-ok", /* TO-DO: change to CB_CONFIG_SUPPORT */ - _("allow larger REDEFINES items")) - CB_CONFIG_BOOLEAN (cb_relaxed_syntax_checks, "relax-syntax-checks", _("allow certain syntax variations (e.g. REDEFINES position)")) @@ -331,6 +328,10 @@ CB_CONFIG_SUPPORT (cb_accept_display_extensions, "accept-display-extensions", CB_CONFIG_SUPPORT (cb_renames_uncommon_levels, "renames-uncommon-levels", _("RENAMES of 01-, 66- and 77-level items")) +/* larger REDEFINES items other than 01 non-external */ +CB_CONFIG_SUPPORT (cb_larger_redefines, "larger-redefines", + _("allow larger REDEFINES items")) + CB_CONFIG_SUPPORT (cb_symbolic_constant, "symbolic-constant", _("constants defined in SPECIAL-NAMES")) diff --git a/cobc/field.c b/cobc/field.c index ac2949776..279f41b1a 100644 --- a/cobc/field.c +++ b/cobc/field.c @@ -2711,7 +2711,7 @@ compute_size (struct cb_field *f) && !(f->report_flag & COB_REPORT_LINE_PLUS) && f->parent && f->parent->children != f) { - for(c = f->parent->children; c && c != f; c = c->sister) { + for (c = f->parent->children; c && c != f; c = c->sister) { if ((c->report_flag & COB_REPORT_LINE) && !(c->report_flag & COB_REPORT_LINE_PLUS) && c->report_line == f->report_line) { @@ -2742,10 +2742,7 @@ compute_size (struct cb_field *f) if (c->level != 66 && c->size * c->occurs_max > c->redefines->size * c->redefines->occurs_max) { - if (cb_larger_redefines_ok) { - cb_warning_x (cb_warn_additional, CB_TREE (c), - _("size of '%s' larger than size of '%s'"), - c->name, c->redefines->name); + if (cb_verify_x (CB_TREE (c), cb_larger_redefines, _("larger REDEFINES"))) { maxsz = c->redefines->size * c->redefines->occurs_max; for (c0 = c->redefines->sister; c0 != c; c0 = c0->sister) { if (c0->size * c0->occurs_max > maxsz) { @@ -2755,10 +2752,11 @@ compute_size (struct cb_field *f) if (c->size * c->occurs_max > maxsz) { size_check += ((cob_s64_t)c->size * c->occurs_max) - maxsz; } - } else { - cb_error_x (CB_TREE (c), - _("size of '%s' larger than size of '%s'"), - c->name, c->redefines->name); + } + if (cb_larger_redefines >= CB_WARNING) { + cb_note_x (cb_warn_dialect, CB_TREE (c), + _("size of '%s' larger than size of '%s'"), + c->name, c->redefines->name); } } } else { @@ -3063,18 +3061,22 @@ compute_size (struct cb_field *f) } } - /* The size of redefining field should not be larger than - the size of redefined field unless the redefined field - is level 01 and non-external */ - if (f->redefines - && f->redefines->flag_external + /* COBOL standard: The size of redefining field should not be larger + than the size of redefined field unless the redefined field is + level 01 and non-external */ + if (f->level == 1 && f->redefines && (f->size * f->occurs_max > f->redefines->size * f->redefines->occurs_max)) { - if (cb_larger_redefines_ok) { - cb_warning_x (cb_warn_additional, CB_TREE (f), - _("size of '%s' larger than size of '%s'"), - f->name, f->redefines->name); + /* note: when allowed the redefined field is NOT size-adjusted here */ + if (f->redefines->flag_external) { + if (!cb_verify_x (CB_TREE (f), cb_larger_redefines, _("larger REDEFINES")) + || cb_larger_redefines == CB_WARNING) { + cb_note_x (cb_warn_dialect, CB_TREE (f), + _("size of '%s' larger than size of '%s'"), + f->name, f->redefines->name); + } } else { - cb_error_x (CB_TREE (f), _("size of '%s' larger than size of '%s'"), + cb_warning_x (cb_warn_larger_01_redefines, CB_TREE (f), + _("size of '%s' larger than size of '%s'"), f->name, f->redefines->name); } } diff --git a/cobc/warning.def b/cobc/warning.def index 113870963..2e2fe2866 100644 --- a/cobc/warning.def +++ b/cobc/warning.def @@ -96,6 +96,9 @@ CB_WARNDEF (cb_warn_constant_expr, "constant-expression", CB_WARNDEF (cb_warn_constant_numlit_expr, "constant-numlit-expression", _(" -Wconstant-numlit-expression\twarn about numeric expressions that always resolve to true/false")) +CB_WARNDEF (cb_warn_larger_01_redefines, "larger-01-redefines", + _(" -Wlarger-01-redefines warn about larger redefines allowed by COBOL standards")) + CB_NOWARNDEF (cb_warn_column_overflow, "column-overflow", _(" -Wcolumn-overflow warn about text after program-text area, FIXED format")) diff --git a/config/ChangeLog b/config/ChangeLog index abe70f397..8a33a54da 100644 --- a/config/ChangeLog +++ b/config/ChangeLog @@ -39,6 +39,11 @@ * Added 'record-sequential-advancing' initial value +2021-10-19 Simon Sobisch + + * general: changed larger-redefines-ok (boolean) to larger-redefines, + now a support option allowing "warning only" + 2021-10-01 Ron Norman * runtime.cfg: Removed the COB_MF_LS_xxx options and replaced COB_MF_FILES @@ -104,19 +109,6 @@ * fileio: added option file_log for ISAM files -||||||| .merge-left.r4286 -======= -2021-07-29 Simon Sobisch - - * general: added self-call-recursive, only active (as "warning") for - default.conf, in all other cases no change to RECURSIVE attribute - is happening any more, fixing bug 686 - -2021-02-03 Simon Sobisch - - * acu-strict.conf: fix settings indirect-redefines + assign-variable - ->>>>>>> .merge-right.r4287 2020-11-08 Simon Sobisch * general: added ref-mod-zero-length, only active for default.conf diff --git a/config/acu-strict.conf b/config/acu-strict.conf index 09c195ada..1a4a1cd6b 100644 --- a/config/acu-strict.conf +++ b/config/acu-strict.conf @@ -95,8 +95,8 @@ binary-truncate: yes # Value: 'native', 'big-endian' binary-byteorder: big-endian -# Allow larger REDEFINES items -larger-redefines-ok: no # not verified yet +# Allow larger REDEFINES items other than 01 non-external +larger-redefines: ok # not verified yet # Allow certain syntax variations (eg. REDEFINES position) relax-syntax-checks: yes diff --git a/config/bs2000-strict.conf b/config/bs2000-strict.conf index 2e1572d37..8ac9d4719 100644 --- a/config/bs2000-strict.conf +++ b/config/bs2000-strict.conf @@ -96,8 +96,8 @@ binary-truncate: yes # TO-DO: For BINARY, *not* for COMP or COMP-5! # Value: 'native', 'big-endian' binary-byteorder: big-endian -# Allow larger REDEFINES items -larger-redefines-ok: no # TO-DO: Except for level 01 items. +# Allow larger REDEFINES items other than 01 non-external +larger-redefines: error # Allow certain syntax variations (eg. REDEFINES position) relax-syntax-checks: no diff --git a/config/cobol2002.conf b/config/cobol2002.conf index 7f2c7b057..7e0403bf1 100644 --- a/config/cobol2002.conf +++ b/config/cobol2002.conf @@ -95,8 +95,8 @@ binary-truncate: yes # Value: 'native', 'big-endian' binary-byteorder: big-endian -# Allow larger REDEFINES items -larger-redefines-ok: no +# Allow larger REDEFINES items other than 01 non-external +larger-redefines: error # Allow certain syntax variations (eg. REDEFINES position) relax-syntax-checks: no diff --git a/config/cobol2014.conf b/config/cobol2014.conf index 901d24e7d..2779f2759 100644 --- a/config/cobol2014.conf +++ b/config/cobol2014.conf @@ -95,8 +95,8 @@ binary-truncate: yes # Value: 'native', 'big-endian' binary-byteorder: big-endian -# Allow larger REDEFINES items -larger-redefines-ok: no +# Allow larger REDEFINES items other than 01 non-external +larger-redefines: error # Allow certain syntax variations (eg. REDEFINES position) relax-syntax-checks: no diff --git a/config/cobol85.conf b/config/cobol85.conf index 8b369bcaf..c02e9fff1 100644 --- a/config/cobol85.conf +++ b/config/cobol85.conf @@ -95,8 +95,8 @@ binary-truncate: yes # Value: 'native', 'big-endian' binary-byteorder: big-endian -# Allow larger REDEFINES items -larger-redefines-ok: no +# Allow larger REDEFINES items other than 01 non-external +larger-redefines: error # Allow certain syntax variations (eg. REDEFINES position) relax-syntax-checks: no diff --git a/config/default.conf b/config/default.conf index de83feea3..cecc93c15 100644 --- a/config/default.conf +++ b/config/default.conf @@ -114,8 +114,8 @@ binary-truncate: yes # Value: 'native', 'big-endian' binary-byteorder: big-endian -# Allow larger REDEFINES items -larger-redefines-ok: no +# Allow larger REDEFINES items other than 01 non-external +larger-redefines: error # Allow certain syntax variations (eg. REDEFINES position) relax-syntax-checks: no diff --git a/config/gcos-strict.conf b/config/gcos-strict.conf index 550bc717c..9da8b3b44 100644 --- a/config/gcos-strict.conf +++ b/config/gcos-strict.conf @@ -94,8 +94,8 @@ binary-truncate: yes # Value: 'native', 'big-endian' binary-byteorder: big-endian -# Allow larger REDEFINES items -larger-redefines-ok: no +# Allow larger REDEFINES items other than 01 non-external +larger-redefines: error # Allow certain syntax variations (eg. REDEFINES position) relax-syntax-checks: yes diff --git a/config/ibm-strict.conf b/config/ibm-strict.conf index 5b55a72d6..da8d4379d 100644 --- a/config/ibm-strict.conf +++ b/config/ibm-strict.conf @@ -94,8 +94,8 @@ binary-truncate: no # Value: 'native', 'big-endian' binary-byteorder: big-endian -# Allow larger REDEFINES items -larger-redefines-ok: no +# Allow larger REDEFINES items other than 01 non-external +larger-redefines: error # Allow certain syntax variations (eg. REDEFINES position) relax-syntax-checks: no diff --git a/config/lax.conf-inc b/config/lax.conf-inc index fe55f402a..1c34a1c9e 100644 --- a/config/lax.conf-inc +++ b/config/lax.conf-inc @@ -45,8 +45,8 @@ complex-odo: yes # Allow REDEFINES to other than last equal level number indirect-redefines: yes -# Allow larger REDEFINES items -larger-redefines-ok: yes +# Allow larger REDEFINES items other than 01 non-external +larger-redefines: +warning # Allow certain syntax variations (eg. REDEFINES position) relax-syntax-checks: yes diff --git a/config/mf-strict.conf b/config/mf-strict.conf index 218aeed07..3a91afa0a 100644 --- a/config/mf-strict.conf +++ b/config/mf-strict.conf @@ -97,8 +97,8 @@ binary-truncate: no # Value: 'native', 'big-endian' binary-byteorder: big-endian -# Allow larger REDEFINES items -larger-redefines-ok: yes +# Allow larger REDEFINES items other than 01 non-external +larger-redefines: ok # Allow certain syntax variations (eg. REDEFINES position) relax-syntax-checks: yes diff --git a/config/mvs-strict.conf b/config/mvs-strict.conf index b4c9666a6..f090c69c4 100644 --- a/config/mvs-strict.conf +++ b/config/mvs-strict.conf @@ -94,8 +94,8 @@ binary-truncate: no # Value: 'native', 'big-endian' binary-byteorder: big-endian -# Allow larger REDEFINES items -larger-redefines-ok: no +# Allow larger REDEFINES items other than 01 non-external +larger-redefines: error # Allow certain syntax variations (eg. REDEFINES position) relax-syntax-checks: no diff --git a/config/realia-strict.conf b/config/realia-strict.conf index f459516e6..f9cf2a67e 100644 --- a/config/realia-strict.conf +++ b/config/realia-strict.conf @@ -35,8 +35,8 @@ numeric-literal-length: 18 # to check pic-length: 100 # to check occurs-max-length-without-subscript: yes # to check -# Value: 'mf', 'ibm' -# +# Default assign type +# Value: 'dynamic', 'external' assign-clause: dynamic # to check # If yes, file names are resolved at run time using @@ -95,8 +95,8 @@ binary-truncate: no # to check # Value: 'native', 'big-endian' binary-byteorder: big-endian # to check -# Allow larger REDEFINES items -larger-redefines-ok: no # not verified yet +# Allow larger REDEFINES items other than 01 non-external +larger-redefines: error # not verified yet # Allow certain syntax variations (eg. REDEFINES position) relax-syntax-checks: no # to check diff --git a/config/rm-strict.conf b/config/rm-strict.conf index 65fcde1ad..3156b34de 100644 --- a/config/rm-strict.conf +++ b/config/rm-strict.conf @@ -100,8 +100,8 @@ binary-truncate: yes # Value: 'native', 'big-endian' binary-byteorder: big-endian -# Allow larger REDEFINES items -larger-redefines-ok: yes # TO-DO: But only for 01 items (see p. 134) +# Allow larger REDEFINES items other than 01 non-external +larger-redefines: ok # (see p. 134) # Allow certain syntax variations (eg. REDEFINES position) relax-syntax-checks: yes # TO-DO: For REDEFINES position, at least. diff --git a/config/xopen.conf b/config/xopen.conf index 9411f0b51..0181ac52d 100644 --- a/config/xopen.conf +++ b/config/xopen.conf @@ -99,8 +99,8 @@ binary-truncate: yes # Value: 'native', 'big-endian' binary-byteorder: big-endian -# Allow larger REDEFINES items -larger-redefines-ok: no +# Allow larger REDEFINES items other than 01 non-external +larger-redefines: error # Allow certain syntax variations (eg. REDEFINES position) relax-syntax-checks: no diff --git a/tests/testsuite.src/configuration.at b/tests/testsuite.src/configuration.at index c6a67c697..f1981ddf8 100644 --- a/tests/testsuite.src/configuration.at +++ b/tests/testsuite.src/configuration.at @@ -435,7 +435,6 @@ test.conf: missing definitions: no definition of 'complex-odo' no definition of 'odoslide' no definition of 'indirect-redefines' - no definition of 'larger-redefines-ok' no definition of 'relax-syntax-checks' no definition of 'ref-mod-zero-length' no definition of 'relax-level-hierarchy' @@ -503,6 +502,7 @@ test.conf: missing definitions: no definition of 'not-exception-before-exception' no definition of 'accept-display-extensions' no definition of 'renames-uncommon-levels' + no definition of 'larger-redefines' no definition of 'symbolic-constant' no definition of 'constant-78' no definition of 'constant-01' diff --git a/tests/testsuite.src/run_extensions.at b/tests/testsuite.src/run_extensions.at index 93eb1753a..874eef4ba 100644 --- a/tests/testsuite.src/run_extensions.at +++ b/tests/testsuite.src/run_extensions.at @@ -3588,46 +3588,27 @@ AT_DATA([prog.cob], [ PROCEDURE DIVISION. MOVE LENGTH OF XMAIN TO Z. IF Z NOT = 8 - DISPLAY "Test 1 " Z - END-DISPLAY - END-IF. + DISPLAY "Test 1 " Z. MOVE LENGTH OF XMAINRED TO Z. IF Z NOT = 9 - DISPLAY "Test 2 " Z - END-DISPLAY - END-IF. + DISPLAY "Test 2 " Z. MOVE LENGTH OF XMAIN03 TO Z. IF Z NOT = 5 - DISPLAY "Test 3 " Z - END-DISPLAY - END-IF. + DISPLAY "Test 3 " Z. MOVE LENGTH OF XMAIN0501 TO Z. IF Z NOT = 4 - DISPLAY "Test 4 " Z - END-DISPLAY - END-IF. + DISPLAY "Test 4 " Z. MOVE LENGTH OF XMAIN0502 TO Z. IF Z NOT = 5 - DISPLAY "Test 5 " Z - END-DISPLAY - END-IF. + DISPLAY "Test 5 " Z. IF LENGTH OF USE-FIRST NOT = 33211 - DISPLAY LENGTH OF USE-FIRST END-DISPLAY - END-IF. + DISPLAY LENGTH OF USE-FIRST END-DISPLAY. IF LENGTH OF USE-SECOND NOT = 27241 - DISPLAY LENGTH OF USE-SECOND END-DISPLAY - END-IF. + DISPLAY LENGTH OF USE-SECOND END-DISPLAY. STOP RUN. ]) -AT_CHECK([$COMPILE -flarger-redefines-ok -Wno-constant-expression prog.cob], [0], [], -[prog.cob:12: warning: size of 'XMAIN0502' larger than size of 'XMAIN0501' -prog.cob:21: warning: size of 'FIRST-VARIANT-A' larger than size of 'FIRST-DATA' -prog.cob:23: warning: size of 'FIRST-VARIANT-B' larger than size of 'FIRST-DATA' -prog.cob:25: warning: size of 'FIRST-VARIANT-C' larger than size of 'FIRST-DATA' -prog.cob:31: warning: size of 'SECOND-VARIANT-A' larger than size of 'SECOND-HEADER' -prog.cob:33: warning: size of 'SECOND-VARIANT-B' larger than size of 'SECOND-HEADER' -]) +AT_CHECK([$COMPILE -flarger-redefines=ok -w prog.cob], [0], [], []) AT_CHECK([$COBCRUN_DIRECT ./prog], [0], [], []) AT_CLEANUP diff --git a/tests/testsuite.src/syn_redefines.at b/tests/testsuite.src/syn_redefines.at index a9f04f21a..337133066 100644 --- a/tests/testsuite.src/syn_redefines.at +++ b/tests/testsuite.src/syn_redefines.at @@ -1,4 +1,4 @@ -## Copyright (C) 2003-2012, 2016-2017, 2020, 2022 Free Software Foundation, Inc. +## Copyright (C) 2003-2012, 2016-2017, 2020-2022 Free Software Foundation, Inc. ## Written by Keisuke Nishida, Roger While, Simon Sobisch ## ## This file is part of GnuCOBOL. @@ -316,19 +316,37 @@ AT_DATA([prog.cob], [ 01 G2. 02 X PIC X. 02 A REDEFINES X PIC 9 OCCURS 2. - 01 WRK-X PIC X. - 01 WRK-X-REDEF REDEFINES WRK-X PIC 99. 01 EXT-X PIC X EXTERNAL. 01 EXT-X-REDEF REDEFINES EXT-X PIC 99. + *> other than the above EXTERNAL one, this is explicit "fine" + *> by COBOL standard (01, non-external) - only warn upon explicit request + 01 WRK-X2 PIC X. + 01 FILLER REDEFINES WRK-X2 PIC X(4). + 88 WRK-X2-BADDY VALUE "99". PROCEDURE DIVISION. STOP RUN. ]) -AT_CHECK([$COMPILE_ONLY prog.cob], [1], [], -[prog.cob:8: error: size of 'A' larger than size of 'X' -prog.cob:11: error: size of 'A' larger than size of 'X' -prog.cob:15: error: size of 'EXT-X-REDEF' larger than size of 'EXT-X' -]) +AT_CHECK([$COBC -Wextra prog.cob], [1], [], +[[prog.cob:8: error: larger REDEFINES used +prog.cob:8: note: size of 'A' larger than size of 'X' [-Wdialect] +prog.cob:11: error: larger REDEFINES used +prog.cob:11: note: size of 'A' larger than size of 'X' [-Wdialect] +prog.cob:13: error: larger REDEFINES used +prog.cob:13: note: size of 'EXT-X-REDEF' larger than size of 'EXT-X' [-Wdialect] +prog.cob:17: warning: size of 'FILLER 1' larger than size of 'WRK-X2' [-Wlarger-01-redefines] +]]) + +# of course, other dialects ignore the rules... +AT_CHECK([$COBC -std=mf prog.cob], [0], [], []) +AT_CHECK([$COBC -flarger-redefines=warning prog.cob], [0], [], +[[prog.cob:8: warning: larger REDEFINES used [-Wdialect] +prog.cob:8: note: size of 'A' larger than size of 'X' [-Wdialect] +prog.cob:11: warning: larger REDEFINES used [-Wdialect] +prog.cob:11: note: size of 'A' larger than size of 'X' [-Wdialect] +prog.cob:13: warning: larger REDEFINES used [-Wdialect] +prog.cob:13: note: size of 'EXT-X-REDEF' larger than size of 'EXT-X' [-Wdialect] +]]) AT_CLEANUP