diff mbox

[Ada] Add new debug procedure psloc

Message ID 20120717095029.GA7820@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet July 17, 2012, 9:50 a.m. UTC 
Add a new debug procedure psloc, to display a source location.

Tested on x86_64-pc-linux-gnu, committed on trunk

2012-07-17  Tristan Gingold  <gingold@adacore.com>

	* treepr.ads (psloc): Declare.
	* treepr.adb (psloc): New debug procedure to print a sloc.
	(Print_Sloc): New procedure, from ...
	(Print_Node_Subtree): ... this.  Call Print_Sloc.
diff mbox

Patch

Index: treepr.adb
===================================================================
--- treepr.adb	(revision 189565)
+++ treepr.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -188,6 +188,9 @@ 
    --  level and the bars used to link list elements). In addition, for lines
    --  other than the first, an additional character Prefix_Char is output.
 
+   procedure Print_Sloc (Loc : Source_Ptr);
+   --  Print the human readable representation of Loc
+
    function Serial_Number (Id : Int) return Nat;
    --  Given a Node_Id, List_Id or Elist_Id, returns the previously assigned
    --  serial number, or zero if no serial number has yet been assigned.
@@ -887,7 +890,6 @@ 
       Field_To_Be_Printed : Boolean;
       Prefix_Str_Char     : String (Prefix_Str'First .. Prefix_Str'Last + 1);
 
-      Sfile : Source_File_Index;
       Fmt   : UI_Format;
 
    begin
@@ -933,20 +935,7 @@ 
          Print_Str (Prefix_Str_Char);
          Print_Str ("Sloc = ");
 
-         if Sloc (N) = Standard_Location then
-            Print_Str ("Standard_Location");
-
-         elsif Sloc (N) = Standard_ASCII_Location then
-            Print_Str ("Standard_ASCII_Location");
-
-         else
-            Sfile := Get_Source_File_Index (Sloc (N));
-            Print_Int (Int (Sloc (N)) - Int (Source_Text (Sfile)'First));
-            Write_Str ("  ");
-            Write_Location (Sloc (N));
-         end if;
-
-         Print_Eol;
+         Print_Sloc (Sloc (N));
       end if;
 
       --  Print Chars field if present
@@ -1397,6 +1386,30 @@ 
       Print_Term;
    end Print_Node_Subtree;
 
+   ----------------
+   -- Print_Sloc --
+   ----------------
+
+   procedure Print_Sloc (Loc : Source_Ptr) is
+      Sfile : Source_File_Index;
+
+   begin
+      if Loc = Standard_Location then
+         Print_Str ("Standard_Location");
+
+      elsif Loc = Standard_ASCII_Location then
+         Print_Str ("Standard_ASCII_Location");
+
+      else
+         Sfile := Get_Source_File_Index (Loc);
+         Print_Int (Int (Loc) - Int (Source_Text (Sfile)'First));
+         Write_Str ("  ");
+         Write_Location (Loc);
+      end if;
+
+      Print_Eol;
+   end Print_Sloc;
+
    ---------------
    -- Print_Str --
    ---------------
@@ -1524,6 +1537,16 @@ 
       Print_Node (N, Label, ' ');
    end Print_Tree_Node;
 
+   -----------
+   -- psloc --
+   -----------
+
+   procedure psloc (Loc : Source_Ptr) is
+   begin
+      Phase := Printing;
+      Print_Sloc (Loc);
+   end psloc;
+
    --------
    -- pt --
    --------
Index: treepr.ads
===================================================================
--- treepr.ads	(revision 189565)
+++ treepr.ads	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -71,6 +71,10 @@ 
    pragma Export (Ada, ppp);
    --  Same as Print_Node_Subtree
 
+   procedure psloc (Loc : Source_Ptr);
+   pragma Export (Ada, psloc);
+   --  Prints the sloc Loc
+
    --  The following are no longer needed; you can use pp or ppp instead
 
    procedure pe (E : Elist_Id);