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 --git a/gcc/ada/libgnat/s-dwalin.adb b/gcc/ada/libgnat/s-dwalin.adb
index 713aad4a304f79c1ec23a91991ef6376318b41e1..75c96619f9940e700f3ec0487257d75214f9ea47 100644 (file)
--- 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 641e515e62f861f67bac16605f86d49a15ba2ed7..17bf0937608ff8f1208cad2d750e6e14790d4475 100644 (file)
--- 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 09026c91efe8c0faf13bb6b80f10ac29b230d093..0c4a036e1398d028040f4dd57fdc5d98ad1f729e 100644 (file)
--- 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