https://gcc.gnu.org/g:eb3a3996851e4272f1e672eca9d0e76f92291434
commit r17-959-geb3a3996851e4272f1e672eca9d0e76f92291434 Author: Viljar Indus <[email protected]> Date: Wed Mar 25 12:57:10 2026 +0200 ada: Improve error message insertion methods Extract the error chain insertion logic into dedicated subprograms. Insert_Error_Msg adds a new message into the chain and adds the next and previous pointers, making the deferred Set_Prev_Pointers pass in Finalize redundant. Find_Msg_Insertion_Point and Is_Before extract the existing logic for finding the insertion point in Error_Msg_Internal. gcc/ada/ChangeLog: * errout.adb (Is_Before): New helper function. (Find_Msg_Insertion_Point): New procedure. (Error_Msg_Internal): Use Find_Msg_Insertion_Point and Insert_Error_Msg. (Finalize): Remove call to Set_Prev_Pointers. (Set_Prev_Pointers): Removed. * erroutc.adb (Insert_Error_Msg): New procedure. * erroutc.ads (Insert_Error_Msg): New declaration. Diff: --- gcc/ada/errout.adb | 140 ++++++++++++++++++++++++++-------------------------- gcc/ada/erroutc.adb | 26 ++++++++++ gcc/ada/erroutc.ads | 7 +++ 3 files changed, 102 insertions(+), 71 deletions(-) diff --git a/gcc/ada/errout.adb b/gcc/ada/errout.adb index f7fd92e51bd8..2bf3a2844117 100644 --- a/gcc/ada/errout.adb +++ b/gcc/ada/errout.adb @@ -125,6 +125,21 @@ package body Errout is -- the actual instantiation (i.e the line with the new). Msg_Cont is -- set true if this is a continuation message. + function Is_Before (M1, M2 : Error_Msg_Id) return Boolean; + -- Return True if M1 sorts before M2 in the error chain. Messages are + -- ordered first by source file (Sfile), then by flag location (Sptr), + -- then by original location (Optr) as a tiebreaker. + + procedure Find_Msg_Insertion_Point + (Cur_Msg : Error_Msg_Id; + Prev_Msg : out Error_Msg_Id; + Next_Msg : out Error_Msg_Id); + -- Determine the insertion point for Cur_Msg in the sorted error chain. + -- Sets Prev_Msg to the message preceding the insertion point and Next_Msg + -- to the message following it (No_Error_Msg if at the end of the chain). + -- Messages are ordered first by source file and then by source location + -- (Sptr, then Optr as a tiebreaker). + function No_Warnings (N : Node_Or_Entity_Id) return Boolean; -- Determines if warnings should be suppressed for the given node @@ -180,9 +195,6 @@ package body Errout is -- in order to guard against cascaded errors. Note that this call has an -- effect for a serious error only. - procedure Set_Prev_Pointers; - -- Set previous pointers for all of the error messages in the error chain - procedure Set_Qualification (N : Nat; E : Entity_Id); -- Outputs up to N levels of qualification for the given entity. For -- example, the entity A.B.C.D will output B.C. if N = 2. @@ -1593,44 +1605,7 @@ package body Errout is -- location (earlier flag location first in the chain). else - -- First a quick check, does this belong at the very end of the chain - -- of error messages. This saves a lot of time in the normal case if - -- there are lots of messages. - - if Last_Error_Msg /= No_Error_Msg - and then Errors.Table (Cur_Msg).Sfile - = Errors.Table (Last_Error_Msg).Sfile - and then (Sptr > Errors.Table (Last_Error_Msg).Sptr.Ptr - or else (Sptr = Errors.Table (Last_Error_Msg).Sptr.Ptr - and then Optr - > Errors.Table (Last_Error_Msg) - .Optr - .Ptr)) - then - Prev_Msg := Last_Error_Msg; - Next_Msg := No_Error_Msg; - - -- Otherwise do a full sequential search for the insertion point - - else - Prev_Msg := No_Error_Msg; - Next_Msg := First_Error_Msg; - while Next_Msg /= No_Error_Msg loop - exit when - Errors.Table (Cur_Msg).Sfile < Errors.Table (Next_Msg).Sfile; - - if Errors.Table (Cur_Msg).Sfile = Errors.Table (Next_Msg).Sfile - then - exit when - Sptr < Errors.Table (Next_Msg).Sptr.Ptr - or else (Sptr = Errors.Table (Next_Msg).Sptr.Ptr - and then Optr < Errors.Table (Next_Msg).Optr.Ptr); - end if; - - Prev_Msg := Next_Msg; - Next_Msg := Errors.Table (Next_Msg).Next; - end loop; - end if; + Find_Msg_Insertion_Point (Cur_Msg, Prev_Msg, Next_Msg); -- Now we insert the new message in the error chain. @@ -1657,17 +1632,7 @@ package body Errout is Last_Killed := False; end if; - if Prev_Msg = No_Error_Msg then - First_Error_Msg := Cur_Msg; - else - Errors.Table (Prev_Msg).Next := Cur_Msg; - end if; - - Errors.Table (Cur_Msg).Next := Next_Msg; - - if Next_Msg = No_Error_Msg then - Last_Error_Msg := Cur_Msg; - end if; + Insert_Error_Msg (Cur_Msg, Prev_Msg, Next_Msg); end if; Increase_Error_Msg_Count (Errors.Table (Cur_Msg)); @@ -1940,7 +1905,6 @@ package body Errout is procedure Finalize (Last_Call : Boolean) is begin - Set_Prev_Pointers; Delete_Duplicate_Errors; Delete_Specifically_Suppressed_Warnings; Finalize_Called := True; @@ -1953,6 +1917,41 @@ package body Errout is end if; end Finalize; + ------------------------------ + -- Find_Msg_Insertion_Point -- + ------------------------------ + + procedure Find_Msg_Insertion_Point + (Cur_Msg : Error_Msg_Id; + Prev_Msg : out Error_Msg_Id; + Next_Msg : out Error_Msg_Id) + is + begin + -- First a quick check, does this belong at the very end of the chain + -- of error messages. This saves a lot of time in the normal case if + -- there are lots of messages. + + if Last_Error_Msg /= No_Error_Msg + and then + Errors.Table (Cur_Msg).Sfile = Errors.Table (Last_Error_Msg).Sfile + and then Is_Before (Last_Error_Msg, Cur_Msg) + then + Prev_Msg := Last_Error_Msg; + Next_Msg := No_Error_Msg; + + -- Otherwise do a full sequential search for the insertion point + + else + Prev_Msg := No_Error_Msg; + Next_Msg := First_Error_Msg; + while Next_Msg /= No_Error_Msg loop + exit when Is_Before (Cur_Msg, Next_Msg); + Prev_Msg := Next_Msg; + Next_Msg := Errors.Table (Next_Msg).Next; + end loop; + end if; + end Find_Msg_Insertion_Point; + ---------------- -- First_Node -- ---------------- @@ -2192,6 +2191,23 @@ package body Errout is Specific_Warnings.Init; end Initialize; + --------------- + -- Is_Before -- + --------------- + + function Is_Before (M1, M2 : Error_Msg_Id) return Boolean is + E1 : Error_Msg_Object renames Errors.Table (M1); + E2 : Error_Msg_Object renames Errors.Table (M2); + begin + if E1.Sfile /= E2.Sfile then + return E1.Sfile < E2.Sfile; + elsif E1.Sptr.Ptr /= E2.Sptr.Ptr then + return E1.Sptr.Ptr < E2.Sptr.Ptr; + else + return E1.Optr.Ptr < E2.Optr.Ptr; + end if; + end Is_Before; + ------------------------------- -- Is_Size_Too_Small_Message -- ------------------------------- @@ -4111,24 +4127,6 @@ package body Errout is end if; end Set_Posted; - ----------------------- - -- Set_Prev_Pointers -- - ----------------------- - - procedure Set_Prev_Pointers is - Cur : Error_Msg_Id; - Nxt : Error_Msg_Id; - - begin - Cur := First_Error_Msg; - while Cur /= No_Error_Msg loop - Nxt := Errors.Table (Cur).Next; - exit when Nxt = No_Error_Msg; - Errors.Table (Nxt).Prev := Cur; - Cur := Nxt; - end loop; - end Set_Prev_Pointers; - ----------------------- -- Set_Qualification -- ----------------------- diff --git a/gcc/ada/erroutc.adb b/gcc/ada/erroutc.adb index b4f136e54651..b46adc18abcc 100644 --- a/gcc/ada/erroutc.adb +++ b/gcc/ada/erroutc.adb @@ -696,6 +696,32 @@ package body Erroutc is end if; end Next_Continuation_Msg; + ---------------------- + -- Insert_Error_Msg -- + ---------------------- + + procedure Insert_Error_Msg + (Msg : Error_Msg_Id; + Prev_Msg : Error_Msg_Id; + Next_Msg : Error_Msg_Id) + is + begin + Errors.Table (Msg).Prev := Prev_Msg; + Errors.Table (Msg).Next := Next_Msg; + + if Prev_Msg = No_Error_Msg then + First_Error_Msg := Msg; + else + Errors.Table (Prev_Msg).Next := Msg; + end if; + + if Next_Msg = No_Error_Msg then + Last_Error_Msg := Msg; + else + Errors.Table (Next_Msg).Prev := Msg; + end if; + end Insert_Error_Msg; + ---------------------- -- Primary_Location -- ---------------------- diff --git a/gcc/ada/erroutc.ads b/gcc/ada/erroutc.ads index aa49a410590e..3d4e14514dda 100644 --- a/gcc/ada/erroutc.ads +++ b/gcc/ada/erroutc.ads @@ -388,6 +388,13 @@ package Erroutc is -- as the physically last entry in the error message table, since messages -- are not always inserted in sequence. + procedure Insert_Error_Msg + (Msg : Error_Msg_Id; Prev_Msg : Error_Msg_Id; Next_Msg : Error_Msg_Id); + -- Insert Msg into the error message chain between Prev_Msg and Next_Msg. + -- Sets the Next and Prev pointers on Msg, updates the Next pointer of + -- Prev_Msg and the Prev pointer of Next_Msg, and adjusts First_Error_Msg + -- and Last_Error_Msg when Prev_Msg or Next_Msg is No_Error_Msg. + procedure Next_Error_Msg (E : in out Error_Msg_Id); -- Update E to point to the next error message in the list of error -- messages. Skip deleted and continuation messages.
