From: Ronan Desplanques <[email protected]>
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.
Tested on x86_64-pc-linux-gnu, committed on master.
---
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 713aad4a304..75c96619f99 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 641e515e62f..17bf0937608 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 09026c91efe..0c4a036e139 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
--
2.51.0
