https://gcc.gnu.org/g:3d03d27fee8905174c74c62ee6876f54d6af3b0c
commit r17-952-g3d03d27fee8905174c74c62ee6876f54d6af3b0c Author: Viljar Indus <[email protected]> Date: Fri Mar 20 15:47:54 2026 +0200 ada: Simplify Warning_Specifically_Suppressed calls. In most places we only care about whether the warning was suppressed or not and we never care what the exact reason was. Add a new subprogram Warning_Is_Suppressed for that purpose. gcc/ada/ChangeLog: * errout.adb (Finalize): use Warning_Is_Suppressed. * erroutc.adb (Warning_Is_Suppressed): New subprogram. * erroutc.ads (Warning_Is_Suppressed): Likewise. Diff: --- gcc/ada/errout.adb | 70 +++++++++++++++++++++++++++++------------------------ gcc/ada/erroutc.adb | 8 ++++++ gcc/ada/erroutc.ads | 4 +++ 3 files changed, 50 insertions(+), 32 deletions(-) diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index a395248cefe1..61fb845ea086 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -1903,6 +1903,23 @@ package body Errout is Nxt : Error_Msg_Id; F : Error_Msg_Id; + function Warning_Is_Suppressed (E : Error_Msg_Id) return Boolean; + -- Check if the warning is suppressed in either its posted or original + -- location. + + --------------------------- + -- Warning_Is_Suppressed -- + --------------------------- + + function Warning_Is_Suppressed (E : Error_Msg_Id) return Boolean is + CE : Error_Msg_Object renames Errors.Table (E); + Tag : constant String := Get_Warning_Tag (E); + begin + return + Warning_Is_Suppressed (CE.Sptr.Ptr, CE.Text, Tag) + or else Warning_Is_Suppressed (CE.Optr.Ptr, CE.Text, Tag); + end Warning_Is_Suppressed; + -- Start of processing for Finalize begin @@ -1938,42 +1955,31 @@ package body Errout is Cur := First_Error_Msg; while Cur /= No_Error_Msg loop - declare - CE : Error_Msg_Object renames Errors.Table (Cur); - Tag : constant String := Get_Warning_Tag (Cur); - - begin - if CE.Kind = Warning - and then not CE.Deleted - and then - (Warning_Specifically_Suppressed (CE.Sptr.Ptr, CE.Text, Tag) - /= No_String - or else - Warning_Specifically_Suppressed (CE.Optr.Ptr, CE.Text, Tag) - /= No_String) - then - Delete_Error_Msg (Cur); + if Errors.Table (Cur).Kind = Warning + and then not Errors.Table (Cur).Deleted + and then Warning_Is_Suppressed (Cur) + then + Delete_Error_Msg (Cur); - -- If this is a continuation, delete previous parts of message + -- If this is a continuation, delete previous parts of message - F := Cur; - while Errors.Table (F).Msg_Cont loop - F := Errors.Table (F).Prev; - exit when F = No_Error_Msg; - Delete_Error_Msg (F); - end loop; + F := Cur; + while Errors.Table (F).Msg_Cont loop + F := Errors.Table (F).Prev; + exit when F = No_Error_Msg; + Delete_Error_Msg (F); + end loop; - -- Delete any following continuations + -- Delete any following continuations - F := Cur; - loop - F := Errors.Table (F).Next; - exit when F = No_Error_Msg; - exit when not Errors.Table (F).Msg_Cont; - Delete_Error_Msg (F); - end loop; - end if; - end; + F := Cur; + loop + F := Errors.Table (F).Next; + exit when F = No_Error_Msg; + exit when not Errors.Table (F).Msg_Cont; + Delete_Error_Msg (F); + end loop; + end if; Cur := Errors.Table (Cur).Next; end loop; diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index ef0c1e4ba6dd..91bb30f0a582 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -2231,6 +2231,14 @@ package body Erroutc is "[" & To_String (Span.First) & " .. " & To_String (Span.Last) & "]"; end To_String; + --------------------------- + -- Warning_Is_Suppressed -- + --------------------------- + + function Warning_Is_Suppressed + (Loc : Source_Ptr; Msg : String_Ptr; Tag : String := "") return Boolean + is (Warning_Specifically_Suppressed (Loc, Msg, Tag) /= No_String); + ------------------------------------- -- Warning_Specifically_Suppressed -- ------------------------------------- diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads index eacf7032711e..5efc64feeff9 100644 --- a/gcc/ada/erroutc.ads +++ b/gcc/ada/erroutc.ads @@ -868,6 +868,10 @@ package Erroutc is -- Called in response to a pragma Warnings (On) to record the source -- location from which warnings are to be turned back on. + function Warning_Is_Suppressed + (Loc : Source_Ptr; Msg : String_Ptr; Tag : String := "") return Boolean; + -- Returns true if warning is specifically suppresed by a pragma. + function Warnings_Suppressed (Loc : Source_Ptr) return String_Id; -- Determines if given location is covered by a warnings off suppression -- range in the warnings table (or is suppressed by compilation option,
