]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Simplify Warning_Specifically_Suppressed calls.
authorViljar Indus <indus@adacore.com>
Fri, 20 Mar 2026 13:47:54 +0000 (15:47 +0200)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Fri, 29 May 2026 08:49:49 +0000 (10:49 +0200)
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.

gcc/ada/errout.adb
gcc/ada/erroutc.adb
gcc/ada/erroutc.ads

index a395248cefe19da14277b1b03dabd3397f508f00..61fb845ea0865c99db61eae0d277caf2b321e146 100644 (file)
@@ -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;
index ef0c1e4ba6dd0ef084a5d5fe348921fbb706ddb5..91bb30f0a582b827532e2ab447d2616c41fa48bd 100644 (file)
@@ -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 --
    -------------------------------------
index eacf7032711e2b24753283567c21023dfa115611..5efc64feeff9e973b312e6e04a286b1e2673b2a2 100644 (file)
@@ -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,