2
0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-15 11:20:39 +08:00

[Ada] Cleanup expansion of attribute Priority

Semantically neutral cleanup after the main fix for expansion of
attribute Priority.

gcc/ada/

	* einfo-utils.adb (Number_Entries): Refine type of a local variable.
	* exp_attr.adb (Expand_N_Attribute_Reference): Rename Conctyp to
	Prottyp; refactor repeated calls to New_Occurrence_Of; replace
	Number_Entries with Has_Entries.
	* exp_ch5.adb (Expand_N_Assignment_Statement): Likewise; remove Subprg
	variable (apparently copy-pasted from expansion of the attribute).
This commit is contained in:
Piotr Trojanek 2021-02-25 21:52:22 +01:00 committed by Marc Poulhiès
parent c7dd10e8af
commit 88fbab0d71
3 changed files with 30 additions and 41 deletions

@ -2081,7 +2081,7 @@ package body Einfo.Utils is
--------------------
function Number_Entries (Id : E) return Nat is
N : Int;
N : Nat;
Ent : Entity_Id;
begin

@ -5667,22 +5667,22 @@ package body Exp_Attr is
-- which is illegal, because of the lack of aliasing.
when Attribute_Priority => Priority : declare
Call : Node_Id;
Conctyp : Entity_Id;
New_Itype : Entity_Id;
Object_Parm : Node_Id;
Subprg : Entity_Id;
RT_Subprg_Name : Node_Id;
Call : Node_Id;
New_Itype : Entity_Id;
Object_Parm : Node_Id;
Prottyp : Entity_Id;
RT_Subprg : RE_Id;
Subprg : Entity_Id;
begin
-- Look for the enclosing protected type
Conctyp := Current_Scope;
while not Is_Protected_Type (Conctyp) loop
Conctyp := Scope (Conctyp);
Prottyp := Current_Scope;
while not Is_Protected_Type (Prottyp) loop
Prottyp := Scope (Prottyp);
end loop;
pragma Assert (Is_Protected_Type (Conctyp));
pragma Assert (Is_Protected_Type (Prottyp));
-- Generate the actual of the call
@ -5710,7 +5710,7 @@ package body Exp_Attr is
New_Itype := Create_Itype (E_Access_Type, N);
Set_Etype (New_Itype, New_Itype);
Set_Directly_Designated_Type (New_Itype,
Corresponding_Record_Type (Conctyp));
Corresponding_Record_Type (Prottyp));
Freeze_Itype (New_Itype, N);
-- Generate:
@ -5745,15 +5745,16 @@ package body Exp_Attr is
-- Select the appropriate run-time subprogram
if Number_Entries (Conctyp) = 0 then
RT_Subprg_Name := New_Occurrence_Of (RTE (RE_Get_Ceiling), Loc);
if Has_Entries (Prottyp) then
RT_Subprg := RO_PE_Get_Ceiling;
else
RT_Subprg_Name := New_Occurrence_Of (RTE (RO_PE_Get_Ceiling), Loc);
RT_Subprg := RE_Get_Ceiling;
end if;
Call :=
Make_Function_Call (Loc,
Name => RT_Subprg_Name,
Name =>
New_Occurrence_Of (RTE (RT_Subprg), Loc),
Parameter_Associations => New_List (Object_Parm));
Rewrite (N, Call);

@ -2392,11 +2392,10 @@ package body Exp_Ch5 is
if Ada_Version >= Ada_2005 then
declare
Call : Node_Id;
Conctyp : Entity_Id;
Ent : Entity_Id;
Subprg : Entity_Id;
RT_Subprg_Name : Node_Id;
Call : Node_Id;
Ent : Entity_Id;
Prottyp : Entity_Id;
RT_Subprg : RE_Id;
begin
-- Handle chains of renamings
@ -2418,36 +2417,25 @@ package body Exp_Ch5 is
-- Look for the enclosing protected type
Conctyp := Current_Scope;
while not Is_Protected_Type (Conctyp) loop
Conctyp := Scope (Conctyp);
Prottyp := Current_Scope;
while not Is_Protected_Type (Prottyp) loop
Prottyp := Scope (Prottyp);
end loop;
pragma Assert (Is_Protected_Type (Conctyp));
-- Generate the first actual of the call
Subprg := Current_Scope;
while
not (Is_Subprogram_Or_Entry (Subprg)
and then Present (Protected_Body_Subprogram (Subprg)))
loop
Subprg := Scope (Subprg);
end loop;
pragma Assert (Is_Protected_Type (Prottyp));
-- Select the appropriate run-time call
if Number_Entries (Conctyp) = 0 then
RT_Subprg_Name :=
New_Occurrence_Of (RTE (RE_Set_Ceiling), Loc);
if Has_Entries (Prottyp) then
RT_Subprg := RO_PE_Set_Ceiling;
else
RT_Subprg_Name :=
New_Occurrence_Of (RTE (RO_PE_Set_Ceiling), Loc);
RT_Subprg := RE_Set_Ceiling;
end if;
Call :=
Make_Procedure_Call_Statement (Loc,
Name => RT_Subprg_Name,
Name =>
New_Occurrence_Of (RTE (RT_Subprg), Loc),
Parameter_Associations => New_List (
New_Copy_Tree (First (Parameter_Associations (Ent))),
Relocate_Node (Expression (N))));