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
This commit is contained in:
parent
d673c5c5bd
commit
f460d8f397
|
@ -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>
|
2011-11-21 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
* sem_ch3.adb, s-taprop-vms.adb, opt.ads: Minor reformatting.
|
* sem_ch3.adb, s-taprop-vms.adb, opt.ads: Minor reformatting.
|
||||||
|
|
|
@ -8648,7 +8648,8 @@ package body Sem_Attr is
|
||||||
-- attribute is always legal in such a context.
|
-- attribute is always legal in such a context.
|
||||||
|
|
||||||
if Attr_Id /= Attribute_Unchecked_Access
|
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
|
and then Ekind (Btyp) = E_General_Access_Type
|
||||||
then
|
then
|
||||||
Accessibility_Message;
|
Accessibility_Message;
|
||||||
|
@ -8670,7 +8671,7 @@ package body Sem_Attr is
|
||||||
-- anonymous_access_to_protected, there are no accessibility
|
-- anonymous_access_to_protected, there are no accessibility
|
||||||
-- checks either. Omit check entirely for Unrestricted_Access.
|
-- 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 Comes_From_Source (N)
|
||||||
and then Ekind (Btyp) = E_Access_Protected_Subprogram_Type
|
and then Ekind (Btyp) = E_Access_Protected_Subprogram_Type
|
||||||
and then Attr_Id /= Attribute_Unrestricted_Access
|
and then Attr_Id /= Attribute_Unrestricted_Access
|
||||||
|
|
|
@ -1896,7 +1896,8 @@ package body Sem_Ch3 is
|
||||||
-- (Ada 2005: AI-230): Accessibility check for anonymous
|
-- (Ada 2005: AI-230): Accessibility check for anonymous
|
||||||
-- components
|
-- 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
|
Error_Msg_N
|
||||||
("expression has deeper access level than component " &
|
("expression has deeper access level than component " &
|
||||||
"(RM 3.10.2 (12.2))", E);
|
"(RM 3.10.2 (12.2))", E);
|
||||||
|
|
|
@ -4086,7 +4086,7 @@ package body Sem_Res is
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
if Type_Access_Level (Etype (Disc_Exp)) >
|
if Type_Access_Level (Etype (Disc_Exp)) >
|
||||||
Type_Access_Level (Alloc_Typ)
|
Deepest_Type_Access_Level (Alloc_Typ)
|
||||||
then
|
then
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
("operand type has deeper level than allocator type", Disc_Exp);
|
("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))
|
and then Get_Attribute_Id (Attribute_Name (Disc_Exp))
|
||||||
= Attribute_Access
|
= Attribute_Access
|
||||||
and then Object_Access_Level (Prefix (Disc_Exp))
|
and then Object_Access_Level (Prefix (Disc_Exp))
|
||||||
> Type_Access_Level (Alloc_Typ)
|
> Deepest_Type_Access_Level (Alloc_Typ)
|
||||||
then
|
then
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
("prefix of attribute has deeper level than allocator type",
|
("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
|
elsif Ekind (Etype (Disc_Exp)) = E_Anonymous_Access_Type
|
||||||
and then Nkind (Disc_Exp) = N_Selected_Component
|
and then Nkind (Disc_Exp) = N_Selected_Component
|
||||||
and then Object_Access_Level (Prefix (Disc_Exp))
|
and then Object_Access_Level (Prefix (Disc_Exp))
|
||||||
> Type_Access_Level (Alloc_Typ)
|
> Deepest_Type_Access_Level (Alloc_Typ)
|
||||||
then
|
then
|
||||||
Error_Msg_N
|
Error_Msg_N
|
||||||
("access discriminant has deeper level than allocator type",
|
("access discriminant has deeper level than allocator type",
|
||||||
|
@ -4314,7 +4314,8 @@ package body Sem_Res is
|
||||||
Exp_Typ := Entity (E);
|
Exp_Typ := Entity (E);
|
||||||
end if;
|
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
|
if In_Instance_Body then
|
||||||
Error_Msg_N ("?type in allocator has deeper level than" &
|
Error_Msg_N ("?type in allocator has deeper level than" &
|
||||||
" designated class-wide type", E);
|
" designated class-wide type", E);
|
||||||
|
@ -10358,7 +10359,7 @@ package body Sem_Res is
|
||||||
Subtypes_Statically_Match (Target_Comp_Type, Opnd_Comp_Type)
|
Subtypes_Statically_Match (Target_Comp_Type, Opnd_Comp_Type)
|
||||||
then
|
then
|
||||||
if Type_Access_Level (Target_Type) <
|
if Type_Access_Level (Target_Type) <
|
||||||
Type_Access_Level (Opnd_Type)
|
Deepest_Type_Access_Level (Opnd_Type)
|
||||||
then
|
then
|
||||||
if In_Instance_Body then
|
if In_Instance_Body then
|
||||||
Error_Msg_N ("?source array type " &
|
Error_Msg_N ("?source array type " &
|
||||||
|
|
|
@ -2437,6 +2437,9 @@ package body Sem_Util is
|
||||||
(Defining_Identifier
|
(Defining_Identifier
|
||||||
(Associated_Node_For_Itype (Typ))));
|
(Associated_Node_For_Itype (Typ))));
|
||||||
|
|
||||||
|
elsif Is_Generic_Type (Root_Type (Typ)) then
|
||||||
|
return UI_From_Int (Int'Last);
|
||||||
|
|
||||||
else
|
else
|
||||||
return Type_Access_Level (Typ);
|
return Type_Access_Level (Typ);
|
||||||
end if;
|
end if;
|
||||||
|
@ -12714,6 +12717,10 @@ package body Sem_Util is
|
||||||
end if;
|
end if;
|
||||||
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));
|
return Scope_Depth (Enclosing_Dynamic_Scope (Btyp));
|
||||||
end Type_Access_Level;
|
end Type_Access_Level;
|
||||||
|
|
||||||
|
|
|
@ -314,7 +314,9 @@ package Sem_Util is
|
||||||
-- static accesssibility level of the object. In that case, the dynamic
|
-- 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
|
-- 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
|
-- 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;
|
function Defining_Entity (N : Node_Id) return Entity_Id;
|
||||||
-- Given a declaration N, returns the associated defining entity. If the
|
-- Given a declaration N, returns the associated defining entity. If the
|
||||||
|
|
Loading…
Reference in New Issue