OSDN Git Service

2010-10-11 Gary Dismukes <dismukes@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / lib-xref.adb
index 0e45e2e..02af70c 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1998-2009, Free Software Foundation, Inc.         --
+--          Copyright (C) 1998-2010, 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- --
@@ -214,7 +214,6 @@ package body Lib.Xref is
       Base_T    : Entity_Id;
       Prim      : Elmt_Id;
       Prim_List : Elist_Id;
-      Ent       : Entity_Id;
 
    begin
       --  Handle subtypes of synchronized types
@@ -262,12 +261,8 @@ package body Lib.Xref is
          --  reference purposes (it is the original for which we want the xref
          --  and for which the comes_from_source test must be performed).
 
-         Ent := Node (Prim);
-         while Present (Alias (Ent)) loop
-            Ent := Alias (Ent);
-         end loop;
-
-         Generate_Reference (Typ, Ent, 'p', Set_Ref => False);
+         Generate_Reference
+           (Typ, Ultimate_Alias (Node (Prim)), 'p', Set_Ref => False);
          Next_Elmt (Prim);
       end loop;
    end Generate_Prim_Op_References;
@@ -473,13 +468,25 @@ package body Lib.Xref is
 
       if Comes_From_Source (N)
         and then Is_Ada_2005_Only (E)
-        and then Ada_Version < Ada_05
+        and then Ada_Version < Ada_2005
         and then Warn_On_Ada_2005_Compatibility
-        and then (Typ = 'm' or else Typ = 'r')
+        and then (Typ = 'm' or else Typ = 'r' or else Typ = 's')
       then
          Error_Msg_NE ("& is only defined in Ada 2005?", N, E);
       end if;
 
+      --  Warn if reference to Ada 2012 entity not in Ada 2012 mode. We only
+      --  detect real explicit references (modifications and references).
+
+      if Comes_From_Source (N)
+        and then Is_Ada_2012_Only (E)
+        and then Ada_Version < Ada_2012
+        and then Warn_On_Ada_2012_Compatibility
+        and then (Typ = 'm' or else Typ = 'r')
+      then
+         Error_Msg_NE ("& is only defined in Ada 2012?", N, E);
+      end if;
+
       --  Never collect references if not in main source unit. However, we omit
       --  this test if Typ is 'e' or 'k', since these entries are structural,
       --  and it is useful to have them in units that reference packages as
@@ -666,7 +673,7 @@ package body Lib.Xref is
          --  Check for pragma Unreferenced given and reference is within
          --  this source unit (occasion for possible warning to be issued).
 
-         if Has_Pragma_Unreferenced (E)
+         if Has_Unreferenced (E)
            and then In_Same_Extended_Unit (E, N)
          then
             --  A reference as a named parameter in a call does not count
@@ -699,7 +706,7 @@ package body Lib.Xref is
                   BE := First_Entity (Current_Scope);
                   while Present (BE) loop
                      if Chars (BE) = Chars (E) then
-                        Error_Msg_NE
+                        Error_Msg_NE -- CODEFIX
                           ("?pragma Unreferenced given for&!", N, BE);
                         exit;
                      end if;
@@ -711,7 +718,8 @@ package body Lib.Xref is
             --  Here we issue the warning, since this is a real reference
 
             else
-               Error_Msg_NE ("?pragma Unreferenced given for&!", N, E);
+               Error_Msg_NE -- CODEFIX
+                 ("?pragma Unreferenced given for&!", N, E);
             end if;
          end if;
 
@@ -1464,7 +1472,6 @@ package body Lib.Xref is
 
             if Name_Len /= Curlen then
                return True;
-
             else
                return Name_Buffer (1 .. Curlen) /= Curnam (1 .. Curlen);
             end if;
@@ -1543,7 +1550,7 @@ package body Lib.Xref is
                --  Used for {} or <> or () for type reference
 
                procedure Check_Type_Reference
-                 (Ent : Entity_Id;
+                 (Ent            : Entity_Id;
                   List_Interface : Boolean);
                --  Find whether there is a meaningful type reference for
                --  Ent, and display it accordingly. If List_Interface is
@@ -1565,7 +1572,7 @@ package body Lib.Xref is
                --------------------------
 
                procedure Check_Type_Reference
-                 (Ent : Entity_Id;
+                 (Ent            : Entity_Id;
                   List_Interface : Boolean)
                is
                begin
@@ -1704,10 +1711,7 @@ package body Lib.Xref is
                      --  through several levels of derivation, so find the
                      --  ultimate (source) ancestor.
 
-                     Op := Alias (Old_E);
-                     while Present (Alias (Op)) loop
-                        Op := Alias (Op);
-                     end loop;
+                     Op := Ultimate_Alias (Old_E);
 
                   --  Normal case of no alias present
 
@@ -1805,27 +1809,25 @@ package body Lib.Xref is
                      Ctyp := '*';
                   end if;
 
-                  --  Special handling for access parameter
-
-                  declare
-                     K : constant Entity_Kind := Ekind (Etype (XE.Ent));
+                  --  Special handling for access parameters and objects of
+                  --  an anonymous access type.
 
-                  begin
-                     if (K = E_Anonymous_Access_Type
-                           or else
-                         K = E_Anonymous_Access_Subprogram_Type
-                            or else K =
-                         E_Anonymous_Access_Protected_Subprogram_Type)
-                       and then Is_Formal (XE.Ent)
+                  if Ekind_In (Etype (XE.Ent),
+                               E_Anonymous_Access_Type,
+                               E_Anonymous_Access_Subprogram_Type,
+                               E_Anonymous_Access_Protected_Subprogram_Type)
+                  then
+                     if Is_Formal (XE.Ent)
+                       or else Ekind_In (XE.Ent, E_Variable, E_Constant)
                      then
                         Ctyp := 'p';
+                     end if;
 
-                        --  Special handling for Boolean
+                     --  Special handling for Boolean
 
-                     elsif Ctyp = 'e' and then Is_Boolean_Type (Ent) then
-                        Ctyp := 'b';
-                     end if;
-                  end;
+                  elsif Ctyp = 'e' and then Is_Boolean_Type (Ent) then
+                     Ctyp := 'b';
+                  end if;
                end if;
 
                --  Special handling for abstract types and operations
@@ -2138,6 +2140,7 @@ package body Lib.Xref is
 
                         begin
                            Write_Info_Char ('[');
+
                            if Curru /= Gen_U then
                               Write_Info_Nat (Dependency_Num (Gen_U));
                               Write_Info_Char ('|');
@@ -2231,7 +2234,7 @@ package body Lib.Xref is
                         Output_Import_Export_Info (XE.Ent);
                      end if;
 
-                     Write_Info_Nat  (Int (Get_Column_Number (XE.Loc)));
+                     Write_Info_Nat (Int (Get_Column_Number (XE.Loc)));
 
                      Output_Instantiation_Refs (Sloc (XE.Ent));
                   end if;