[gcc r17-2794] cobol: Support SET of NUMERIC type for GnuCOBOL emulation.

https://gcc.gnu.org/g:2d665597ec6cb4e9f2740d3d4dbccc786687f911

commit r17-2794-g2d665597ec6cb4e9f2740d3d4dbccc786687f911
Author: James K. Lowden <[email protected]>
Date:   Wed Jul 29 15:30:42 2026 -0400

    cobol: Support SET of NUMERIC type for GnuCOBOL emulation.
    
    gcc/cobol/ChangeLog:
    
            * cbldiag.h (enum cbl_diag_id_t): Add MfSetNumeric and sort alphabetically.
            * cobol1.cc (cobol_langhook_handle_option): Handle OPT_Wset_numeric.
            * gcobol.1: Document Wset-numeric option.
            * lang-specs.h: Add Wset-numeric to specs string.
            * lang.opt: Add Wset-numeric option.
            * messages.cc: Add MfSetNumeric to mf and gnu dialects, and sort alphabetically.
            * parse_ante.h (parser_move_carefully): Report diagnotic per dialect.

Diff:
---
 gcc/cobol/cbldiag.h    |  3 ++-
 gcc/cobol/cobol1.cc    |  4 ++++
 gcc/cobol/gcobol.1     | 11 ++++++++---
 gcc/cobol/lang-specs.h |  1 +
 gcc/cobol/lang.opt     |  5 +++++
 gcc/cobol/messages.cc  |  8 ++++----
 gcc/cobol/parse_ante.h | 10 +++++-----
 7 files changed, 29 insertions(+), 13 deletions(-)

