exp_intr.adb (Expand_Source_Name): For Enclosing_Entity...

2005-09-01  Ed Schonberg  <schonberg@adacore.com>

	* exp_intr.adb (Expand_Source_Name): For Enclosing_Entity, generate
	fully qualified name, to distinguish instances with the same local name.

	* g-souinf.ads (Enclosing_Entity): Document that entity name is now
	fully qualified.

From-SVN: r103864

2 files changed, 68 insertions, 25 deletions

diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb
index ea5d74f..5a402fd 100644
--- a/gcc/ada/exp_intr.adb
+++ b/gcc/ada/exp_intr.adb
@@ -490,6 +490,61 @@ package body Exp_Intr is
       Loc : constant Source_Ptr := Sloc (N);
       Ent : Entity_Id;
 
+      procedure Write_Entity_Name (E : Entity_Id);
+      --  Recursive procedure to construct string for qualified name of
+      --  enclosing program unit. The qualification stops at an enclosing
+      --  scope has no source name (block or loop). If entity is a subprogram
+      --  instance, skip enclosing wrapper package.
+
+      -----------------------
+      -- Write_Entity_Name --
+      -----------------------
+
+      procedure Write_Entity_Name (E : Entity_Id) is
+         SDef : Source_Ptr;
+         TDef : constant Source_Buffer_Ptr :=
+                  Source_Text (Get_Source_File_Index (Sloc (E)));
+
+      begin
+         --  Nothing to do if at outer level
+
+         if Scope (E) = Standard_Standard then
+            null;
+
+         --  If scope comes from source, write its name
+
+         elsif Comes_From_Source (Scope (E)) then
+            Write_Entity_Name (Scope (E));
+            Add_Char_To_Name_Buffer ('.');
+
+         --  If in wrapper package skip past it
+
+         elsif Is_Wrapper_Package (Scope (E)) then
+            Write_Entity_Name (Scope (Scope (E)));
+            Add_Char_To_Name_Buffer ('.');
+
+         --  Otherwise nothing to output (happens in unnamed block statements)
+
+         else
+            null;
+         end if;
+
+         --  Loop to output the name
+
+         --  is this right wrt wide char encodings ??? (no!)
+
+         SDef := Sloc (E);
+         while TDef (SDef) in '0' .. '9'
+           or else TDef (SDef) >= 'A'
+           or else TDef (SDef) = ASCII.ESC
+         loop
+            Add_Char_To_Name_Buffer (TDef (SDef));
+            SDef := SDef + 1;
+         end loop;
+      end Write_Entity_Name;
+
+   --  Start of processing for Expand_Source_Info
+
    begin
       --  Integer cases
 
@@ -515,7 +570,7 @@ package body Exp_Intr is
 
                Ent := Current_Scope;
 
-               --  Skip enclosing blocks to reach enclosing unit.
+               --  Skip enclosing blocks to reach enclosing unit
 
                while Present (Ent) loop
                   exit when Ekind (Ent) /= E_Block
@@ -525,22 +580,8 @@ package body Exp_Intr is
 
                --  Ent now points to the relevant defining entity
 
-               declare
-                  SDef : Source_Ptr := Sloc (Ent);
-                  TDef : Source_Buffer_Ptr;
-
-               begin
-                  TDef := Source_Text (Get_Source_File_Index (SDef));
-                  Name_Len := 0;
-
-                  while TDef (SDef) in '0' .. '9'
-                    or else TDef (SDef) >= 'A'
-                    or else TDef (SDef) = ASCII.ESC
-                  loop
-                     Add_Char_To_Name_Buffer (TDef (SDef));
-                     SDef := SDef + 1;
-                  end loop;
-               end;
+               Name_Len := 0;
+               Write_Entity_Name (Ent);
 
             when others =>
                raise Program_Error;
diff --git a/gcc/ada/g-souinf.ads b/gcc/ada/g-souinf.ads
index a04b32b..b49fa80 100644
--- a/gcc/ada/g-souinf.ads
+++ b/gcc/ada/g-souinf.ads
@@ -39,15 +39,15 @@
 --  the name of the source file in which the exception is handled.
 
 package GNAT.Source_Info is
-pragma Pure (Source_Info);
+   pragma Pure;
 
    function File return String;
    --  Return the name of the current file, not including the path information.
    --  The result is considered to be a static string constant.
 
    function Line return Positive;
-   --  Return the current input line number. The result is considered
-   --  to be a static expression.
+   --  Return the current input line number. The result is considered to be a
+   --  static expression.
 
    function Source_Location return String;
    --  Return a string literal of the form "name:line", where name is the
@@ -61,12 +61,14 @@ pragma Pure (Source_Info);
    --  Return the name of the current subprogram, package, task, entry or
    --  protected subprogram. The string is in exactly the form used for the
    --  declaration of the entity (casing and encoding conventions), and is
-   --  considered to be a static string constant.
+   --  considered to be a static string constant. The name is fully qualified
+   --  using periods where possible (this is not always possible, notably in
+   --  the case of entities appearing in unnamed block statements.)
    --
-   --  Note: if this function is used at the outer level of a generic
-   --  package, the string returned will be the name of the instance,
-   --  not the generic package itself. This is useful in identifying
-   --  and logging information from within generic templates.
+   --  Note: if this function is used at the outer level of a generic package,
+   --  the string returned will be the name of the instance, not the generic
+   --  package itself. This is useful in identifying and logging information
+   --  from within generic templates.
 
 private
    pragma Import (Intrinsic, File);