From 7d4c4a4d21aceabf7bae4eec608d2c6f22fc9d76 Mon Sep 17 00:00:00 2001
From: Steve Baird <baird@adacore.com>
Date: Thu, 7 Dec 2023 12:18:29 -0800
Subject: [PATCH] ada: Fix bug in Sem_Util.Enclosing_Declaration
Fix Sem_Util.Enclosing_Declaration to not return an N_Subprogram_Specification
node. Remove code in various places that was formerly needed to cope with this
misbehavior.
gcc/ada/
* sem_util.adb (Enclosing_Declaration): Instead of returning a
subprogram specification node, return its parent (which is
presumably a subprogram declaration).
* contracts.adb (Insert_Stable_Property_Check): Remove code
formerly needed to compensate for incorrect behavior of
Sem_Util.Enclosing_Declaration.
* exp_attr.adb (In_Available_Context): Remove code formerly needed
to compensate for incorrect behavior of
Sem_Util.Enclosing_Declaration.
* sem_ch8.adb (Is_Actual_Subp_Of_Inst): Remove code formerly
needed to compensate for incorrect behavior of
Sem_Util.Enclosing_Declaration.
---
gcc/ada/contracts.adb | 12 ++----------
gcc/ada/exp_attr.adb | 11 +----------
gcc/ada/sem_ch8.adb | 10 ----------
gcc/ada/sem_util.adb | 5 +++++
4 files changed, 8 insertions(+), 30 deletions(-)
diff --git a/gcc/ada/contracts.adb b/gcc/ada/contracts.adb
index fa0d59a246a2..21bbbf1219e7 100644
--- a/gcc/ada/contracts.adb
+++ b/gcc/ada/contracts.adb
@@ -2529,17 +2529,9 @@ package body Contracts is
Pragma_Argument_Associations => Args,
Class_Present => Class_Present);
- Subp_Decl : Node_Id := Subp_Id;
+ Subp_Decl : constant Node_Id := Enclosing_Declaration (Subp_Id);
+ pragma Assert (Is_Declaration (Subp_Decl));
begin
- -- Enclosing_Declaration may return, for example,
- -- a N_Procedure_Specification node. Cope with this.
- loop
- Subp_Decl := Enclosing_Declaration (Subp_Decl);
- exit when Is_Declaration (Subp_Decl);
- Subp_Decl := Parent (Subp_Decl);
- pragma Assert (Present (Subp_Decl));
- end loop;
-
Insert_After_And_Analyze (Subp_Decl, Prag);
end Insert_Stable_Property_Check;
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 66fd6848a1d7..a781f93c4ef8 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -8653,17 +8653,8 @@ package body Exp_Attr is
--------------------------
function In_Available_Context (Ent : Entity_Id) return Boolean is
- Decl : Node_Id := Enclosing_Declaration (Ent);
+ Decl : constant Node_Id := Enclosing_Declaration (Ent);
begin
- -- Enclosing_Declaration does not always return a declaration;
- -- cope with this irregularity.
- if Decl in N_Subprogram_Specification_Id
- and then Nkind (Parent (Decl)) in
- N_Subprogram_Body | N_Subprogram_Declaration
- then
- Decl := Parent (Decl);
- end if;
-
if Has_Declarations (Parent (Decl)) then
return In_Subtree (Attr_Ref, Root => Parent (Decl));
elsif Is_List_Member (Decl) then
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 5408be3e1a52..fc2fec5f2243 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -6562,16 +6562,6 @@ package body Sem_Ch8 is
Decl := Enclosing_Declaration (E);
- -- Enclosing_Declaration does not always return a
- -- declaration; cope with this irregularity.
- if Decl in N_Subprogram_Specification_Id
- and then Nkind (Parent (Decl)) in
- N_Subprogram_Body | N_Subprogram_Declaration
- | N_Subprogram_Renaming_Declaration
- then
- Decl := Parent (Decl);
- end if;
-
-- Look for the suprogram renaming declaration built
-- for a generic actual subprogram. Unclear why
-- Original_Node call is needed, but sometimes it is.
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index 9cff9e1be163..01be86cb41f6 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -7386,6 +7386,11 @@ package body Sem_Util is
Decl := Parent (Decl);
end loop;
+ -- cope with oddness in definition of N_Declaration
+ if Nkind (Decl) in N_Subprogram_Specification then
+ Decl := Parent (Decl);
+ end if;
+
return Decl;
end Enclosing_Declaration;
--
GitLab