From: "Marc Poulhiès" <poulhies@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Piotr Trojanek <trojanek@adacore.com>
Subject: [Ada] Cleanup expansion of attribute Priority
Date: Mon, 5 Sep 2022 09:25:53 +0200 [thread overview]
Message-ID: <20220905072553.GA1174527@poulhies-Precision-5550> (raw)
[-- Attachment #1: Type: text/plain, Size: 520 bytes --]
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).
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 5169 bytes --]
diff --git a/gcc/ada/einfo-utils.adb b/gcc/ada/einfo-utils.adb
--- a/gcc/ada/einfo-utils.adb
+++ b/gcc/ada/einfo-utils.adb
@@ -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
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -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);
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -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))));
reply other threads:[~2022-09-05 7:25 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20220905072553.GA1174527@poulhies-Precision-5550 \
--to=poulhies@adacore.com \
--cc=gcc-patches@gcc.gnu.org \
--cc=trojanek@adacore.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).