From: "Marc Poulhiès" <poulhies@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Javier Miranda <miranda@adacore.com>
Subject: [COMMITTED] ada: Crash on creation of extra formals on type extension
Date: Fri, 15 Sep 2023 16:20:32 +0200 [thread overview]
Message-ID: <20230915142032.2100558-1-poulhies@adacore.com> (raw)
From: Javier Miranda <miranda@adacore.com>
Revert previous patch and fix the pending issue.
gcc/ada/
* accessibility.ads (Needs_Result_Accessibility_Extra_Formal):
Removed.
* accessibility.adb (Needs_Result_Accessibility_Level_Param):
Removed.
(Needs_Result_Accessibility_Extra_Formal): Removed.
(Needs_Result_Accessibility_Level): Revert previous patch.
* sem_ch6.adb (Parent_Subprogram): Handle function overriding an
enumeration literal.
(Create_Extra_Formals): Ensure that the parent subprogram has all
its extra formals.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/accessibility.adb | 54 ++-------------------------------------
gcc/ada/accessibility.ads | 9 -------
gcc/ada/sem_ch6.adb | 27 ++++++++++++++++----
3 files changed, 24 insertions(+), 66 deletions(-)
diff --git a/gcc/ada/accessibility.adb b/gcc/ada/accessibility.adb
index 6b4ec5b9d24..bc897d1ef18 100644
--- a/gcc/ada/accessibility.adb
+++ b/gcc/ada/accessibility.adb
@@ -56,16 +56,6 @@ with Tbuild; use Tbuild;
package body Accessibility is
- function Needs_Result_Accessibility_Level_Param
- (Func_Id : Entity_Id;
- Func_Typ : Entity_Id) return Boolean;
- -- Subsidiary of functions Needs_Result_Accessibility_Extra_Formal and
- -- Needs_Result_Accessibility_Level_Param. Return True if the function
- -- needs an implicit parameter to identify the accessibility level of
- -- the function result "determined by the point of call". Func_Typ is
- -- the function return type; this function returns False if Func_Typ is
- -- Empty.
-
---------------------------
-- Accessibility_Message --
---------------------------
@@ -1902,34 +1892,6 @@ package body Accessibility is
and then Is_Explicitly_Aliased (Entity (Prefix (Exp)));
end Is_Special_Aliased_Formal_Access;
- ---------------------------------------------
- -- Needs_Result_Accessibility_Extra_Formal --
- ---------------------------------------------
-
- function Needs_Result_Accessibility_Extra_Formal
- (Func_Id : Entity_Id) return Boolean
- is
- Func_Typ : Entity_Id;
-
- begin
- if Present (Underlying_Type (Etype (Func_Id))) then
- Func_Typ := Underlying_Type (Etype (Func_Id));
-
- -- Case of a function returning a private type which is not completed
- -- yet. The support for this case is required because this function is
- -- called to create the extra formals of dispatching primitives, and
- -- they may be frozen before we see the full-view of their returned
- -- private type.
-
- else
- -- Temporarily restore previous behavior
- -- Func_Typ := Etype (Func_Id);
- Func_Typ := Empty;
- end if;
-
- return Needs_Result_Accessibility_Level_Param (Func_Id, Func_Typ);
- end Needs_Result_Accessibility_Extra_Formal;
-
--------------------------------------
-- Needs_Result_Accessibility_Level --
--------------------------------------
@@ -1939,18 +1901,6 @@ package body Accessibility is
is
Func_Typ : constant Entity_Id := Underlying_Type (Etype (Func_Id));
- begin
- return Needs_Result_Accessibility_Level_Param (Func_Id, Func_Typ);
- end Needs_Result_Accessibility_Level;
-
- --------------------------------------------
- -- Needs_Result_Accessibility_Level_Param --
- --------------------------------------------
-
- function Needs_Result_Accessibility_Level_Param
- (Func_Id : Entity_Id;
- Func_Typ : Entity_Id) return Boolean
- is
function Has_Unconstrained_Access_Discriminant_Component
(Comp_Typ : Entity_Id) return Boolean;
-- Returns True if any component of the type has an unconstrained access
@@ -2002,7 +1952,7 @@ package body Accessibility is
-- Flag used to temporarily disable a "True" result for tagged types.
-- See comments further below for details.
- -- Start of processing for Needs_Result_Accessibility_Level_Param
+ -- Start of processing for Needs_Result_Accessibility_Level
begin
-- False if completion unavailable, which can happen when we are
@@ -2078,7 +2028,7 @@ package body Accessibility is
else
return False;
end if;
- end Needs_Result_Accessibility_Level_Param;
+ end Needs_Result_Accessibility_Level;
------------------------------------------
-- Prefix_With_Safe_Accessibility_Level --
diff --git a/gcc/ada/accessibility.ads b/gcc/ada/accessibility.ads
index 731fea125f4..000e9b6e1e4 100644
--- a/gcc/ada/accessibility.ads
+++ b/gcc/ada/accessibility.ads
@@ -197,15 +197,6 @@ package Accessibility is
-- prefix is an aliased formal of Scop and that Scop returns an anonymous
-- access type. See RM 3.10.2 for more details.
- function Needs_Result_Accessibility_Extra_Formal
- (Func_Id : Entity_Id) return Boolean;
- -- Ada 2012 (AI05-0234): Return True if the function needs an implicit
- -- parameter to identify the accessibility level of the function result.
- -- If the type of the function result is a private type and its completion
- -- is unavailable, which can happen when we are analyzing an abstract
- -- subprogram, determines its result using the returned private type. This
- -- function is used by Create_Extra_Formals.
-
function Needs_Result_Accessibility_Level
(Func_Id : Entity_Id) return Boolean;
-- Ada 2012 (AI05-0234): Return True if the function needs an implicit
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 612a9e97221..a0dad86149f 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -8766,7 +8766,12 @@ package body Sem_Ch6 is
Ovr_Alias : Entity_Id;
begin
- if Present (Ovr_E) then
+ if Present (Ovr_E)
+ and then Ekind (Ovr_E) = E_Enumeration_Literal
+ then
+ Ovr_E := Empty;
+
+ elsif Present (Ovr_E) then
Ovr_Alias := Ultimate_Alias (Ovr_E);
-- There is no real overridden subprogram if there is a mutual
@@ -8992,6 +8997,18 @@ package body Sem_Ch6 is
-- for extra formals.
if Present (Parent_Subp) then
+
+ -- Ensure that the parent subprogram has all its extra formals.
+ -- Required because its return type may have been a private or
+ -- an incomplete type, and the extra formals were not added. We
+ -- protect this call against the weird cases where the parent subp
+ -- renames this primitive (documented in the body of the local
+ -- function Parent_Subprogram).
+
+ if Ultimate_Alias (Parent_Subp) /= Ref_E then
+ Create_Extra_Formals (Parent_Subp);
+ end if;
+
Parent_Formal := First_Formal (Parent_Subp);
-- For concurrent types, the controlling argument of a dispatching
@@ -9140,13 +9157,13 @@ package body Sem_Ch6 is
begin
Ada_Version := Ada_2022;
- if Needs_Result_Accessibility_Extra_Formal (Ref_E)
+ if Needs_Result_Accessibility_Level (Ref_E)
or else
(Present (Parent_Subp)
- and then Needs_Result_Accessibility_Extra_Formal (Parent_Subp))
+ and then Needs_Result_Accessibility_Level (Parent_Subp))
or else
(Present (Alias_Subp)
- and then Needs_Result_Accessibility_Extra_Formal (Alias_Subp))
+ and then Needs_Result_Accessibility_Level (Alias_Subp))
then
Set_Extra_Accessibility_Of_Result (E,
Add_Extra_Formal (E, Standard_Natural, E, "L"));
@@ -9695,7 +9712,7 @@ package body Sem_Ch6 is
-- Check attribute Extra_Accessibility_Of_Result
if Ekind (E) in E_Function | E_Subprogram_Type
- and then Needs_Result_Accessibility_Extra_Formal (E)
+ and then Needs_Result_Accessibility_Level (E)
and then No (Extra_Accessibility_Of_Result (E))
then
return False;
--
2.40.0
next reply other threads:[~2023-09-15 14:20 UTC|newest]
Thread overview: 2+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-09-15 14:20 Marc Poulhiès [this message]
-- strict thread matches above, loose matches on Subject: below --
2023-09-05 11:08 Marc Poulhiès
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=20230915142032.2100558-1-poulhies@adacore.com \
--to=poulhies@adacore.com \
--cc=gcc-patches@gcc.gnu.org \
--cc=miranda@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).