2007-10-15 Emmanuel Briot <briot@adacore.com>

[pf3gnuchains/gcc-fork.git] / gcc / ada / ali.adb

diff --git a/gcc/ada/ali.adb b/gcc/ada/ali.adb
index 6d4b551..2605301 100644 (file)
--- a/gcc/ada/ali.adb
+++ b/gcc/ada/ali.adb
@@ -2174,35 +2174,82 @@ package body ALI is
 
                   Skip_Space;
 
-                  --  See if type reference present
-
-                  Get_Typeref
-                    (Current_File_Num, XE.Tref, XE.Tref_File_Num, XE.Tref_Line,
-                     XE.Tref_Type, XE.Tref_Col, XE.Tref_Standard_Entity);
-
-                  --  Do we have an overriding procedure, instead ?
-                  if XE.Tref_Type = 'p' then
-                     XE.Oref_File_Num := XE.Tref_File_Num;
-                     XE.Oref_Line     := XE.Tref_Line;
-                     XE.Oref_Col      := XE.Tref_Col;
-                     XE.Tref_File_Num := No_Sdep_Id;
-                     XE.Tref          := Tref_None;
-                  else
-                     --  We might have additional information about the
-                     --  overloaded subprograms
+                  XE.Oref_File_Num := No_Sdep_Id;
+                  XE.Tref_File_Num := No_Sdep_Id;
+                  XE.Tref          := Tref_None;
+                  XE.First_Xref    := Xref.Last + 1;
+
+                  --  Loop to check for additional info present
+
+                  loop
                      declare
-                        Ref : Tref_Kind;
-                        Typ : Character;
-                        Standard_Entity : Name_Id;
+                        Ref  : Tref_Kind;
+                        File : Sdep_Id;
+                        Line : Nat;
+                        Typ  : Character;
+                        Col  : Nat;
+                        Std  : Name_Id;
+
                      begin
                         Get_Typeref
-                          (Current_File_Num,
-                           Ref, XE.Oref_File_Num,
-                           XE.Oref_Line, Typ, XE.Oref_Col, Standard_Entity);
-                     end;
-                  end if;
+                          (Current_File_Num, Ref, File, Line, Typ, Col, Std);
+                        exit when Ref = Tref_None;
+
+                        --  Do we have an overriding procedure?
+
+                        if Ref = Tref_Derived and then Typ = 'p' then
+                           XE.Oref_File_Num := File;
+                           XE.Oref_Line     := Line;
+                           XE.Oref_Col      := Col;
+
+                        --  Arrays never override anything, and <> points to
+                        --  the index types instead
+
+                        elsif Ref = Tref_Derived and then XE.Etype = 'A' then
+
+                           --  Index types are stored in the list of references
+
+                           Xref.Increment_Last;
+
+                           declare
+                              XR : Xref_Record renames Xref.Table (Xref.Last);
+                           begin
+                              XR.File_Num := File;
+                              XR.Line     := Line;
+                              XR.Rtype    := Array_Index_Reference;
+                              XR.Col      := Col;
+                              XR.Name     := Std;
+                           end;
+
+                        --  Interfaces are stored in the list of references,
+                        --  although the parent type itself is stored in XE
+
+                        elsif Ref = Tref_Derived
+                          and then Typ = 'R'
+                          and then XE.Tref_File_Num /= No_Sdep_Id
+                        then
+                           Xref.Increment_Last;
+
+                           declare
+                              XR : Xref_Record renames Xref.Table (Xref.Last);
+                           begin
+                              XR.File_Num := File;
+                              XR.Line     := Line;
+                              XR.Rtype    := Interface_Reference;
+                              XR.Col      := Col;
+                              XR.Name     := Std;
+                           end;
 
-                  XE.First_Xref := Xref.Last + 1;
+                        else
+                           XE.Tref                 := Ref;
+                           XE.Tref_File_Num        := File;
+                           XE.Tref_Line            := Line;
+                           XE.Tref_Type            := Typ;
+                           XE.Tref_Col             := Col;
+                           XE.Tref_Standard_Entity := Std;
+                        end if;
+                     end;
+                  end loop;
 
                   --  Loop through cross-references for this entity