[Ada] Generate warning for negative literal of a modular type

gcc/ada/

	* opt.ads: Update comment for Warn_On_Suspicious_Modulus_Value.
	* sem_res.adb (Resolve_Unary_Op): Generate warning.
	* usage.adb: Refine doc for -gnatw.m/M switch.
	* doc/gnat_ugn/building_executable_programs_with_gnat.rst:
	Update doc on -gnatw.m switch.
	* gnat_ugn.texi: Regenerate.

5 files changed, 36 insertions, 6 deletions

diff --git a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
index fb8a3ff..0906a68 100644
--- a/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
+++ b/gcc/ada/doc/gnat_ugn/building_executable_programs_with_gnat.rst
@@ -3424,7 +3424,10 @@ of the pragma in the :title:`GNAT_Reference_manual`).
   with no size clause. The guess in both cases is that 2**x was intended
   rather than x. In addition expressions of the form 2*x for small x
   generate a warning (the almost certainly accurate guess being that
-  2**x was intended). The default is that these warnings are given.
+  2**x was intended). This switch also activates warnings for negative
+  literal values of a modular type, which are interpreted as large positive
+  integers after wrap-around. The default is that these warnings are given.
+
 
 
 .. index:: -gnatw.M  (gcc)
diff --git a/gcc/ada/gnat_ugn.texi b/gcc/ada/gnat_ugn.texi
index 637f061..fefba9c 100644
--- a/gcc/ada/gnat_ugn.texi
+++ b/gcc/ada/gnat_ugn.texi
@@ -11616,7 +11616,9 @@ a modulus of 7 with a size of 7 bits), and modulus values of 32 or 64
 with no size clause. The guess in both cases is that 2**x was intended
 rather than x. In addition expressions of the form 2*x for small x
 generate a warning (the almost certainly accurate guess being that
-2**x was intended). The default is that these warnings are given.
+2**x was intended). This switch also activates warnings for negative
+literal values of a modular type, which are interpreted as large positive
+integers after wrap-around. The default is that these warnings are given.
 @end table
 
 @geindex -gnatw.M (gcc)
diff --git a/gcc/ada/opt.ads b/gcc/ada/opt.ads
index f717a99..aeac352 100644
--- a/gcc/ada/opt.ads
+++ b/gcc/ada/opt.ads
@@ -1885,8 +1885,9 @@ package Opt is
 
    Warn_On_Suspicious_Modulus_Value : Boolean := True;
    --  GNAT
-   --  Set to True to generate warnings for suspicious modulus values. The
-   --  default is that this warning is enabled. Modified by -gnatw.m/.M.
+   --  Set to True to generate warnings for suspicious modulus values, as well
+   --  as negative literals of a modular type. The default is that this warning
+   --  is enabled. Modified by -gnatw.m/.M.
 
    Warn_On_Unchecked_Conversion : Boolean := True;
    --  GNAT
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index fc89a31..bd950f5 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -12096,6 +12096,28 @@ package body Sem_Res is
       Set_Etype (N, B_Typ);
       Resolve (R, B_Typ);
 
+      --  Generate warning for negative literal of a modular type, unless it is
+      --  enclosed directly in a type qualification or a type conversion, as it
+      --  is likely not what the user intended. We don't issue the warning for
+      --  the common use of -1 to denote OxFFFF_FFFF...
+
+      if Warn_On_Suspicious_Modulus_Value
+        and then Nkind (N) = N_Op_Minus
+        and then Nkind (R) = N_Integer_Literal
+        and then Is_Modular_Integer_Type (B_Typ)
+        and then Nkind (Parent (N)) not in N_Qualified_Expression
+                                         | N_Type_Conversion
+        and then Expr_Value (R) > Uint_1
+      then
+         Error_Msg_N
+           ("?M?negative literal of modular type is in fact positive", N);
+         Error_Msg_Uint_1 := (-Expr_Value (R)) mod Modulus (B_Typ);
+         Error_Msg_Uint_2 := Expr_Value (R);
+         Error_Msg_N ("\do you really mean^ when writing -^ '?", N);
+         Error_Msg_N
+           ("\if you do, use qualification to avoid this warning", N);
+      end if;
+
       --  Generate warning for expressions like abs (x mod 2)
 
       if Warn_On_Redundant_Constructs
diff --git a/gcc/ada/usage.adb b/gcc/ada/usage.adb
index e5bc62e..c85d610 100644
--- a/gcc/ada/usage.adb
+++ b/gcc/ada/usage.adb
@@ -532,8 +532,10 @@ begin
                                                   "but not read");
    Write_Line ("        M*   turn off warnings for variable assigned " &
                                                   "but not read");
-   Write_Line ("        .m*+ turn on warnings for suspicious modulus value");
-   Write_Line ("        .M   turn off warnings for suspicious modulus value");
+   Write_Line ("        .m*+ turn on warnings for suspicious usage " &
+                                                      "of modular type");
+   Write_Line ("        .M   turn off warnings for suspicious usage " &
+                                                      "of modular type");
    Write_Line ("        n*   normal warning mode (cancels -gnatws/-gnatwe)");
    Write_Line ("        .n   turn on info messages for atomic " &
                                                   "synchronization");