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.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@101046 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 161 insertions, 31 deletions

diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index 4c8a08b05a8..22c5e526968 100644
--- a/gcc/ada/ali.adb
+++ b/gcc/ada/ali.adb
@@ -439,6 +439,7 @@ package body ALI is
                  or else Nextc = '(' or else Nextc = ')'
                  or else Nextc = '{' or else Nextc = '}'
                  or else Nextc = '<' or else Nextc = '>'
+                 or else Nextc = '[' or else Nextc = ']'
                  or else Nextc = '=';
             end if;
          end loop;
@@ -1886,6 +1887,31 @@ package body ALI is
                   XE.Lib    := (Getc = '*');
                   XE.Entity := Get_Name;
 
+                  --  Handle the information about generic instantiations
+
+                  if Nextc = '[' then
+                     Skipc; --  Opening '['
+                     N := Get_Nat;
+
+                     if Nextc /= '|' then
+                        XE.Iref_File_Num := Current_File_Num;
+                        XE.Iref_Line     := N;
+                     else
+                        XE.Iref_File_Num :=
+                          Sdep_Id (N + Nat (First_Sdep_Entry) - 1);
+                        Skipc;
+                        XE.Iref_Line := Get_Nat;
+                     end if;
+
+                     if Getc /= ']' then
+                        Fatal_Error;
+                     end if;
+
+                  else
+                     XE.Iref_File_Num := No_Sdep_Id;
+                     XE.Iref_Line     := 0;
+                  end if;
+
                   Current_File_Num := XS.File_Num;
 
                   --  Renaming reference is present
diff --git a/gcc/ada/ali.ads b/gcc/ada/ali.ads
index cab4b062365..91ecd2dd16c 100644
--- a/gcc/ada/ali.ads
+++ b/gcc/ada/ali.ads
@@ -593,7 +593,7 @@ package ALI is
       --  ALI File containing tne entry
 
       No_Dep_Unit : Name_Id;
