From: "Marc Poulhiès" <poulhies@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Javier Miranda <miranda@adacore.com>
Subject: [COMMITTED] ada: Constraint_Error caused by interface conversion
Date: Tue, 18 Jul 2023 15:13:35 +0200 [thread overview]
Message-ID: <20230718131335.81230-1-poulhies@adacore.com> (raw)
From: Javier Miranda <miranda@adacore.com>
When the sources have a type conversion from an interface type
T2 to some ancestor interface type T1 (that is, T2 extends T1)
the tag check added by the compiler may fail at runtime.
gcc/ada/
* exp_disp.adb (Has_Dispatching_Constructor_Call): Removed.
(Expand_Interface_Conversion): Reverse patch.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_disp.adb | 94 ++------------------------------------------
1 file changed, 4 insertions(+), 90 deletions(-)
diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 9381ceee60c..9e0c87a5095 100644
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -1242,92 +1242,9 @@ package body Exp_Disp is
procedure Expand_Interface_Conversion (N : Node_Id) is
- function Has_Dispatching_Constructor_Call
- (Expr : Node_Id) return Boolean;
- -- Determines if the expression has a dispatching constructor call
-
function Underlying_Record_Type (Typ : Entity_Id) return Entity_Id;
-- Return the underlying record type of Typ
- --------------------------------------
- -- Has_Dispatching_Constructor_Call --
- --------------------------------------
-
- function Has_Dispatching_Constructor_Call (Expr : Node_Id) return Boolean
- is
- function Is_Dispatching_Constructor_Call (N : Node_Id) return Boolean;
- -- Determines if N is a dispatching constructor call
-
- function Process (Nod : Node_Id) return Traverse_Result;
- -- Traverse the expression searching for constructor calls
-
- -------------------------------------
- -- Is_Dispatching_Constructor_Call --
- -------------------------------------
-
- function Is_Dispatching_Constructor_Call (N : Node_Id) return Boolean
- is
- Param : Node_Id;
- Param_Type : Entity_Id;
- Assoc_Node : Node_Id;
- Gen_Func_Id : Entity_Id;
-
- begin
- if Nkind (N) = N_Function_Call
- and then Present (Parameter_Associations (N))
- then
- Param := First (Parameter_Associations (N));
-
- if Nkind (Param) = N_Parameter_Association then
- Param := Selector_Name (Param);
- end if;
-
- Param_Type := Etype (Param);
-
- if Is_Itype (Param_Type) then
- Assoc_Node := Associated_Node_For_Itype (Param_Type);
-
- if Nkind (Assoc_Node) = N_Function_Specification
- and then Present (Generic_Parent (Assoc_Node))
- then
- Gen_Func_Id := Generic_Parent (Assoc_Node);
-
- if Is_Intrinsic_Subprogram (Gen_Func_Id)
- and then Chars (Gen_Func_Id)
- = Name_Generic_Dispatching_Constructor
- then
- return True;
- end if;
- end if;
- end if;
- end if;
-
- return False;
- end Is_Dispatching_Constructor_Call;
-
- -------------
- -- Process --
- -------------
-
- function Process (Nod : Node_Id) return Traverse_Result is
- begin
- if Nkind (Nod) = N_Function_Call
- and then Is_Dispatching_Constructor_Call (Nod)
- then
- return Abandon;
- end if;
-
- return OK;
- end Process;
-
- function Traverse_Expression is new Traverse_Func (Process);
-
- -- Start of processing for Has_Dispatching_Constructor_Call
-
- begin
- return Traverse_Expression (Expr) = Abandon;
- end Has_Dispatching_Constructor_Call;
-
----------------------------
-- Underlying_Record_Type --
----------------------------
@@ -1430,16 +1347,13 @@ package body Exp_Disp is
-- object to reference the corresponding secondary dispatch table
-- (cf. Make_DT and Expand_Dispatching_Constructor_Call)).
- -- Under regular runtime this is a minor optimization that improves
- -- the generated code; under configurable runtime (where generic
- -- dispatching constructors are not supported) this optimization
- -- allows supporting this interface conversion, which otherwise
- -- would require calling the runtime routine to displace the
- -- pointer to the object.
+ -- Under configurable runtime it is safe to skip generating code to
+ -- displace the pointer to the object, because generic dispatching
+ -- constructors are not supported.
elsif Is_Interface (Iface_Typ)
and then Is_Ancestor (Iface_Typ, Opnd, Use_Full_View => True)
- and then not Has_Dispatching_Constructor_Call (Operand)
+ and then not RTE_Available (RE_Displace)
then
return;
end if;
--
2.40.0
reply other threads:[~2023-07-18 13:13 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=20230718131335.81230-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).