[Ada] Cleanup expansion of attribute Priority
Commit Message
Semantically neutral cleanup after the main fix for expansion of
attribute Priority.
Tested on x86_64-pc-linux-gnu, committed on trunk
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).
@@ -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))));