-      --  Id for names table entry including entire name, including periods.
+      --  Id for names table entry including entire name, including periods
    end record;
 
    package No_Deps is new Table.Table (
@@ -731,6 +731,16 @@ package ALI is
       Entity : Name_Id;
       --  Name of entity
 
+      Iref_File_Num : Sdep_Id;
+      --  This field is set to the dependency reference for the file containing
+      --  the generic entity that this one instantiates, or to No_Sdep_Id if
+      --  the current entity is not an instantiation
+
+      Iref_Line : Nat;
+      --  This field is set to the line number in Iref_File_Num of the generic
+      --  entity that this one instantiates, or to zero if the current entity
+      --  is not an instantiation.
+
       Rref_Line : Nat;
       --  This field is set to the line number of a renaming reference if
       --  one is present, or to zero if no renaming reference is present
@@ -815,6 +825,11 @@ package ALI is
 
       --  Note: for instantiation references, Rtype is set to ' ', and Col is
       --  set to zero. One or more such entries can follow any other reference.
+      --  When there is more than one such entry, this is to be read as:
+      --     e.g. ref1  ref2  ref3
+      --     ref1 is a reference to an entity that was instantied at ref2.
+      --     ref2 itself is also the result of an instantiation, that took
+      --     place at ref3
    end record;
 
    package Xref is new Table.Table (
@@ -848,7 +863,8 @@ package ALI is
    --
    --    Ignore_ED is normally False. If set to True, it indicates that
    --    all ED (elaboration desirable) indications in the ALI file are
-   --    to be ignored.
+   --    to be ignored. This parameter is obsolete now that the -f switch
+   --    is removed from gnatbind, and should be removed ???
    --
    --    Err determines the action taken on an incorrectly formatted file.
    --    If Err is False, then an error message is output, and the program
diff --git a/gcc/ada/lib-xref.adb b/gcc/ada/lib-xref.adb
index 5afc12bf13f..78e14b2d493 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);
diff --git a/gcc/ada/lib-xref.ads b/gcc/ada/lib-xref.ads
index 59c703fb78e..1a0055e5c2b 100644
--- a/gcc/ada/lib-xref.ads
+++ b/gcc/ada/lib-xref.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1998-2004, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2005, 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- --
@@ -54,7 +54,7 @@ package Lib.Xref is
 
    --  The lines following the header look like
 
-   --     line type col level entity renameref typeref ref  ref  ref
+   --     line type col level entity renameref instref typeref ref  ref  ref
 
    --        line is the line number of the referenced entity. The name of
    --        the entity starts in column col. Columns are numbered from one,
@@ -93,6 +93,17 @@ package Lib.Xref is
    --        reference is a complex expressions, then renameref is omitted.
    --        Here line/col give line/column as defined above.
 
+   --        instref is only present for package and subprogram instances.
+   --        The information in instref is the location of the point of
+   --        declaration of the generic parent unit. This part has the form:
+
+   --            [file|line]
+
+   --        without column information, on the reasonable assumption that
+   --        there is only one unit per line (the same assumption is made
+   --        in references to entities that are declared within instances,
+   --        see below).
+
    --        typeref is the reference for a related type. This part is
    --        optional. It is present for the following cases:
 
@@ -130,7 +141,7 @@ package Lib.Xref is
 
    --           line is the line number of the reference
 
-   --           col is the column number of the reference, as defined above.
+   --           col is the column number of the reference, as defined above
 
    --           type is one of
    --              b = body entity
@@ -296,7 +307,7 @@ package Lib.Xref is
    --              the END line of the body has an explict reference to
    --              the name of the procedure at line 12, column 13.
 
-   --              the body ends at line 12, column 15, just past this label.
+   --              the body ends at line 12, column 15, just past this label
 
    --        16I9*My_Type<2|4I9> 18r8
 
@@ -350,7 +361,9 @@ package Lib.Xref is
    --  For private types, the character + appears in the table. In this
    --  case the kind of the underlying type is used, if available, to
    --  determine the character to use in the xref listing. The listing
-   --  will still include a '+' for a generic private type, for example.
+   --  will still include a '+' for a generic private type, for example,
+   --  but will retain the '*' for an object or formal parameter of such
+   --  a type.
 
    --  For subprograms, the characters 'U' and 'V' appear in the table,
    --  indicating procedures and functions. If the operation is abstract,
@@ -597,6 +610,6 @@ package Lib.Xref is
    --  Output references to the current ali file
 
    procedure Initialize;
-   --  Initialize internal tables.
+   --  Initialize internal tables
 
 end Lib.Xref;
diff --git a/gcc/ada/xref_lib.adb b/gcc/ada/xref_lib.adb
index 5b953e441e1..b6054b62285 100644
--- a/gcc/ada/xref_lib.adb
+++ b/gcc/ada/xref_lib.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2003 Free Software Foundation, Inc.          --
+--          Copyright (C) 1998-2005 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- --
@@ -755,6 +755,10 @@ package body Xref_Lib is
       --  to parse the ali file again because the parent entity is not in
       --  the declaration table if it did not match the search pattern.
 
+      procedure Skip_To_Matching_Closing_Bracket;
+      --  When Ptr points to an opening square bracket, moves it to the
+      --  character following the matching closing bracket
+
       ---------------------
       -- Get_Symbol_Name --
       ---------------------
@@ -806,6 +810,27 @@ package body Xref_Lib is
          return "???";
       end Get_Symbol_Name;
 
+      --------------------------------------
+      -- Skip_To_Matching_Closing_Bracket --
+      --------------------------------------
+
+      procedure Skip_To_Matching_Closing_Bracket is
+         Num_Brackets : Natural;
+
+      begin
+         Num_Brackets := 1;
+         while Num_Brackets /= 0 loop
+            Ptr := Ptr + 1;
+            if Ali (Ptr) = '[' then
+               Num_Brackets := Num_Brackets + 1;
+            elsif Ali (Ptr) = ']' then
+               Num_Brackets := Num_Brackets - 1;
+            end if;
+         end loop;
+
+         Ptr := Ptr + 1;
+      end Skip_To_Matching_Closing_Bracket;
+
    --  Start of processing for Parse_Identifier_Info
 
    begin
@@ -862,7 +887,10 @@ package body Xref_Lib is
       Decl_Ref := Add_Declaration
         (File.X_File, Ali (E_Name .. Ptr - 1), E_Line, E_Col, E_Type);
 
-      if Ali (Ptr) = '<'
+      if Ali (Ptr) = '[' then
+         Skip_To_Matching_Closing_Bracket;
+
+      elsif Ali (Ptr) = '<'
         or else Ali (Ptr) = '('
         or else Ali (Ptr) = '{'
       then
@@ -918,20 +946,7 @@ package body Xref_Lib is
                --  Skip the information for generics instantiations
 
                if Ali (Ptr) = '[' then
-                  declare
-                     Num_Brackets : Natural := 1;
-                  begin
-                     while Num_Brackets /= 0 loop
-                        Ptr := Ptr + 1;
-                        if Ali (Ptr) = '[' then
-                           Num_Brackets := Num_Brackets + 1;
-                        elsif Ali (Ptr) = ']' then
-                           Num_Brackets := Num_Brackets - 1;
-                        end if;
-                     end loop;
-
-                     Ptr := Ptr + 1;
-                  end;
+                  Skip_To_Matching_Closing_Bracket;
                end if;
 
                --  Skip '>', or ')' or '>'
@@ -1169,6 +1184,7 @@ package body Xref_Lib is
                      or else Source (Ptr) = ASCII.HT
                      or else Source (Ptr) = '<'
                      or else Source (Ptr) = '{'
+                     or else Source (Ptr) = '['
                      or else Source (Ptr) = '='
                      or else Source (Ptr) = '('))
         and then Source (Ptr) >= ' '