* g++.old-deja/g++.benjamin/16077.C: Adjust warnings.

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

diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 2fada3e..46cad47 100644 (file)
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -6,9 +6,8 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                            $Revision: 1.304 $
 --                                                                          --
---          Copyright (C) 1992-2001 Free Software Foundation, Inc.          --
+--          Copyright (C) 1992-2002 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- --
@@ -22,7 +21,7 @@
 -- MA 02111-1307, USA.                                                      --
 --                                                                          --
 -- GNAT was originally developed  by the GNAT team at  New York University. --
--- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
 --                                                                          --
 ------------------------------------------------------------------------------
 
@@ -48,7 +47,6 @@ with Rtsfind;  use Rtsfind;
 with Sem;      use Sem;
 with Sem_Ch7;  use Sem_Ch7;
 with Sem_Ch8;  use Sem_Ch8;
-with Sem_Ch13; use Sem_Ch13;
 with Sem_Eval; use Sem_Eval;
 with Sem_Res;  use Sem_Res;
 with Sem_Util; use Sem_Util;
@@ -452,7 +450,7 @@ package body Exp_Attr is
             declare
                Agg     : Node_Id;
                Sub     : Entity_Id;
-               E_T     : constant Entity_Id := Equivalent_Type (Typ);
+               E_T     : constant Entity_Id := Equivalent_Type (Btyp);
                Acc     : constant Entity_Id :=
                            Etype (Next_Component (First_Component (E_T)));
                Obj_Ref : Node_Id;
@@ -511,7 +509,7 @@ package body Exp_Attr is
 
                Rewrite (N, Agg);
 
-               Analyze_And_Resolve (N, Equivalent_Type (Typ));
+               Analyze_And_Resolve (N, E_T);
 
                --  For subsequent analysis,  the node must retain its type.
                --  The backend will replace it with the equivalent type where
@@ -3083,9 +3081,16 @@ package body Exp_Attr is
          Ttyp := Underlying_Type (Ttyp);
 
          if Prefix_Is_Type then
-            Rewrite (N,
-              Unchecked_Convert_To (RTE (RE_Tag),
-                New_Reference_To (Access_Disp_Table (Ttyp), Loc)));
+
+            --  For JGNAT we leave the type attribute unexpanded because
+            --  there's not a dispatching table to reference.
+
+            if not Java_VM then
+               Rewrite (N,
+                 Unchecked_Convert_To (RTE (RE_Tag),
+                   New_Reference_To (Access_Disp_Table (Ttyp), Loc)));
+               Analyze_And_Resolve (N, RTE (RE_Tag));
+            end if;
 
          else
             Rewrite (N,
@@ -3093,9 +3098,8 @@ package body Exp_Attr is
                 Prefix => Relocate_Node (Pref),
                 Selector_Name =>
                   New_Reference_To (Tag_Component (Ttyp), Loc)));
+            Analyze_And_Resolve (N, RTE (RE_Tag));
          end if;
-
-         Analyze_And_Resolve (N, RTE (RE_Tag));
       end Tag;
 
       ----------------
@@ -3755,8 +3759,6 @@ package body Exp_Attr is
            Attribute_Machine_Overflows            |
            Attribute_Machine_Radix                |
            Attribute_Machine_Rounds               |
-           Attribute_Max_Interrupt_Priority       |
-           Attribute_Max_Priority                 |
            Attribute_Maximum_Alignment            |
            Attribute_Model_Emin                   |
            Attribute_Model_Epsilon                |
@@ -3774,7 +3776,6 @@ package body Exp_Attr is
            Attribute_Signed_Zeros                 |
            Attribute_Small                        |
            Attribute_Storage_Unit                 |
-           Attribute_Tick                         |
            Attribute_Type_Class                   |
            Attribute_Universal_Literal_String     |
            Attribute_Wchar_T_Size                 |
@@ -3830,7 +3831,8 @@ package body Exp_Attr is
                 Make_Attribute_Reference (Loc,
                   Prefix =>
                     New_Reference_To (Base_Type (Etype (Prefix (N))), Loc),
-                  Attribute_Name => Cnam))));
+                  Attribute_Name => Cnam)),
+          Reason => CE_Overflow_Check_Failed));
 
    end Expand_Pred_Succ;
 
@@ -3856,18 +3858,23 @@ package body Exp_Attr is
 
       --  If Typ is a derived type, it may inherit attributes from some
       --  ancestor which is not the ultimate underlying one.
+      --  If Typ is a derived tagged type, the corresponding primitive
+      --  operation has been created explicitly.
 
       if Is_Derived_Type (P_Type) then
+         if Is_Tagged_Type (P_Type) then
+            return Find_Prim_Op (P_Type, Nam);
+         else
+            while Is_Derived_Type (P_Type) loop
+               Proc :=  TSS (Base_Type (Etype (Typ)), Nam);
 
-         while Is_Derived_Type (P_Type) loop
-            Proc :=  TSS (Base_Type (Etype (Typ)), Nam);
-
-            if Present (Proc) then
-               return Proc;
-            else
-               P_Type := Base_Type (Etype (P_Type));
-            end if;
-         end loop;
+               if Present (Proc) then
+                  return Proc;
+               else
+                  P_Type := Base_Type (Etype (P_Type));
+               end if;
+            end loop;
+         end if;
       end if;
 
       --  If nothing else, use the TSS of the root type.