https://gcc.gnu.org/g:3b67b356f650e817e69cdcd441f80cee697d8f7a
commit r17-4791-g3b67b356f650e817e69cdcd441f80cee697d8f7a Author: James K. Lowden <[email protected]> Date: Tue Sep 29 15:29:01 2026 -0400 cobol: Add Werrno to warn about errno, and refine syslog priority. If the COBOL program uses "error" as a data-item name, Werrno emits a diagnositic indicating that it does not reference the errno C variable. Instead of LOG_INFO for all messages regarding an unhandled error condition, use LOG_ERR for fatal EC and LOG_WARNING for nonfatal. Any EC that is unimplemented or not recognized continues to use LOG_INFO. Correct EC processing to work for last statement in program. gcc/cobol/ChangeLog: * cbldiag.h (enum cbl_diag_id_t): Define ParErrno. * cobol1.cc (cobol_langhook_handle_option): Handle Werrno. * lang-specs.h: Accept Werrno. * lang.opt: Define Werrno. * messages.cc (struct cbl_diag_t): Add Werrno to warning table. (kind_of): Whitespace. (cobol_warning): Same. (option_of): Same. (cbl_message): Same. (dialect_ok): Same. * parse.y: Issue Werrno diagnostic, and handle end-of-program EC. libgcobol/ChangeLog: * ec.h (enum ec_type_t): Whitespace. * libgcobol.cc (ec_priority): New function. (default_exception_handler): use ec_priority. Diff: --- gcc/cobol/cbldiag.h | 1 + gcc/cobol/cobol1.cc | 4 ++++ gcc/cobol/lang-specs.h | 1 + gcc/cobol/lang.opt | 5 +++++ gcc/cobol/messages.cc | 60 +++++++++++++++++++++++--------------------------- gcc/cobol/parse.y | 5 +++++ libgcobol/ec.h | 2 +- libgcobol/libgcobol.cc | 16 ++++++++++++++ 8 files changed, 61 insertions(+), 33 deletions(-) diff --git a/gcc/cobol/cbldiag.h b/gcc/cobol/cbldiag.h index d0b28574819d..f8aac9d16bff 100644 --- a/gcc/cobol/cbldiag.h +++ b/gcc/cobol/cbldiag.h @@ -227,6 +227,7 @@ enum cbl_diag_id_t : uint64_t { Par78CdfDefinedW, ParDynamicCall, + ParErrno, ParIconvE, ParInfoI, ParLangInfoW, diff --git a/gcc/cobol/cobol1.cc b/gcc/cobol/cobol1.cc index 46bdd129e9f3..ef902e118474 100644 --- a/gcc/cobol/cobol1.cc +++ b/gcc/cobol/cobol1.cc @@ -732,6 +732,10 @@ cobol_langhook_handle_option (size_t scode, cobol_warning(ParInfoI, entry_convention, warning_as_error); return true; + case OPT_Werrno: + cobol_warning(ParNumstrW, cobol_errno, warning_as_error); + return true; + case OPT_Wiconv_error: cobol_warning(ParIconvE, iconv_error, warning_as_error); return true; diff --git a/gcc/cobol/lang-specs.h b/gcc/cobol/lang-specs.h index 43198041a788..a5ed3fb9322f 100644 --- a/gcc/cobol/lang-specs.h +++ b/gcc/cobol/lang-specs.h @@ -73,6 +73,7 @@ "%{Wdynamic-call} %{Wno-dynamic-call} " "%{Wec-unknown} %{Wno-ec-unknown} " "%{Wentry-convention} %{Wno-entry-convention} " + "%{Werrno} %{Wno-errno} " "%{Whex-numeric} %{Wno-hex-numeric} " "%{Wibm-cdf} %{Wno-ibm-cdf} " "%{Wiconv-error} %{Wno-iconv-error} " diff --git a/gcc/cobol/lang.opt b/gcc/cobol/lang.opt index 413796daba26..5872f68b70f9 100644 --- a/gcc/cobol/lang.opt +++ b/gcc/cobol/lang.opt @@ -219,6 +219,11 @@ Wbad-numeric Cobol Warning Var(bad_numeric, 1) Init(1) Warn if numeric string is invalid. +; ParErrno +Werrno +Cobol Warning Var(cobol_errno, 1) Init(1) +Warn errno is used as a data-item name. + ; CdfParameterW Wcdf-invalid-parameter Cobol Warning Var(cdf_invalid_parameter, 1) Init(1) diff --git a/gcc/cobol/messages.cc b/gcc/cobol/messages.cc index dd3c4f8862fb..98fab8437396 100644 --- a/gcc/cobol/messages.cc +++ b/gcc/cobol/messages.cc @@ -29,9 +29,9 @@ */ /* - * Define a table of diagnositic messages, each uniquely identified and - * grouped into dialects. The user can select on the command line which - * ones are in effect. + * Define a table of diagnositic messages, each uniquely identified and + * grouped into dialects. The user can select on the command line which + * ones are in effect. */ #include <cobol-system.h> @@ -84,7 +84,7 @@ struct cbl_diag_t { cbl_name_t option; diagnostics::kind kind; cbl_dialect_t dialect; - + explicit cbl_diag_t( cbl_diag_id_t id ) : id(id), option(""), kind(diagnostics::kind::ignored), dialect(dialect_gcc_e) {} @@ -109,7 +109,7 @@ struct cbl_diag_t { * user chooses dialect iso, all dialect-enabled features are turned into * errors. If the user selects a more generous dialect, features associated * with it are set to be ignored. - * + * * Individual features may also be suppressed, and all warnings may be elevated * to errors. */ @@ -138,7 +138,7 @@ std::set<cbl_diag_t> cbl_diagnostics { { IbmVolatileE, "-Wcobol-volatile", diagnostics::kind::error, dialect_ibm_e }, { IbmVolatileW, "-Wcobol-volatile", diagnostics::kind::warning, dialect_ibm_e }, - // IBM, MF, and GNU all support ASSIGN TO filename, so we keep mum. + // IBM, MF, and GNU all support ASSIGN TO filename, so we keep mum. { IsoAssignFile, "-Wassign-file", diagnostics::kind::ignored, dialect_ibm_mf_gnu }, // ISO says for B REDEFINES A, Length(B) <= Length(A), others disagree { IsoRedefinesGrow, "-Wredefines-grow", diagnostics::kind::error, dialect_ibm_mf_gnu }, @@ -167,20 +167,21 @@ std::set<cbl_diag_t> cbl_diagnostics { { 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 }, - { LexIndicatorE, "-Wstray-indicator", diagnostics::kind::error }, - { LexInputN, "-Wcopybook-found", diagnostics::kind::ignored }, - { LexLineE, "-Wbad-line-directive", diagnostics::kind::error }, - { LexPreprocessE, "-Wpreprocessor-error", diagnostics::kind::error }, + { LexIncludeE, "-Winclude-file-not-found", diagnostics::kind::error }, + { LexIncludeOkN, "-Winclude-file-found", diagnostics::kind::note }, + { LexIndicatorE, "-Wstray-indicator", diagnostics::kind::error }, + { LexInputN, "-Wcopybook-found", diagnostics::kind::ignored }, + { LexLineE, "-Wbad-line-directive", diagnostics::kind::error }, + { LexPreprocessE, "-Wpreprocessor-error", diagnostics::kind::error }, { LexReplaceE, "-Wreplace-error", diagnostics::kind::error }, // mf and gnu do not require whitespace after relational operators - { LexSeparatorE, "-Woperator-space", diagnostics::kind::error, dialect_mf_gnu }, + { LexSeparatorE, "-Woperator-space", diagnostics::kind::error, dialect_mf_gnu }, { Par78CdfDefinedW, "-Wlevel-78-defined", diagnostics::kind::warning }, - { ParDynamicCall, "-Wdynamic-call", diagnostics::kind::ignored }, - { ParIconvE, "-Wiconv-error", diagnostics::kind::note }, - { ParInfoI, "-Wentry-convention", diagnostics::kind::note }, + { ParDynamicCall, "-Wdynamic-call", diagnostics::kind::ignored }, + { ParErrno, "-Werrno", diagnostics::kind::warning }, + { ParIconvE, "-Wiconv-error", diagnostics::kind::note }, + { ParInfoI, "-Wentry-convention", diagnostics::kind::note }, { ParLangInfoW, "-Wnllanginfo-error", diagnostics::kind::warning }, { ParLiteral2W, "-Wliteral-concat", diagnostics::kind::warning }, { ParLocaleW, "-Wlocale-error", diagnostics::kind::warning }, @@ -222,7 +223,7 @@ kind_of( cbl_diag_id_t id ) { return diag->kind; } return diagnostics::kind::ice; -} +} diagnostics::kind cbl_diagnostic_kind( cbl_diag_id_t id ) { @@ -271,11 +272,11 @@ cobol_warning( cbl_diag_id_t id, int yn, bool warning_as_error ) { break; } } - + if( warning_as_error ) { kind = diagnostics::kind::error; } - + cbl_diagnostic_kind(id, kind); } @@ -321,7 +322,7 @@ option_of( cbl_diag_id_t id ) { return diag->option; } return nullptr; -} +} const char * cbl_diagnostic_option( cbl_diag_id_t id ) { @@ -354,7 +355,7 @@ cbl_message( cbl_diag_id_t id, const char gmsgid[], ... ) { msg = xasprintf("%s [%s]", gmsgid, option); gmsgid = msg; } - + va_list ap; va_start (ap, gmsgid); @@ -362,7 +363,7 @@ cbl_message( cbl_diag_id_t id, const char gmsgid[], ... ) { option_zero, gmsgid, &ap ); va_end (ap); free(msg); - + return ret; } @@ -399,10 +400,10 @@ bool cbl_message( cbl_loc_t loc, cbl_diag_id_t id, const char gmsgid[], ... ) { temp_loc_t looker(loc); va_list ap; - + va_start (ap, gmsgid); rich_location richloc (line_table, current_token_location()); - auto ret = emit_diagnostic_valist( kind, + auto ret = emit_diagnostic_valist( kind, current_token_location(), option_zero, gmsgid, &ap ); va_end (ap); @@ -418,20 +419,20 @@ bool cbl_message( cbl_loc_t loc, cbl_diag_id_t id, const char gmsgid[], ... ) { * dialect required: ok, dialect matches feature dialect * dialect prohibits not_ok, dialect matches feature ~dialect * - * If ok is false, then a match means the dialect prohibits the feature. + * If ok is false, then a match means the dialect prohibits the feature. */ bool dialect_ok( const cbl_loc_t& loc, cbl_diag_id_t id, const char term[], bool ok ) { auto diag = cbl_diagnostics.find(cbl_diag_t(id)); const char *verb = "requires"; - + if( diag == cbl_diagnostics.end() ) { gcc_unreachable(); } if( diag->kind == diagnostics::kind::ignored ) return true; - + if( dialect_has(diag->dialect) ) { if( ok ) { return true; @@ -452,8 +453,3 @@ dialect_ok( const cbl_loc_t& loc, cbl_diag_id_t id, const char term[], bool ok ) } return false; } - - - - - diff --git a/gcc/cobol/parse.y b/gcc/cobol/parse.y index 78d7f22d894b..243a56e0300b 100644 --- a/gcc/cobol/parse.y +++ b/gcc/cobol/parse.y @@ -4090,6 +4090,11 @@ level_name: LEVEL ctx_name @ctx_name.first_line }; if( !namcpy(@ctx_name, field.name, $2) ) YYERROR; + if( 0 == strcasecmp(field.name, "errno") ) { + warn_msg(@ctx_name, "%<errno%> does not refer to the C variable, " + "see posix-errno function"); + } + $$ = field_add(@$, &field); if( !$$ ) { YYERROR; diff --git a/libgcobol/ec.h b/libgcobol/ec.h index afa79cd53f03..6699cfbc45be 100644 --- a/libgcobol/ec.h +++ b/libgcobol/ec.h @@ -99,7 +99,7 @@ enum ec_type_t { ec_io_linage_e, ec_imp_e = 0x00008000, - ec_imp_iconv_open_e, + ec_imp_iconv_open_e, ec_imp_suffix_e, ec_locale_e = 0x00010000, diff --git a/libgcobol/libgcobol.cc b/libgcobol/libgcobol.cc index ca3adf82bc69..a9d8e2141ac4 100644 --- a/libgcobol/libgcobol.cc +++ b/libgcobol/libgcobol.cc @@ -9949,6 +9949,20 @@ void open_syslog(int option, int facility) } } +static int +ec_priority( ec_disposition_t disposition ) { + switch( disposition ) { + case ec_category_none_e: + break; + case ec_category_fatal_e: + return LOG_ERR; + case ec_category_nonfatal_e: + case ec_category_implementor_e: + return LOG_WARNING; + } + return LOG_INFO; +} + /* * The default exception handler is called if: * 1. The EC is enabled and was not handled by a Declarative, or @@ -9976,6 +9990,8 @@ default_exception_handler( ec_type_t ec ) } else { warnx("logic error: unknown exception %x", ec ); } + const int priority = ec_priority(disposition); + /* * An enabled, unhandled fatal EC normally results in termination. But * EC-I-O is a special case becase a SELECT statement with FILE STATUS