diff --git a/gcc/cobol/cbldiag.h b/gcc/cobol/cbldiag.h
index 7a6d25e52a4f..75c946df96c0 100644
--- a/gcc/cobol/cbldiag.h
+++ b/gcc/cobol/cbldiag.h
@@ -204,8 +204,9 @@ enum cbl_diag_id_t : uint64_t {
   MfMoveIndex, 
   MfMovePointer, 
   MfReturningNum,
-  MfUsageTypename,
+  MfSetNumeric,
   MfTrailing,
+  MfUsageTypename,
   
   Par78CdfDefinedW,
   ParIconvE, 
diff --git a/gcc/cobol/cobol1.cc b/gcc/cobol/cobol1.cc
index fd226b520f63..f57d310f63b0 100644
--- a/gcc/cobol/cobol1.cc
+++ b/gcc/cobol/cobol1.cc
@@ -629,6 +629,10 @@ cobol_langhook_handle_option (size_t scode,
           cobol_warning(MfMovePointer, move_pointer, warning_as_error);
           return true;
 
+        case OPT_Wset_numeric:
+          cobol_warning(MfSetNumeric, set_numeric, warning_as_error);
+          return true;
+
         case OPT_Wlevel_78:
           cobol_warning(MfLevel78, level_78, warning_as_error);
           return true;
diff --git a/gcc/cobol/gcobol.1 b/gcc/cobol/gcobol.1
index 5eac3beef595..aff6c1c7431e 100644
--- a/gcc/cobol/gcobol.1
+++ b/gcc/cobol/gcobol.1
@@ -83,6 +83,7 @@
 .Op Fl Wno-returning-number
 .Op Fl Wno-segment-error
 .Op Fl Wno-segment-negative
+.Op Fl Wno-set-numeric
 .Op Fl Wno-stop-number
 .Op Fl Wno-stray-indicator
 .Op Fl Wno-usage-typename
@@ -504,18 +505,20 @@ used with
 .It
 .Sy INSPECT ... TRAILING
 .It
+.Sy LEVEL 78
+constants
+.It
 .Sy OCCURS
 at
 .Sy "LEVEL 01"
 .It
-.Sy LEVEL 78
-constants
-.It
 .Sy MOVE POINTER
 .It
 .Sy RETURNING
 <number>
 .It
+.Sy SET NUMERIC
+.It
 .Sy USAGE IS TYPENAME
 .El
 .El
@@ -635,6 +638,8 @@ Warn if CDF defines Level 78 constant.
 Warn if MOVE INDEX is used.
 .It Fl Wno-move-pointer
 Warn if MOVE POINTER is used.
+.It Fl Wno-set-numeric
+Warn if SET is used with NUMERIC target.
 .It Fl Wno-returning-number
 Warn if RETURNING <number> is used.
 .It Fl Wno-usage-typename
diff --git a/gcc/cobol/lang-specs.h b/gcc/cobol/lang-specs.h
index d64353523e04..bc97e411ee30 100644
--- a/gcc/cobol/lang-specs.h
+++ b/gcc/cobol/lang-specs.h
@@ -93,6 +93,7 @@
 	"%{Wreturning-number} %{Wno-returning-number} "
 	"%{Wsegment-error} %{Wno-segment-error} "
 	"%{Wsegment-negative} %{Wno-segment-negative} "
+	"%{Wset-numeric} %{Wno-set-numeric} "
 	"%{Wstop-number} %{Wno-stop-number} "
 	"%{Wstray-indicator} %{Wno-stray-indicator} "
 	"%{Wusage-typename} %{Wno-usage-typename} "
diff --git a/gcc/cobol/lang.opt b/gcc/cobol/lang.opt
index f50224fac05a..e2350ef142ee 100644
--- a/gcc/cobol/lang.opt
+++ b/gcc/cobol/lang.opt
@@ -179,6 +179,11 @@ Wreturning-number
 Cobol Warning Var(returning_number, 1) Init(1)
 Warn if RETURNING <number> is used.
 
+; MfSetNumeric, 
+Wset-numeric
+Cobol Warning Var(set_numeric, 1) Init(1)
+Warn if SET is used with NUMERIC target.
+
 ; MfUsageTypename
 Wusage-typename
 Cobol Warning Var(usage_typename, 1) Init(1)
diff --git a/gcc/cobol/messages.cc b/gcc/cobol/messages.cc
index e2518e112403..9dfd9ce403cb 100644
--- a/gcc/cobol/messages.cc
+++ b/gcc/cobol/messages.cc
@@ -141,8 +141,8 @@ std::set<cbl_diag_t> cbl_diagnostics {
   { IsoResume, "-Wcobol-resume", diagnostics::kind::error, dialect_ibm_e },
   // IBM, MF, and GNU all support ASSIGN TO filename, so we keep mum. 
   { IsoAssignFile, "-Wassign-file", diagnostics::kind::ignored, dialect_ibm_mf_gnu },
-  
 
+  { MfAnyLength, "-Wany-length", diagnostics::kind::error, dialect_mf_gnu },
   { MfAssignExternal, "-Wassign-external", diagnostics::kind::error, dialect_mf_gnu },
   { MfBinaryLongLong, "-Wbinary-long-long", diagnostics::kind::error, dialect_mf_gnu },
   { MfCallGiving, "-Wcall-giving", diagnostics::kind::error, dialect_mf_gnu },
@@ -150,14 +150,14 @@ std::set<cbl_diag_t> cbl_diagnostics {
   { MfCdfDollar, "-Wcdf-dollar", diagnostics::kind::error, dialect_mf_gnu },
   { MfComp6, "-Wcomp-6", diagnostics::kind::error, dialect_mf_gnu },
   { MfCompX, "-Wcomp-x", diagnostics::kind::error, dialect_mf_gnu },
-  { MfLevel_1_Occurs, "-Wlevel-1-occurs", diagnostics::kind::error, dialect_mf_gnu },
   { MfLevel78, "-Wlevel-78", diagnostics::kind::error, dialect_mf_gnu },
-  { MfAnyLength, "-Wany-length", diagnostics::kind::error, dialect_mf_gnu },
+  { MfLevel_1_Occurs, "-Wlevel-1-occurs", diagnostics::kind::error, dialect_mf_gnu },
   { MfMoveIndex, "-Wmove-index", diagnostics::kind::error, dialect_gnu_e },
   { MfMovePointer, "-Wmove-pointer", diagnostics::kind::error, dialect_mf_gnu },
   { MfReturningNum, "-Wreturning-number", diagnostics::kind::error, dialect_mf_gnu },
-  { MfUsageTypename, "-Wusage-typename", diagnostics::kind::error, dialect_mf_gnu },
+  { 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 },
 
   { LexIncludeE, "-Winclude-file-not-found", diagnostics::kind::error }, 
   { LexIncludeOkN, "-Winclude-file-found", diagnostics::kind::note }, 
diff --git a/gcc/cobol/parse_ante.h b/gcc/cobol/parse_ante.h
index 477ed3478480..39f33fdf3b54 100644
--- a/gcc/cobol/parse_ante.h
+++ b/gcc/cobol/parse_ante.h
@@ -3436,11 +3436,11 @@ parser_move_carefully( const char */*F*/, int /*L*/,
 
     if( is_index ) {
       if( tgt.field->type != FldIndex && src.field->type != FldIndex) {
-        error_msg(src.loc, "invalid SET %qs (%s) TO %qs (%s): not a field index",
-                  name_of(tgt.field), 3 + cbl_field_type_str(tgt.field->type),
-                  name_of(src.field), 3 + cbl_field_type_str(src.field->type));
-        delete tgt_list;
-        return false;
+        auto msg = xasprintf("invalid SET %qs (%s) TO %qs (%s): not a field index",
+                             name_of(tgt.field), cbl_field_type_name(tgt.field->type),
+                             name_of(src.field), cbl_field_type_name(src.field->type));
+        dialect_ok(src.loc, MfSetNumeric, msg);
+        free(msg);
       }
     } else {
       if( ! valid_move( tgt.field, src.field ) ) {