sem_util.ads: Update comment describing function Deepest_Access_Level.

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.

From-SVN: r181570

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5a9e425693ea224cc49d3781282d84341f73436a..ad67de5d4a9683fc1743cb993fdc02305f9e182d 100644 (file)
--- 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 393a5e1298866a7fe536116d44d52ba112c805c5..4005ba2426a2d58f062130bf8b56431ace2bebf4 100644 (file)
--- 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 f6fc65b496981ca46c56cde04685a158fcffafbc..3587e07685a7b10770a0451a9f7f300d3837ff95 100644 (file)
--- 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 5798ae0fbef3e0aaa31505f88dfac2158ee62cc6..30421af048f97f5f076898203221985f161a797b 100644 (file)
--- 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 c073d20a05631d166eb89e9f57e1522b087ef904..c3fe8f9bbfaa80765396d1a71f43e6ee25f5c4bc 100644 (file)
--- 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 0d7253b6e295ddd0e7aa13b316400fb7eb83a99c..693ddf2def95cf80f9890d27b84165ea3211350e 100644 (file)
--- 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