https://gcc.gnu.org/g:b5e8c0587adb83b08587137d43bf80de00bc2d0e
commit r17-951-gb5e8c0587adb83b08587137d43bf80de00bc2d0e Author: Viljar Indus <[email protected]> Date: Fri Mar 20 15:15:07 2026 +0200 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: --- gcc/ada/errout.adb | 45 ++++++++++++--------------------------------- gcc/ada/erroutc.adb | 24 ++++++++++++++++++------ gcc/ada/erroutc.ads | 3 +++ 3 files changed, 33 insertions(+), 39 deletions(-) diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index 0ae23cd38f7d..a395248cefe1 100644 --- 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 d88c97bbfc8b..ef0c1e4ba6dd 100644 --- 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 52ff4538a59d..eacf7032711e 100644 --- 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.
