From e306ed45b58e7210021a8a74d453ee1b2a75ed30 Mon Sep 17 00:00:00 2001 From: Piotr Trojanek Date: Thu, 9 Dec 2021 17:57:16 +0100 Subject: [PATCH] [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. --- gcc/ada/errout.adb | 22 +++++++++++++++------- gcc/ada/erroutc.adb | 1 + gcc/ada/erroutc.ads | 9 +++++++++ gcc/ada/errutil.adb | 1 + 4 files changed, 26 insertions(+), 7 deletions(-) diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 0778f54..b3c3856 100644 --- 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 --- 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 --- 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 --- 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, -- 2.7.4