[Ada] Remove warnings-as-errors about constraints error in dead code

gcc/ada/

	* erroutc.ads, erroutc.adb (Is_Runtime_Raise): Global flag to
	connect status of initial messages and their continuation; we
	already have several flags like this.
	(Error_Msg_Object): Add field Warn_Runtime_Raise to connect
	error reporting (when problematic code is found) and removal
	(when problematic code is determined to be dead).
	* errout.adb (Error_Msg_Internal): Handle new field when
	recording a continuation message; propagate status from
	continuation to the preceding messages.
	(To_Be_Removed): For dead code remove both simple warnings and
	warnings about constraint errors that have been escalated to
	hard errors.
	(Set_Msg_Text): Recognize warnings about constraint errors that
	are escalated to hard errors.
	* errutil.adb (Error_Msg): Handle added field when recording a
	new message.

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 0778f54..b3c3856 100644 (file)
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -1224,6 +1224,7 @@ package body Errout is
           Check               => Is_Check_Msg,
           Warn_Err            => False, -- reset below
           Warn_Chr            => Warning_Msg_Char,
+          Warn_Runtime_Raise  => Is_Runtime_Raise,
           Style               => Is_Style_Msg,
           Serious             => Is_Serious_Error,
           Uncond              => Is_Unconditional_Msg,
@@ -1241,12 +1242,14 @@ package body Errout is
                     Warning_Treated_As_Error (Get_Warning_Tag (Cur_Msg)));
 
       --  Propagate Warn_Err to this message and preceding continuations.
-      --  Likewise, propagate Is_Warning_Msg, because the current continued
-      --  message could have been escalated from warning to error.
+      --  Likewise, propagate Is_Warning_Msg and Is_Runtime_Raise, because the
+      --  current continued message could have been escalated from warning to
+      --  error.
 
       for J in reverse 1 .. Errors.Last loop
-         Errors.Table (J).Warn_Err := Warn_Err;
-         Errors.Table (J).Warn     := Is_Warning_Msg;
+         Errors.Table (J).Warn_Err           := Warn_Err;
+         Errors.Table (J).Warn               := Is_Warning_Msg;
+         Errors.Table (J).Warn_Runtime_Raise := Is_Runtime_Raise;
          exit when not Errors.Table (J).Msg_Cont;
       end loop;
 
@@ -3290,13 +3293,17 @@ package body Errout is
                --  not remove style messages here. They are warning messages
                --  but not ones we want removed in this context.
 
-               and then Errors.Table (E).Warn
+               and then (Errors.Table (E).Warn
+                           or else
+                         Errors.Table (E).Warn_Runtime_Raise)
 
                --  Don't remove unconditional messages
 
                and then not Errors.Table (E).Uncond
             then
-               Warnings_Detected := Warnings_Detected - 1;
+               if Errors.Table (E).Warn then
+                  Warnings_Detected := Warnings_Detected - 1;
+               end if;
 
                if Errors.Table (E).Info then
                   Warning_Info_Messages := Warning_Info_Messages - 1;
@@ -4072,7 +4079,8 @@ package body Errout is
                if Is_Warning_Msg
                  and then Warning_Mode = Treat_Run_Time_Warnings_As_Errors
                then
-                  Is_Warning_Msg := False;
+                  Is_Warning_Msg   := False;
+                  Is_Runtime_Raise := True;
                end if;
 
                if Is_Warning_Msg then

diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index bbe08ff..c18f418 100644 (file)
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -902,6 +902,7 @@ package body Erroutc is
          Is_Serious_Error     := True;
          Is_Unconditional_Msg := False;
          Is_Warning_Msg       := False;
+         Is_Runtime_Raise     := False;
 
          --  Check style message
 

diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index a93fe57..d4d4443 100644 (file)
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -71,6 +71,11 @@ package Erroutc is
    --  Set True to indicate if current message is warning message (contains ?
    --  or contains < and Error_Msg_Warn is True).
 
+   Is_Runtime_Raise : Boolean := False;
+   --  Set to True to indicate that the current message is a warning about a
+   --  constraint error that will be raised at runtime (contains [ and switch
+   --  -gnatwE was given).
+
    Is_Info_Msg : Boolean := False;
    --  Set True to indicate that the current message starts with the characters
    --  "info: " and is to be treated as an information message. This string
@@ -239,6 +244,10 @@ package Erroutc is
       --  True if this is a warning message which is to be treated as an error
       --  as a result of a match with a Warning_As_Error pragma.
 
+      Warn_Runtime_Raise : Boolean;
+      --  True if this a warning about a constraint error that will be raised
+      --  at runtime.
+
       Warn_Chr : String (1 .. 2);
       --  See Warning_Msg_Char
 

diff --git a/gcc/ada/errutil.adb b/gcc/ada/errutil.adb
index 6aa7d6e..921de31 100644 (file)
--- a/gcc/ada/errutil.adb
+++ b/gcc/ada/errutil.adb
@@ -217,6 +217,7 @@ package body Errutil is
             Info                => Is_Info_Msg,
             Check               => Is_Check_Msg,
             Warn_Err            => Warning_Mode = Treat_As_Error,
+            Warn_Runtime_Raise  => Is_Runtime_Raise,
             Warn_Chr            => Warning_Msg_Char,
             Style               => Is_Style_Msg,
             Serious             => Is_Serious_Error,