ada: Refactor error message deletion

Extract the common code from multiple places where we deleted
messages into one common subprogram.

gcc/ada/ChangeLog:

	* errout.adb: Use Delete_Error_Msg.
	* erroutc.adb (Delete_Error_Msg): New subprogram.
	* erroutc.ads (Delete_Error_Msg): Likewise.

diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb
index 0ae23cd38f7d6d820a10952bd8fc1b042d518799..a395248cefe19da14277b1b03dabd3397f508f00 100644 (file)
--- a/gcc/ada/errout.adb
+++ b/gcc/ada/errout.adb
@@ -395,19 +395,11 @@ package body Errout is
 
       Id := Msg;
       loop
-         declare
-            M : Error_Msg_Object renames Errors.Table (Id);
-
-         begin
-            if not M.Deleted then
-               M.Deleted := True;
-               Decrease_Error_Msg_Count (M);
-            end if;
+         Delete_Error_Msg (Id);
 
-            Id := M.Next;
-            exit when Id = No_Error_Msg;
-            exit when not Errors.Table (Id).Msg_Cont;
-         end;
+         Id := Errors.Table (Id).Next;
+         exit when Id = No_Error_Msg;
+         exit when not Errors.Table (Id).Msg_Cont;
       end loop;
    end Delete_Warning_And_Continuations;
 
@@ -1911,21 +1903,6 @@ package body Errout is
       Nxt : Error_Msg_Id;
       F   : Error_Msg_Id;
 
-      procedure Delete_Warning (E : Error_Msg_Id);
-      --  Delete a warning msg if not already deleted and adjust warning count
-
-      --------------------
-      -- Delete_Warning --
-      --------------------
-
-      procedure Delete_Warning (E : Error_Msg_Id) is
-      begin
-         if not Errors.Table (E).Deleted then
-            Errors.Table (E).Deleted := True;
-            Decrease_Error_Msg_Count (Errors.Table (E));
-         end if;
-      end Delete_Warning;
-
    --  Start of processing for Finalize
 
    begin
@@ -1975,7 +1952,7 @@ package body Errout is
                     Warning_Specifically_Suppressed (CE.Optr.Ptr, CE.Text, Tag)
                                                                 /= No_String)
             then
-               Delete_Warning (Cur);
+               Delete_Error_Msg (Cur);
 
                --  If this is a continuation, delete previous parts of message
 
@@ -1983,7 +1960,7 @@ package body Errout is
                while Errors.Table (F).Msg_Cont loop
                   F := Errors.Table (F).Prev;
                   exit when F = No_Error_Msg;
-                  Delete_Warning (F);
+                  Delete_Error_Msg (F);
                end loop;
 
                --  Delete any following continuations
@@ -1993,7 +1970,7 @@ package body Errout is
                   F := Errors.Table (F).Next;
                   exit when F = No_Error_Msg;
                   exit when not Errors.Table (F).Msg_Cont;
-                  Delete_Warning (F);
+                  Delete_Error_Msg (F);
                end loop;
             end if;
          end;
@@ -3405,8 +3382,6 @@ package body Errout is
 
                and then not Errors.Table (E).Uncond
             then
-               Decrease_Error_Msg_Count (Errors.Table (E));
-
                return True;
 
             --  No removal required
@@ -3419,7 +3394,11 @@ package body Errout is
       --  Start of processing for Check_For_Warnings
 
       begin
+         --  Remove the first messages from the error chain.
+         --  ??? Why not delete them like the others?
+
          while To_Be_Removed (First_Error_Msg) loop
+            Decrease_Error_Msg_Count (Errors.Table (First_Error_Msg));
             First_Error_Msg := Errors.Table (First_Error_Msg).Next;
          end loop;
 
@@ -3430,7 +3409,7 @@ package body Errout is
          E := First_Error_Msg;
          while E /= No_Error_Msg loop
             while To_Be_Removed (Errors.Table (E).Next) loop
-               Errors.Table (Errors.Table (E).Next).Deleted := True;
+               Delete_Error_Msg (Errors.Table (E).Next);
 
                Errors.Table (E).Next :=
                  Errors.Table (Errors.Table (E).Next).Next;

diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb
index d88c97bbfc8b22447c13f1c6b3f483c0ea3e0013..ef0c1e4ba6dd0ef084a5d5fe348921fbb706ddb5 100644 (file)
--- a/gcc/ada/erroutc.adb
+++ b/gcc/ada/erroutc.adb
@@ -145,9 +145,7 @@ package body Erroutc is
          K := Keep;
 
          loop
-            Errors.Table (D).Deleted := True;
-
-            Decrease_Error_Msg_Count (Errors.Table (D));
+            Delete_Error_Msg (D);
 
             --  Substitute shorter of the two error messages
 
@@ -275,6 +273,18 @@ package body Erroutc is
       end if;
    end Debug_Output;
 
+   ----------------------
+   -- Delete_Error_Msg --
+   ----------------------
+
+   procedure Delete_Error_Msg (E : Error_Msg_Id) is
+   begin
+      if not Errors.Table (E).Deleted then
+         Errors.Table (E).Deleted := True;
+         Decrease_Error_Msg_Count (Errors.Table (E));
+      end if;
+   end Delete_Error_Msg;
+
    -----------
    -- dedit --
    -----------
@@ -1335,8 +1345,6 @@ package body Erroutc is
            and then Errors.Table (E).Sptr.Ptr > From
            and then Errors.Table (E).Sptr.Ptr < To
          then
-            Decrease_Error_Msg_Count (Errors.Table (E));
-
             return True;
 
          else
@@ -1347,14 +1355,18 @@ package body Erroutc is
    --  Start of processing for Purge_Messages
 
    begin
+      --  Remove the first messages from the error chain.
+      --  ??? Why not delete them like the others?
+
       while To_Be_Purged (First_Error_Msg) loop
+         Decrease_Error_Msg_Count (Errors.Table (First_Error_Msg));
          First_Error_Msg := Errors.Table (First_Error_Msg).Next;
       end loop;
 
       E := First_Error_Msg;
       while E /= No_Error_Msg loop
          while To_Be_Purged (Errors.Table (E).Next) loop
-            Errors.Table (Errors.Table (E).Next).Deleted := True;
+            Delete_Error_Msg (Errors.Table (E).Next);
 
             Errors.Table (E).Next :=
               Errors.Table (Errors.Table (E).Next).Next;

diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads
index 52ff4538a59dc39f1aa784d61e417a013208d8fe..eacf7032711e2b24753283567c21023dfa115611 100644 (file)
--- a/gcc/ada/erroutc.ads
+++ b/gcc/ada/erroutc.ads
@@ -739,6 +739,9 @@ package Erroutc is
    --  Tag used at the end of warning messages that were converted by
    --  pragma Warning_As_Error.
 
+   procedure Delete_Error_Msg (E : Error_Msg_Id);
+   --  Delete an error msg if not already deleted and adjust message count
+
    procedure Purge_Messages (From : Source_Ptr; To : Source_Ptr);
    --  All error messages whose location is in the range From .. To (not
    --  including the end points) will be deleted from the error listing.