exp_attr.adb (Attribute_Priority): Add missing support for entries and entry barriers.

2007-08-16  Javier Miranda  <miranda@adacore.com>

	* exp_attr.adb (Attribute_Priority): Add missing support for entries
	and entry barriers.

From-SVN: r127539
This commit is contained in:
Javier Miranda 2007-08-16 14:18:26 +02:00 committed by Arnaud Charlet
parent 19590d704b
commit 16f67b79ab

View File

@ -37,7 +37,9 @@ with Exp_Strm; use Exp_Strm;
with Exp_Tss; use Exp_Tss; with Exp_Tss; use Exp_Tss;
with Exp_Util; use Exp_Util; with Exp_Util; use Exp_Util;
with Exp_VFpt; use Exp_VFpt; with Exp_VFpt; use Exp_VFpt;
with Freeze; use Freeze;
with Gnatvsn; use Gnatvsn; with Gnatvsn; use Gnatvsn;
with Itypes; use Itypes;
with Lib; use Lib; with Lib; use Lib;
with Namet; use Namet; with Namet; use Namet;
with Nmake; use Nmake; with Nmake; use Nmake;
@ -3134,16 +3136,66 @@ package body Exp_Attr is
Subprg := Scope (Subprg); Subprg := Scope (Subprg);
end loop; end loop;
-- Use of 'Priority inside protected entries and barriers (in
-- both cases the type of the first formal of their expanded
-- subprogram is Address)
if Etype (First_Entity (Protected_Body_Subprogram (Subprg)))
= RTE (RE_Address)
then
declare
New_Itype : Entity_Id;
begin
-- In the expansion of protected entries the type of the
-- first formal of the Protected_Body_Subprogram is an
-- Address. In order to reference the _object component
-- we generate:
-- type T is access p__ptTV;
-- freeze T []
New_Itype := Create_Itype (E_Access_Type, N);
Set_Etype (New_Itype, New_Itype);
Init_Esize (New_Itype);
Init_Size_Align (New_Itype);
Set_Directly_Designated_Type (New_Itype,
Corresponding_Record_Type (Conctyp));
Freeze_Itype (New_Itype, N);
-- Generate:
-- T!(O)._object'unchecked_access
Object_Parm :=
Make_Attribute_Reference (Loc,
Prefix =>
Make_Selected_Component (Loc,
Prefix =>
Unchecked_Convert_To (New_Itype,
New_Reference_To
(First_Entity
(Protected_Body_Subprogram (Subprg)),
Loc)),
Selector_Name =>
Make_Identifier (Loc, Name_uObject)),
Attribute_Name => Name_Unchecked_Access);
end;
-- Use of 'Priority inside a protected subprogram
else
Object_Parm := Object_Parm :=
Make_Attribute_Reference (Loc, Make_Attribute_Reference (Loc,
Prefix => Prefix =>
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => New_Reference_To Prefix => New_Reference_To
(First_Entity (First_Entity
(Protected_Body_Subprogram (Subprg)), Loc), (Protected_Body_Subprogram (Subprg)),
Loc),
Selector_Name => Selector_Name =>
Make_Identifier (Loc, Name_uObject)), Make_Identifier (Loc, Name_uObject)),
Attribute_Name => Name_Unchecked_Access); Attribute_Name => Name_Unchecked_Access);
end if;
-- Select the appropriate run-time subprogram -- Select the appropriate run-time subprogram
@ -3161,7 +3213,11 @@ package body Exp_Attr is
Parameter_Associations => New_List (Object_Parm)); Parameter_Associations => New_List (Object_Parm));
Rewrite (N, Call); Rewrite (N, Call);
Analyze_And_Resolve (N, Typ);
-- Avoid the generation of extra checks on the pointer to the
-- protected object.
Analyze_And_Resolve (N, Typ, Suppress => Access_Check);
end; end;
------------------ ------------------