OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sem_util.ads: Update comment describing function Deepest_Access_Level.

Browse Source 
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:
Steve Baird 2011-11-21 12:02:41 +00:00 committed by Arnaud Charlet
parent d673c5c5bd
commit f460d8f397
6 changed files with 41 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
gcc/ada/ChangeLog
View File

@ -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.

5
gcc/ada/sem_attr.adb
View File

@ -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

3
gcc/ada/sem_ch3.adb
View File

@ -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);

11
gcc/ada/sem_res.adb
View File

@ -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 " &

7
gcc/ada/sem_util.adb
View File

@ -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;

4
gcc/ada/sem_util.ads
View File

@ -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