2011-11-21 Steve Baird <baird@adacore.com>

	* sem_util.ads: Update comment describing function
	Deepest_Access_Level.
	* sem_util.adb (Deepest_Type_Access_Level): Return Int'Last for a
	generic formal type.
	(Type_Access_Level): Return library level
	for a generic formal type.
	* sem_attr.adb (Resolve_Attribute): Replace two Type_Access_Level
	calls with calls to Deepest_Type_Access_Level.
	* sem_ch3.adb (Analyze_Component_Declaration): replace a
	Type_Access_Level call with a call to Deepest_Type_Access_Level.
	* sem_res.adb (Resolve_Allocator.Check_Allocator_Discrim_Accessibility):
	Replace three Type_Access_Level calls with calls to
	Deepest_Type_Access_Level.
	(Resolve_Allocator): Replace a Type_Access_Level call with a call to
	Deepest_Type_Access_Level.
	(Valid_Conversion.Valid_Array_Conversion): Replace a
	Type_Access_Level call with a call to Deepest_Type_Access_Level.



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

6 files changed, 41 insertions, 9 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5a9e425693e..ad67de5d4a9 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,23 @@
+2011-11-21  Steve Baird  <baird@adacore.com>
+
+	* sem_util.ads: Update comment describing function
+	Deepest_Access_Level.
+	* sem_util.adb (Deepest_Type_Access_Level): Return Int'Last for a
+	generic formal type.
+	(Type_Access_Level): Return library level
+	for a generic formal type.
+	* sem_attr.adb (Resolve_Attribute): Replace two Type_Access_Level
+	calls with calls to Deepest_Type_Access_Level.
+	* sem_ch3.adb (Analyze_Component_Declaration): replace a
+	Type_Access_Level call with a call to Deepest_Type_Access_Level.
+	* sem_res.adb (Resolve_Allocator.Check_Allocator_Discrim_Accessibility):
+	Replace three Type_Access_Level calls with calls to
+	Deepest_Type_Access_Level.
+	(Resolve_Allocator): Replace a Type_Access_Level call with a call to
+	Deepest_Type_Access_Level.
+	(Valid_Conversion.Valid_Array_Conversion): Replace a
+	Type_Access_Level call with a call to Deepest_Type_Access_Level.
+
 2011-11-21  Robert Dewar  <dewar@adacore.com>
 
 	* sem_ch3.adb, s-taprop-vms.adb, opt.ads: Minor reformatting.
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 393a5e12988..4005ba2426a 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -8648,7 +8648,8 @@ package body Sem_Attr is
                --  attribute is always legal in such a context.
 
                if Attr_Id /= Attribute_Unchecked_Access
-                 and then Object_Access_Level (P) > Type_Access_Level (Btyp)
+                 and then
+                   Object_Access_Level (P) > Deepest_Type_Access_Level (Btyp)
                  and then Ekind (Btyp) = E_General_Access_Type
                then
                   Accessibility_Message;
@@ -8670,7 +8671,7 @@ package body Sem_Attr is
                --  anonymous_access_to_protected, there are no accessibility
                --  checks either. Omit check entirely for Unrestricted_Access.
 
-               elsif Object_Access_Level (P) > Type_Access_Level (Btyp)
+               elsif Object_Access_Level (P) > Deepest_Type_Access_Level (Btyp)
                  and then Comes_From_Source (N)
                  and then Ekind (Btyp) = E_Access_Protected_Subprogram_Type
                  and then Attr_Id /= Attribute_Unrestricted_Access
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index f6fc65b4969..3587e07685a 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1896,7 +1896,8 @@ package body Sem_Ch3 is
             --  (Ada 2005: AI-230): Accessibility check for anonymous
             --  components
 
