[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.
This commit is contained in:
Piotr Trojanek 2021-12-09 17:57:16 +01:00 committed by Pierre-Marie de Rodat
parent 45742b6192
commit e306ed45b5
4 changed files with 26 additions and 7 deletions

View File

@ -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

View File

@ -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

View File

@ -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

View File

@ -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,