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 + + * 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 * 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