-            if Type_Access_Level (Etype (E)) > Type_Access_Level (T) then
+            if Type_Access_Level (Etype (E)) >
+              Deepest_Type_Access_Level (T) then
                Error_Msg_N
                  ("expression has deeper access level than component " &
                   "(RM 3.10.2 (12.2))", E);
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index 5798ae0fbef..30421af048f 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -4086,7 +4086,7 @@ package body Sem_Res is
       is
       begin
          if Type_Access_Level (Etype (Disc_Exp)) >
-            Type_Access_Level (Alloc_Typ)
+            Deepest_Type_Access_Level (Alloc_Typ)
          then
             Error_Msg_N
               ("operand type has deeper level than allocator type", Disc_Exp);
@@ -4098,7 +4098,7 @@ package body Sem_Res is
            and then Get_Attribute_Id (Attribute_Name (Disc_Exp))
                       = Attribute_Access
            and then Object_Access_Level (Prefix (Disc_Exp))
-                      > Type_Access_Level (Alloc_Typ)
+                      > Deepest_Type_Access_Level (Alloc_Typ)
          then
             Error_Msg_N
               ("prefix of attribute has deeper level than allocator type",
@@ -4110,7 +4110,7 @@ package body Sem_Res is
          elsif Ekind (Etype (Disc_Exp)) = E_Anonymous_Access_Type
            and then Nkind (Disc_Exp) = N_Selected_Component
            and then Object_Access_Level (Prefix (Disc_Exp))
-                      > Type_Access_Level (Alloc_Typ)
+                      > Deepest_Type_Access_Level (Alloc_Typ)
          then
             Error_Msg_N
               ("access discriminant has deeper level than allocator type",
@@ -4314,7 +4314,8 @@ package body Sem_Res is
                Exp_Typ := Entity (E);
             end if;
 
-            if Type_Access_Level (Exp_Typ) > Type_Access_Level (Typ) then
+            if Type_Access_Level (Exp_Typ) >
+              Deepest_Type_Access_Level (Typ) then
                if In_Instance_Body then
                   Error_Msg_N ("?type in allocator has deeper level than" &
                                " designated class-wide type", E);
@@ -10358,7 +10359,7 @@ package body Sem_Res is
                 Subtypes_Statically_Match (Target_Comp_Type, Opnd_Comp_Type)
             then
                if Type_Access_Level (Target_Type) <
-                   Type_Access_Level (Opnd_Type)
+                   Deepest_Type_Access_Level (Opnd_Type)
                then
                   if In_Instance_Body then
                      Error_Msg_N ("?source array type " &
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index c073d20a056..c3fe8f9bbfa 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -2437,6 +2437,9 @@ package body Sem_Util is
                          (Defining_Identifier
                            (Associated_Node_For_Itype (Typ))));
 
+      elsif Is_Generic_Type (Root_Type (Typ)) then
+         return UI_From_Int (Int'Last);
+
       else
          return Type_Access_Level (Typ);
       end if;
@@ -12714,6 +12717,10 @@ package body Sem_Util is
          end if;
       end if;
 
+      if Is_Generic_Type (Root_Type (Btyp)) then
+         return Scope_Depth (Standard_Standard);
+      end if;
+
       return Scope_Depth (Enclosing_Dynamic_Scope (Btyp));
    end Type_Access_Level;
 
diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads
index 0d7253b6e29..693ddf2def9 100644
--- a/gcc/ada/sem_util.ads
+++ b/gcc/ada/sem_util.ads
@@ -314,7 +314,9 @@ package Sem_Util is
    --  static accesssibility level of the object. In that case, the dynamic
    --  accessibility level of the object may take on values in a range. The low
    --  bound of of that range is returned by Type_Access_Level; this function
-   --  yields the high bound of that range.
+   --  yields the high bound of that range. Also differs from Type_Access_Level
+   --  in the case of a descendant of a generic formal type (returns Int'Last
+   --  instead of 0).
 
    function Defining_Entity (N : Node_Id) return Entity_Id;
    --  Given a declaration N, returns the associated defining entity. If the