https://gcc.gnu.org/g:0aaff350c25659cba2c1bc86deada888aebbf0d3
commit r16-5651-g0aaff350c25659cba2c1bc86deada888aebbf0d3 Author: Ronan Desplanques <[email protected]> Date: Thu Nov 13 08:16:18 2025 +0100 ada: Fix actual parameters in call A recent patch made Multi_Module_Symbolic_Traceback have two consecutive formal parameters of type Boolean, which opens the door for mixing up actual parameters in calls. And that mistake was actually made in a call introduced by the same patch. This commit fixes the call and also introduces a new enumerated type to make this kind of mistake less likely in the future. gcc/ada/ChangeLog: * libgnat/s-dwalin.ads (Display_Mode_Type): New enumerated type. (Symbolic_Traceback): Use new type in profile. * libgnat/s-dwalin.adb (Symbolic_Traceback): Use new type in profile and adapt body. * libgnat/s-trasym__dwarf.adb (Multi_Module_Symbolic_Traceback): Fix wrong call in body of one overload. Use new type in profile. Adapt body. (Symbolic_Traceback, Symbolic_Traceback_No_Lock, Module_Symbolic_Traceback): Use new type in profile and adapt body. (Calling_Entity): Adapt body. Diff: --- gcc/ada/libgnat/s-dwalin.adb | 8 +- gcc/ada/libgnat/s-dwalin.ads | 18 +++-- gcc/ada/libgnat/s-trasym__dwarf.adb | 144 +++++++++++++++++------------------- 3 files changed, 85 insertions(+), 85 deletions(-) diff --git a/gcc/ada/libgnat/s-dwalin.adb b/gcc/ada/libgnat/s-dwalin.adb index 713aad4a304f..75c96619f994 100644 --- a/gcc/ada/libgnat/s-dwalin.adb +++ b/gcc/ada/libgnat/s-dwalin.adb @@ -1915,7 +1915,7 @@ package body System.Dwarf_Lines is (Cin : Dwarf_Context; Traceback : STE.Tracebacks_Array; Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; + Display_Mode : Display_Mode_Type; Symbol_Found : out Boolean; Res : in out System.Bounded_Strings.Bounded_String) is @@ -1954,7 +1954,7 @@ package body System.Dwarf_Lines is -- If we're not requested to suppress hex addresses, emit it now. - if not Suppress_Hex and then not Subprg_Name_Only then + if not Suppress_Hex and then Display_Mode = Full then Append_Address (Res, Addr_In_Traceback); Append (Res, ' '); end if; @@ -2007,7 +2007,7 @@ package body System.Dwarf_Lines is Append (Res, "???"); end if; - if not Subprg_Name_Only then + if Display_Mode = Full then Append (Res, " at "); Append (Res, String (File_Name (1 .. Last))); Append (Res, ':'); @@ -2023,7 +2023,7 @@ package body System.Dwarf_Lines is Append (Res, "???"); end if; - if not Subprg_Name_Only then + if Display_Mode = Full then Append (Res, " at ???"); end if; end if; diff --git a/gcc/ada/libgnat/s-dwalin.ads b/gcc/ada/libgnat/s-dwalin.ads index 641e515e62f8..17bf0937608f 100644 --- a/gcc/ada/libgnat/s-dwalin.ads +++ b/gcc/ada/libgnat/s-dwalin.ads @@ -79,13 +79,19 @@ package System.Dwarf_Lines is procedure Enable_Cache (C : in out Dwarf_Context); -- Read symbol information to speed up Symbolic_Traceback. + type Display_Mode_Type is (Full, Subprg_Name_Only); + -- This type is used to configure how frames are displayed. + -- In Subprg_Name_Only mode, only the name of the subprogram is displayed + -- for a frame. In Full mode, additional information is displayed on top of + -- that. + procedure Symbolic_Traceback - (Cin : Dwarf_Context; - Traceback : STE.Tracebacks_Array; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Symbol_Found : out Boolean; - Res : in out System.Bounded_Strings.Bounded_String); + (Cin : Dwarf_Context; + Traceback : STE.Tracebacks_Array; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Symbol_Found : out Boolean; + Res : in out System.Bounded_Strings.Bounded_String); -- Generate a string for a traceback suitable for displaying to the user. -- If one or more symbols are found, Symbol_Found is set to True. This -- allows the caller to fall back to hexadecimal addresses. diff --git a/gcc/ada/libgnat/s-trasym__dwarf.adb b/gcc/ada/libgnat/s-trasym__dwarf.adb index 09026c91efe8..0c4a036e1398 100644 --- a/gcc/ada/libgnat/s-trasym__dwarf.adb +++ b/gcc/ada/libgnat/s-trasym__dwarf.adb @@ -96,16 +96,15 @@ package body System.Traceback.Symbolic is -- Initialize Exec_Module if not already initialized function Symbolic_Traceback - (Traceback : System.Traceback_Entries.Tracebacks_Array; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean) return String; + (Traceback : System.Traceback_Entries.Tracebacks_Array; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type) return String; function Symbolic_Traceback (E : Ada.Exceptions.Exception_Occurrence; Suppress_Hex : Boolean) return String; -- Suppress_Hex means do not print any hexadecimal addresses, even if the - -- symbol is not available. Subprg_Name_Only means to only print the - -- subprogram name for each frame, as opposed to the complete description - -- of the frame. + -- symbol is not available. Display_Mode configures how frames for which + -- symbols are available are printed. function Lt (Left, Right : Module_Cache_Acc) return Boolean; -- Sort function for Module_Cache @@ -169,34 +168,34 @@ package body System.Traceback.Symbolic is -- Non-symbolic traceback (simply write addresses in hexa) procedure Symbolic_Traceback_No_Lock - (Traceback : Tracebacks_Array; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String); + (Traceback : Tracebacks_Array; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String); -- Like the public Symbolic_Traceback except there is no provision against -- concurrent accesses. procedure Module_Symbolic_Traceback - (Traceback : Tracebacks_Array; - Module : Module_Cache; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String); + (Traceback : Tracebacks_Array; + Module : Module_Cache; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String); -- Returns the Traceback for a given module procedure Multi_Module_Symbolic_Traceback - (Traceback : Tracebacks_Array; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String); + (Traceback : Tracebacks_Array; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String); -- Build string containing symbolic traceback for the given call chain procedure Multi_Module_Symbolic_Traceback - (Traceback : Tracebacks_Array; - Module : Module_Cache; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String); + (Traceback : Tracebacks_Array; + Module : Module_Cache; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String); -- Likewise but using Module Max_String_Length : constant := 4096; @@ -357,7 +356,9 @@ package body System.Traceback.Symbolic is declare With_Trailing_Newline : constant String := Symbolic_Traceback - (Traceback, Suppress_Hex => True, Subprg_Name_Only => True); + (Traceback, + Suppress_Hex => True, + Display_Mode => Subprg_Name_Only); begin return With_Trailing_Newline @@ -487,31 +488,28 @@ package body System.Traceback.Symbolic is ------------------------------- procedure Module_Symbolic_Traceback - (Traceback : Tracebacks_Array; - Module : Module_Cache; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String) + (Traceback : Tracebacks_Array; + Module : Module_Cache; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String) is Success : Boolean; begin - if Symbolic.Module_Name.Is_Supported and then not Subprg_Name_Only then + if Symbolic.Module_Name.Is_Supported and then Display_Mode = Full then Append (Res, '['); Append (Res, Module.Name.all); Append (Res, ']' & ASCII.LF); end if; Dwarf_Lines.Symbolic_Traceback - (Module.C, - Traceback, - Suppress_Hex, - Subprg_Name_Only, - Success, - Res); + (Module.C, Traceback, Suppress_Hex, Display_Mode, Success, Res); if not Success then Hexa_Traceback - (Traceback, Suppress_Hex or else Subprg_Name_Only, Res); + (Traceback, + Suppress_Hex or else Display_Mode = Subprg_Name_Only, + Res); end if; -- We must not allow an unhandled exception here, since this function @@ -527,10 +525,10 @@ package body System.Traceback.Symbolic is ------------------------------------- procedure Multi_Module_Symbolic_Traceback - (Traceback : Tracebacks_Array; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String) + (Traceback : Tracebacks_Array; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String) is F : constant Natural := Traceback'First; begin @@ -555,8 +553,8 @@ package body System.Traceback.Symbolic is Multi_Module_Symbolic_Traceback (Traceback, Modules_Cache (Mid).all, - Subprg_Name_Only, Suppress_Hex, + Display_Mode, Res); return; else @@ -569,7 +567,7 @@ package body System.Traceback.Symbolic is Multi_Module_Symbolic_Traceback (Traceback (F + 1 .. Traceback'Last), Suppress_Hex, - Subprg_Name_Only, + Display_Mode, Res); end; else @@ -577,7 +575,7 @@ package body System.Traceback.Symbolic is -- First try the executable if Is_Inside (Exec_Module.C, Traceback (F)) then Multi_Module_Symbolic_Traceback - (Traceback, Exec_Module, Suppress_Hex, Subprg_Name_Only, Res); + (Traceback, Exec_Module, Suppress_Hex, Display_Mode, Res); return; end if; @@ -593,7 +591,7 @@ package body System.Traceback.Symbolic is Init_Module (Module, Success, M_Name, Load_Addr); if Success then Multi_Module_Symbolic_Traceback - (Traceback, Module, Suppress_Hex, Subprg_Name_Only, Res); + (Traceback, Module, Suppress_Hex, Display_Mode, Res); Close_Module (Module); else -- Module not found @@ -601,7 +599,7 @@ package body System.Traceback.Symbolic is Multi_Module_Symbolic_Traceback (Traceback (F + 1 .. Traceback'Last), Suppress_Hex, - Subprg_Name_Only, + Display_Mode, Res); end if; end; @@ -609,11 +607,11 @@ package body System.Traceback.Symbolic is end Multi_Module_Symbolic_Traceback; procedure Multi_Module_Symbolic_Traceback - (Traceback : Tracebacks_Array; - Module : Module_Cache; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String) + (Traceback : Tracebacks_Array; + Module : Module_Cache; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String) is Pos : Positive; begin @@ -638,13 +636,10 @@ package body System.Traceback.Symbolic is (Traceback (Traceback'First .. Pos - 1), Module, Suppress_Hex, - Subprg_Name_Only, + Display_Mode, Res); Multi_Module_Symbolic_Traceback - (Traceback (Pos .. Traceback'Last), - Suppress_Hex, - Subprg_Name_Only, - Res); + (Traceback (Pos .. Traceback'Last), Suppress_Hex, Display_Mode, Res); end Multi_Module_Symbolic_Traceback; -------------------- @@ -674,22 +669,24 @@ package body System.Traceback.Symbolic is -------------------------------- procedure Symbolic_Traceback_No_Lock - (Traceback : Tracebacks_Array; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean; - Res : in out Bounded_String) is + (Traceback : Tracebacks_Array; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type; + Res : in out Bounded_String) is begin if Symbolic.Module_Name.Is_Supported then Multi_Module_Symbolic_Traceback - (Traceback, Suppress_Hex, Subprg_Name_Only, Res); + (Traceback, Suppress_Hex, Display_Mode, Res); else if Exec_Module_State = Failed then Append (Res, "Call stack traceback locations:" & ASCII.LF); Hexa_Traceback - (Traceback, Suppress_Hex or else Subprg_Name_Only, Res); + (Traceback, + Suppress_Hex or else Display_Mode = Subprg_Name_Only, + Res); else Module_Symbolic_Traceback - (Traceback, Exec_Module, Suppress_Hex, Subprg_Name_Only, Res); + (Traceback, Exec_Module, Suppress_Hex, Display_Mode, Res); end if; end if; end Symbolic_Traceback_No_Lock; @@ -702,9 +699,9 @@ package body System.Traceback.Symbolic is -- Copied from Ada.Exceptions.Exception_Data function Symbolic_Traceback - (Traceback : Tracebacks_Array; - Suppress_Hex : Boolean; - Subprg_Name_Only : Boolean) return String + (Traceback : Tracebacks_Array; + Suppress_Hex : Boolean; + Display_Mode : Display_Mode_Type) return String is Load_Address : constant Address := Get_Executable_Load_Address; Res : Bounded_String (Max_Length => Max_String_Length); @@ -712,13 +709,12 @@ package body System.Traceback.Symbolic is begin System.Soft_Links.Lock_Task.all; Init_Exec_Module; - if not Subprg_Name_Only and then Load_Address /= Null_Address then + if Display_Mode = Full and then Load_Address /= Null_Address then Append (Res, LDAD_Header); Append_Address (Res, Load_Address); Append (Res, ASCII.LF); end if; - Symbolic_Traceback_No_Lock - (Traceback, Suppress_Hex, Subprg_Name_Only, Res); + Symbolic_Traceback_No_Lock (Traceback, Suppress_Hex, Display_Mode, Res); System.Soft_Links.Unlock_Task.all; return To_String (Res); @@ -734,7 +730,7 @@ package body System.Traceback.Symbolic is begin return Symbolic_Traceback - (Traceback, Suppress_Hex => False, Subprg_Name_Only => False); + (Traceback, Suppress_Hex => False, Display_Mode => Full); end Symbolic_Traceback; function Symbolic_Traceback_No_Hex @@ -742,7 +738,7 @@ package body System.Traceback.Symbolic is begin return Symbolic_Traceback - (Traceback, Suppress_Hex => True, Subprg_Name_Only => False); + (Traceback, Suppress_Hex => True, Display_Mode => Full); end Symbolic_Traceback_No_Hex; function Symbolic_Traceback @@ -752,9 +748,7 @@ package body System.Traceback.Symbolic is begin return Symbolic_Traceback - (Ada.Exceptions.Traceback.Tracebacks (E), - Suppress_Hex, - False); + (Ada.Exceptions.Traceback.Tracebacks (E), Suppress_Hex, Full); end Symbolic_Traceback; function Symbolic_Traceback
