lib-xref.ads, [...] (Generate_Definition): Treat any entity declared within an inlined body as referenced...

2005-06-14  Ed Schonberg  <schonberg@adacore.com>
	    Emmanuel Briot  <briot@adacore.com>

	* lib-xref.ads, lib-xref.adb (Generate_Definition): Treat any entity
	declared within an inlined body as referenced, to prevent spurious
	warnings.
	(Output_One_Ref): If an entity renames an array component, indicate in
	the ALI file that this aliases (renames) the array. Capture as well
	function renamings that rename predefined operations.
	Add information about generic parent for package and subprogram
	instances.
	(Get_Type_Reference): For a subtype that is the renaming of an actual in
	an instantiation, use the first_subtype to ensure that we don't generate
	cross-reference information for internal types.
	For objects and parameters of a generic private type, retain the '*'
	indicator to distinguish such an entity from its type.

        * ali.ads (Xref_Entity_Record): New fields Iref_File_Num and Iref_Line,
        to store information about instantiated entities.

        * ali.adb (Scan_ALI): Add support for parsing the reference to the
        generic parent

        * xref_lib.adb (Skip_To_Matching_Closing_Bracket): New subprogram
        (Parse_Identifier_Info, Parse_Token): Add support for the generic parent
        information.

From-SVN: r101046

1 files changed, 66 insertions, 7 deletions

diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index 5afc12b..78e14b2 100644
--- a/gcc/ada/lib-xref.adb
+++ b/gcc/ada/lib-xref.adb
@@ -34,6 +34,7 @@ with Nlists;   use Nlists;
 with Opt;      use Opt;
 with Restrict; use Restrict;
 with Rident;   use Rident;
+with Sem;      use Sem;
 with Sem_Prag; use Sem_Prag;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
@@ -133,6 +134,10 @@ package body Lib.Xref is
          Xrefs.Table (Indx).Eun := Get_Source_Unit (Loc);
          Xrefs.Table (Indx).Lun := No_Unit;
          Set_Has_Xref_Entry (E);
+
+         if In_Inlined_Body then
+            Set_Referenced (E);
+         end if;
       end if;
    end Generate_Definition;
 
@@ -269,7 +274,10 @@ package body Lib.Xref is
 
       --  Warn if reference to Ada 2005 entity not in Ada 2005 mode
 
-      if Is_Ada_2005 (E) and then Ada_Version < Ada_05 then
+      if Is_Ada_2005 (E)
+        and then Ada_Version < Ada_05
+        and then Warn_On_Ada_2005_Compatibility
+      then
          Error_Msg_NE ("& is only defined in Ada 2005?", N, E);
       end if;
 
@@ -534,7 +542,7 @@ package body Lib.Xref is
 
          Xrefs.Table (Indx).Loc := Ref;
 
-         --  Overriding operations are marked with 'P'.
+         --  Overriding operations are marked with 'P'
 
          if Typ = 'p'
            and then Is_Subprogram (N)
@@ -723,7 +731,7 @@ package body Lib.Xref is
                      exit;
                   end if;
 
-               --  For a subtype, go to ancestor subtype.
+               --  For a subtype, go to ancestor subtype
 
                else
                   Tref := Ancestor_Subtype (Tref);
@@ -778,7 +786,7 @@ package body Lib.Xref is
                   (Is_Wrapper_Package (Scope (Tref))
                      or else Is_Generic_Instance (Scope (Tref)))
                then
-                  Tref := Base_Type (Tref);
+                  Tref := First_Subtype (Base_Type (Tref));
                end if;
 
                return;
@@ -810,7 +818,7 @@ package body Lib.Xref is
             Language_Name := Name_Ada;
 
          else
-            --  These are the only languages that GPS knows about.
+            --  These are the only languages that GPS knows about
 
             return;
          end if;
@@ -1260,6 +1268,14 @@ package body Lib.Xref is
                      if Present (Ent) then
                         Ctyp := Fold_Lower (Xref_Entity_Letters (Ekind (Ent)));
                      end if;
+
+                  elsif Is_Generic_Type (Ent) then
+
+                     --  If the type of the entity is a  generic private type
+                     --  there is no usable full view, so retain the indication
+                     --  that this is an object.
+
+                     Ctyp := '*';
                   end if;
 
                   --  Special handling for access parameter
@@ -1285,7 +1301,7 @@ package body Lib.Xref is
                   end;
                end if;
 
-               --  Special handling for abstract types and operations.
+               --  Special handling for abstract types and operations
 
                if Is_Abstract (XE.Ent) then
 
@@ -1524,7 +1540,25 @@ package body Lib.Xref is
                            Rref := Selector_Name (Rref);
                         end if;
 
-                        if Nkind (Rref) /= N_Identifier then
+                        if Nkind (Rref) = N_Identifier
+                          or else Nkind (Rref) = N_Operator_Symbol
+                        then
+                           null;
+
+                        --  For renamed array components, use the array name
+                        --  for the renamed entity, which reflect the fact that
+                        --  in general the whole array is aliased.
+
+                        elsif Nkind (Rref) = N_Indexed_Component then
+                           if Nkind (Prefix (Rref)) = N_Identifier then
+                              Rref := Prefix (Rref);
+                           elsif Nkind (Prefix (Rref)) = N_Expanded_Name then
+                              Rref := Selector_Name (Prefix (Rref));
+                           else
+                              Rref := Empty;
+                           end if;
+
+                        else
                            Rref := Empty;
                         end if;
                      end if;
@@ -1545,6 +1579,31 @@ package body Lib.Xref is
 
                      Curru := Curxu;
 
+                     --  Write out information about generic parent,
+                     --  if entity is an instance.
+
+                     if  Is_Generic_Instance (XE.Ent) then
+                        declare
+                           Gen_Par : constant Entity_Id :=
+                             Generic_Parent
+                               (Specification
+                                  (Unit_Declaration_Node (XE.Ent)));
+                           Loc : constant Source_Ptr := Sloc (Gen_Par);
+                           Gen_U : constant Unit_Number_Type :=
+                                     Get_Source_Unit (Loc);
+                        begin
+                           Write_Info_Char ('[');
+                           if Curru /= Gen_U then
+                              Write_Info_Nat (Dependency_Num (Gen_U));
+                              Write_Info_Char ('|');
+                           end if;
+
+                           Write_Info_Nat
+                             (Int (Get_Logical_Line_Number (Loc)));
+                           Write_Info_Char (']');
+                        end;
+                     end if;
+
                      --  See if we have a type reference and if so output
 
                      Get_Type_Reference (XE.Ent, Tref, Left, Right);