From dbe7d6a179f1468d4b2cd198fde7f88329356bbb Mon Sep 17 00:00:00 2001 From: charlet Date: Mon, 5 Sep 2005 07:54:01 +0000 Subject: [PATCH] 2005-09-01 Ed Schonberg * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@103864 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/exp_intr.adb | 75 ++++++++++++++++++++++++++++++++++++++++------------ gcc/ada/g-souinf.ads | 18 +++++++------ 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); -- 2.7.4