https://gcc.gnu.org/g:687457ca8af0a5ee48c8bc52b0da4aa5c5ebb9bd
commit r17-4726-g687457ca8af0a5ee48c8bc52b0da4aa5c5ebb9bd Author: James K. Lowden <[email protected]> Date: Mon Sep 28 17:47:18 2026 -0400 cobol: Add Wvalue-clause to permit superfluous trailing blanks in VALUE clause. ISO requires VALUE contain no more data than fit in the item's defined space. Trailing blanks that do not fit may be deemed harmless. gcc/cobol/ChangeLog: * cbldiag.h (current_call_convention): Whitespace. (struct cbl_loc_t): Same. (enum cbl_diag_id_t): Define MfValueClause, and sort. * cobol1.cc (cobol_warning_suppress): Whitespace. (cobol_langhook_handle_option): Handle new option. * gcobol.1: Document new option. * lang-specs.h: Accept new option. * lang.opt: Define new option. * messages.cc: Add new option to dialects. * picture.cc: Remove structures that no longer support picture validation. * symbols.cc (cbl_field_t::encode): Use new option. Diff: --- gcc/cobol/cbldiag.h | 43 ++++++++++++------------ gcc/cobol/cobol1.cc | 8 +++-- gcc/cobol/gcobol.1 | 3 ++ gcc/cobol/lang-specs.h | 2 +- gcc/cobol/lang.opt | 5 +++ gcc/cobol/messages.cc | 1 + gcc/cobol/picture.cc | 91 ++------------------------------------------------ gcc/cobol/symbols.cc | 29 ++++++++++++---- 8 files changed, 64 insertions(+), 118 deletions(-) diff --git a/gcc/cobol/cbldiag.h b/gcc/cobol/cbldiag.h index 8a678aa47baf..d0b28574819d 100644 --- a/gcc/cobol/cbldiag.h +++ b/gcc/cobol/cbldiag.h @@ -52,7 +52,7 @@ const char * cobol_filename(); #endif /* - * Enumerations do not depend on anything else. + * Enumerations do not depend on anything else. */ enum cbl_gcobol_feature_t { @@ -74,7 +74,7 @@ cbl_call_convention_t current_call_convention(); /* - * CDF state does not require types that would be defined in another file. + * CDF state does not require types that would be defined in another file. */ void cdf_push(); void cdf_push_call_convention(); @@ -108,7 +108,7 @@ struct cbl_loc_t : public cbl_loc_base_t { cbl_loc_t() = default; // cppcheck-suppress uninitDerivedMemberVar cbl_loc_t( int first_line, int first_column, - int last_line, int last_column ) + int last_line, int last_column ) : cbl_loc_base_t { first_line , first_column, last_line, last_column @@ -116,7 +116,7 @@ struct cbl_loc_t : public cbl_loc_base_t { {} // cppcheck-suppress noExplicitConstructor cbl_loc_t( const cbl_loc_base_t& base ) - : cbl_loc_base_t(base) + : cbl_loc_base_t(base) {} explicit cbl_loc_t( int line ) @@ -149,7 +149,7 @@ struct cbl_loc_t : public cbl_loc_base_t { } // Represent a multi-line location as the first line, so "included from" - // reflects where the COPY statement appears, not where it ends. + // reflects where the COPY statement appears, not where it ends. cbl_loc_t as_first_line() const { cbl_loc_t loc(*this); loc.last_line = first_line; @@ -171,10 +171,10 @@ static_assert(std::is_trivially_copyable<cbl_loc_t>::value, const cbl_loc_t& cobol_location(); enum cbl_diag_id_t : uint64_t { - CdfNotFoundW, + CdfNotFoundW, CdfParameterW, - - EcUnknownW, + + EcUnknownW, LexIncludeE, LexIncludeOkN, @@ -190,50 +190,51 @@ enum cbl_diag_id_t : uint64_t { IbmContentExpr, IbmEjectE, IbmEqualAssignE, - IbmLengthOf, + IbmLengthOf, IbmProcedurePointer, IbmSectionNegE, IbmSectionRangeE, IbmSectionSegmentW, IbmStopNumber, - IbmVolatileE, + IbmVolatileE, IbmVolatileW, // dialect warning for ignored syntax IsoAssignFile, IsoRedefinesGrow, IsoResume, + MfAnyLength, MfAssignExternal, MfBinaryLongLong, MfCallGiving, MfCallLiteral, - MfDisplayScreen, - MfCdfDollar, + MfCdfDollar, MfComp6, MfCompX, + MfDisplayScreen, MfHexNumeric, - MfLevel_1_Occurs, MfLevel78, - MfAnyLength, - MfMoveIndex, - MfMovePointer, + MfLevel_1_Occurs, + MfMoveIndex, + MfMovePointer, MfRedefinesFirst, MfRedefinesTable, MfReturningNum, MfSetNumeric, MfTrailing, MfUsageTypename, - + MfValueClause, + Par78CdfDefinedW, ParDynamicCall, - ParIconvE, + ParIconvE, ParInfoI, ParLangInfoW, - ParLiteral2W, + ParLiteral2W, ParLocaleW, ParNoCorrespondingW, - ParNumstrW, - ParUnresolvedProcE, + ParNumstrW, + ParUnresolvedProcE, SynApplyCommit, SynFileCodeSet, diff --git a/gcc/cobol/cobol1.cc b/gcc/cobol/cobol1.cc index 354c568347be..46bdd129e9f3 100644 --- a/gcc/cobol/cobol1.cc +++ b/gcc/cobol/cobol1.cc @@ -441,7 +441,7 @@ void cobol_warning_suppress( cbl_dialect_t dialect ); /* * If an unrecognized/unimplmemented EC is specified, emit a warning. If the * warning is turned off, keep quiet. - * + * * Tue Aug 25 09:41:37 2026: For reasons unclear gcobol duplicates some * command-line options to cobol1. In any case if the user specifies the ssme * EC twice, or uses it more than once in the body of the code, he doesn't @@ -560,7 +560,7 @@ cobol_langhook_handle_option (size_t scode, case OPT_dialect: // gcc disallows 0 as an enumerated value, so we used 0x10 for iso. - if( cobol_dialect == 0x100 ) cobol_dialect = 0; + if( cobol_dialect == 0x100 ) cobol_dialect = 0; cobol_dialect_set(cbl_dialect_t(cobol_dialect)); cobol_warning_suppress(cbl_dialect_t(cobol_dialect)); return true; @@ -644,6 +644,10 @@ cobol_langhook_handle_option (size_t scode, cobol_warning(MfHexNumeric, hex_numeric, warning_as_error); return true; + case OPT_Wvalue_clause: + cobol_warning(MfValueClause, value_clause, warning_as_error); + return true; + case OPT_Winspect_trailing: cobol_warning(MfTrailing, inspect_trailing, warning_as_error); return true; diff --git a/gcc/cobol/gcobol.1 b/gcc/cobol/gcobol.1 index 81dd64e76cff..185b00c6641a 100644 --- a/gcc/cobol/gcobol.1 +++ b/gcc/cobol/gcobol.1 @@ -97,6 +97,7 @@ .Op Fl Wno-redefines-grow .Op Fl Wno-set-locale-to .Op Fl Wno-set-to-locale +.Op Fl Wno-value-clause .Ar filename Op ... . .Sh DESCRIPTION @@ -719,6 +720,8 @@ Warn if SECTION segments are used. Warn if SET LOCALE ... TO is used. .It Fl Wno-set-to-locale Warn if SET ... TO LOCALE is used. +.It Fl Wno-value-clause +Warn if VALUE has too many trailing blanks. . `.\" convert errors to warnings Warn if a line directive is malformed (instead of error). diff --git a/gcc/cobol/lang-specs.h b/gcc/cobol/lang-specs.h index ea9a144c2a8b..43198041a788 100644 --- a/gcc/cobol/lang-specs.h +++ b/gcc/cobol/lang-specs.h @@ -78,6 +78,7 @@ "%{Wiconv-error} %{Wno-iconv-error} " "%{Winclude-file-found} %{Wno-include-file-found} " "%{Winclude-file-not-found} %{Wno-include-file-not-found} " + "%{Wvalue-clause} %{Wno-value-clause} " "%{Winspect-trailing} %{Wno-inspect-trailing} " "%{Wlength-of} %{Wno-length-of} " "%{Wlevel-1-occurs} %{Wno-level-1-occurs} " @@ -110,4 +111,3 @@ "%{nomain} " "%{!fsyntax-only:%(invoke_as)} " , 0, 0, 0}, - diff --git a/gcc/cobol/lang.opt b/gcc/cobol/lang.opt index 32553775c0e7..413796daba26 100644 --- a/gcc/cobol/lang.opt +++ b/gcc/cobol/lang.opt @@ -154,6 +154,11 @@ Wdisplay-screen Cobol Warning Var(display_screen, 1) Init(1) Warn if DISPLAY WITH screen options is used. +; MfInitialValue +Wvalue-clause +Cobol Warning Var(value_clause, 1) Init(1) +Warn if VALUE has too many trailing blanks. + ; MfTrailing Winspect-trailing Cobol Warning Var(inspect_trailing, 1) Init(1) diff --git a/gcc/cobol/messages.cc b/gcc/cobol/messages.cc index 468e6754293f..dd3c4f8862fb 100644 --- a/gcc/cobol/messages.cc +++ b/gcc/cobol/messages.cc @@ -165,6 +165,7 @@ std::set<cbl_diag_t> cbl_diagnostics { { MfSetNumeric, "-Wset-numeric", diagnostics::kind::error, dialect_mf_gnu }, { MfTrailing, "-Winspect-trailing", diagnostics::kind::error, dialect_mf_gnu }, { MfUsageTypename, "-Wusage-typename", diagnostics::kind::error, dialect_mf_gnu }, + { MfValueClause, "-Wvalue-clause", diagnostics::kind::error, dialect_mf_gnu }, { LexIncludeE, "-Winclude-file-not-found", diagnostics::kind::error }, { LexIncludeOkN, "-Winclude-file-found", diagnostics::kind::note }, diff --git a/gcc/cobol/picture.cc b/gcc/cobol/picture.cc index c78ca3b923a0..28489522fe88 100644 --- a/gcc/cobol/picture.cc +++ b/gcc/cobol/picture.cc @@ -115,81 +115,6 @@ namespace picture_validation { return "???"; } - struct follow_key_t { - state_t state; - char ch; - bool operator< (const follow_key_t& that ) const { - if( state == that.state ) { - return ch < that.ch; - } - return state < that.state; - } - }; - - /* - * The followers table enforces the merest of syntax: in a picture string, - * what character may follow another? It reproduces ISO table 10 in - * programmatic form. - * - * "The symbol '+' that appears in a column and in a row by itself, - * represents its use in the exponent part of character-string-1 for a - * floating-point numeric-edited item. - * - * The symbols '+' and '-' when used as a non-floating insertion symbol - * appear in two columns and two rows. The leftmost column and the uppermost - * row for these symbols represent their use as the first symbol in - * character-string-1. The rightmost column and the lowermost row for these - * symbols represent its use as the last or penultimate symbol in - * character-string-1. - * - * The symbol '+' that appears in a column and in a row by itself, - * represents its use in the exponent." - */ - -#define dot '.' -#define com ',' - typedef std::array<char, 64> follow_t; - static const std::map <follow_key_t, follow_t> followers { - /* all */ { { none_e, '\0' }, {"" "*+,-./$019ABENPSVXZCD"} }, - /* 1 */ { { antedec_e, '1' }, {"(" "1"} }, - /* B0/ */ { { antedec_e, 'B' }, {"" "B0/,.Z*+-$9AXVPNECD"} }, - /* B0/ */ { { postdec_e, 'B' }, {"" "B0/,.Z*+-$9AXVPNECD"} }, // ante & post - /* B0/ */ { { antedec_e, '0' }, {"" "B0/,.Z*+-$9AXVPNECD"} }, - /* B0/ */ { { postdec_e, '0' }, {"" "B0/,.Z*+-$9AXVPNECD"} }, // ante & post - /* B0/ */ { { antedec_e, '/' }, {"" "B0/,.Z*+-$9AXVPNECD"} }, - /* B0/ */ { { postdec_e, '/' }, {"" "B0/,.Z*+-$9AXVPNECD"} }, // ante & post - /* + */ { { exponent_e, '+' }, {"" "9"} }, - /* , */ { { antedec_e, com }, {"" "B0/,.Z*+-$9VPE"} }, - /* . */ { { antedec_e, dot }, {"" "B0/,Z*+-$9E"} }, - /* . */ { { postdec_e, dot }, {"" "B0/,Z*+-$9E"} }, // ante & post - /* +- */ { { antedec_e, '+' }, {"" "B0/,.+-Z*$9VPE"} }, - /* +- */ { { antedec_e, '-' }, {"" "B0/,.+-Z*$9VPE"} }, - /* Z* */ { { antedec_e, 'Z' }, {"(" "B0/,.+-Z*$9VP"} }, - /* Z* */ { { postdec_e, 'Z' }, {"" "B0/,+-Z*"} }, - /* Z* */ { { antedec_e, '*' }, {"" "B0/,.+Z*$9VPCD"} }, - /* Z* */ { { postdec_e, '*' }, {"" "B0/,+Z*CD"} }, - /* + */ { { antedec_e, '+' }, {"" "B0/,.+-$9VP"} }, - /* + */ { { postdec_e, '+' }, {"" "B0/,+-"} }, - /* cs */ { { antedec_e, '$' }, {"" "B0/Z*,.+$9VP"} }, - /* cs */ { { postdec_e, '$' }, {"" "B0/Z*,+"} }, - /* 9 */ { { antedec_e, '9' }, {"(" "B0/,.+-$9AXVPECD"} }, - /* 9 */ { { postdec_e, '9' }, {"(" "B0/,.+-$9AXVPECD"} }, // ante & post - /* AX */ { { antedec_e, 'A' }, {"(" "B0/$9AX"} }, - /* AX */ { { antedec_e, 'X' }, {"(" "B0/$9AX"} }, - /* S */ { { antedec_e, 'S' }, {"" "9VP"} }, - /* V */ { { postdec_e, 'V' }, {"" "B0/,+Z*+-$9P"} }, - /* P */ { { antedec_e, 'P' }, {"(" "+V9P"} }, - /* P */ { { postdec_e, 'P' }, {"(" "B0/,+Z*$P"} }, - /* 1 */ { { antedec_e, '1' }, {"" "1"} }, - /* N */ { { antedec_e, 'N' }, {"(" "B0/N"} }, - /* E */ { { antedec_e, 'E' }, {"" "+9"} }, - - /* CR/DB */ { { antedec_e, 'C' }, {"" "R"} }, - /* CR/DB */ { { antedec_e, 'D' }, {"" "B"} }, - /* CR/DB */ { { postdec_e, 'C' }, {"" "R"} }, - /* CR/DB */ { { postdec_e, 'D' }, {"" "B"} }, - }; - //////////////////////////////////////////////////////////////// struct transition_t { @@ -221,6 +146,9 @@ namespace picture_validation { } }; +#define dot '.' +#define com ',' + static std::vector<transition_t> picture_rules { // Alpha and Alphanumeric { none_e, 'A', alphabetic_e }, @@ -773,22 +701,9 @@ namespace picture_validation { } } - /* - * The followers table is sensitive to whether we've seen decimal point, and - * whether we're in an exponent. That reflects the duplicate column - * headings in ISO Table 10. - */ bool day_follows_night( char ch ) const { const static std::string domain("*+,-./019ABENPSVXZCRDB"); return std::string::npos != domain.find(ch); - - auto p = followers.find( follow_key_t {pic_state, prior_ch} ); - if( p != followers.end() ) { - const auto& candidates(p->second); - auto pnext = std::find( candidates.begin(), candidates.end(), ch ); - return pnext != candidates.end(); - } - return false; } inline bool first_dollar( char ch ) { return ch == '$' && ndollar == 0; } diff --git a/gcc/cobol/symbols.cc b/gcc/cobol/symbols.cc index 9dc547dc24c0..35b364221e72 100644 --- a/gcc/cobol/symbols.cc +++ b/gcc/cobol/symbols.cc @@ -4367,18 +4367,35 @@ cbl_field_t::encode( size_t srclen, cbl_loc_t loc ) { gcc_assert(0 < inbytesleft); if( loc.first_line == 0 ) loc = symbol_field_location(field_index(this)); - if( type == FldNumericEdited ) { + switch( type ) { + case FldNumericEdited: // Tolerate trailing zeros for P-values if( data.rdigits < 0 ) { if( inbytesleft <= size_t(data.rdigits * -1) ) { - bool all_zeros = std::all_of(reinterpret_cast<const char*>(inbuf), - data.original() + srclen, - [](char ch) { - return '0' == ch; - }); + bool all_zeros = std::all_of(reinterpret_cast<const char*>(inbuf), + data.original() + srclen, + [](char ch) { + return '0' == ch; + }); if( all_zeros ) return nullptr; } } + break; + default: + if( ! is_numeric(this) ) { + bool all_blank = std::all_of(reinterpret_cast<const char*>(inbuf), + data.original() + srclen, + [](char ch) { + return 0x20 == ch; + }); + if( all_blank ) { + cbl_message(loc, MfValueClause, + "VALUE %qs is too long to initialize %qs, discarded %qs", + data.original(), name, inbuf); + return nullptr; + } + } + break; } error_msg( loc, "VALUE %qs is too long to initialize %qs, discarded %qs",
