public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
From: "Marc Poulhiès" <poulhies@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Eric Botcazou <ebotcazou@adacore.com>
Subject: [COMMITTED] ada: Fix expansion of aggregates with controlled components
Date: Tue, 13 Jun 2023 09:37:53 +0200	[thread overview]
Message-ID: <20230613073753.239309-1-poulhies@adacore.com> (raw)

From: Eric Botcazou <ebotcazou@adacore.com>

The expansion is incorrect in the case where the initialization expression
of a component is a conditional expression that has a function call as one
of its dependent expressions, leading to a wrong order of initialization,
adjustment and finalization.

gcc/ada/

	* exp_aggr.adb (Initialize_Component): Perform immediate expansion
	of the initialization expression if it is a conditional expression
	and the component type is controlled.

Tested on x86_64-pc-linux-gnu, committed on master.

---
 gcc/ada/exp_aggr.adb | 102 +++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 99 insertions(+), 3 deletions(-)

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index e5b2cedb954..8c6c9f97429 100644
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -8444,8 +8444,104 @@ package body Exp_Aggr is
       Comp      : Node_Id;
       Comp_Typ  : Entity_Id;
       Init_Expr : Node_Id;
-      Stmts     : List_Id) is
+      Stmts     : List_Id)
+   is
+      Init_Expr_Q : constant Node_Id    := Unqualify (Init_Expr);
+      Loc         : constant Source_Ptr := Sloc (N);
+
    begin
+      --  If the initialization expression of a component with controlled type
+      --  is a conditional expression that has a function call as one of its
+      --  dependent expressions, then we need to expand it immediately, so as
+      --  to trigger the special processing for function calls with controlled
+      --  type below and avoid a wrong order of initialization, adjustment and
+      --  finalization in the context of aggregates. For the sake of uniformity
+      --  we perform this expansion for all conditional expressions.
+
+      if Nkind (Init_Expr_Q) = N_If_Expression
+        and then Present (Comp_Typ)
+        and then Needs_Finalization (Comp_Typ)
+      then
+         declare
+            Cond       : constant Node_Id := First (Expressions (Init_Expr_Q));
+            Thenx      : constant Node_Id := Next (Cond);
+            Elsex      : constant Node_Id := Next (Thenx);
+            Then_Stmts : constant List_Id := New_List;
+            Else_Stmts : constant List_Id := New_List;
+
+            If_Stmt : Node_Id;
+
+         begin
+            Initialize_Component
+              (N         => N,
+               Comp      => Comp,
+               Comp_Typ  => Comp_Typ,
+               Init_Expr => Thenx,
+               Stmts     => Then_Stmts);
+
+            Initialize_Component
+              (N         => N,
+               Comp      => Comp,
+               Comp_Typ  => Comp_Typ,
+               Init_Expr => Elsex,
+               Stmts     => Else_Stmts);
+
+            If_Stmt :=
+              Make_Implicit_If_Statement (N,
+                Condition       => Relocate_Node (Cond),
+                Then_Statements => Then_Stmts,
+                Else_Statements => Else_Stmts);
+
+            Set_From_Conditional_Expression (If_Stmt);
+            Append_To (Stmts, If_Stmt);
+         end;
+
+      elsif Nkind (Init_Expr_Q) = N_Case_Expression
+        and then Present (Comp_Typ)
+        and then Needs_Finalization (Comp_Typ)
+      then
+         declare
+            Alt       : Node_Id;
+            Alt_Stmts : List_Id;
+            Case_Stmt : Node_Id;
+
+         begin
+            Case_Stmt :=
+               Make_Case_Statement (Loc,
+                 Expression   =>
+                   Relocate_Node (Expression (Init_Expr_Q)),
+                 Alternatives => New_List);
+
+            Alt := First (Alternatives (Init_Expr_Q));
+            while Present (Alt) loop
+               declare
+                  Alt_Expr : constant Node_Id    := Expression (Alt);
+                  Alt_Loc  : constant Source_Ptr := Sloc (Alt_Expr);
+
+               begin
+                  Alt_Stmts := New_List;
+
+                  Initialize_Component
+                    (N         => N,
+                     Comp      => Comp,
+                     Comp_Typ  => Comp_Typ,
+                     Init_Expr => Alt_Expr,
+                     Stmts     => Alt_Stmts);
+
+                  Append_To
+                    (Alternatives (Case_Stmt),
+                     Make_Case_Statement_Alternative (Alt_Loc,
+                     Discrete_Choices => Discrete_Choices (Alt),
+                     Statements       => Alt_Stmts));
+               end;
+
+               Next (Alt);
+            end loop;
+
+            Set_From_Conditional_Expression (Case_Stmt);
+            Append_To (Stmts, Case_Stmt);
+         end;
+
       --  Handle an initialization expression of a controlled type in
       --  case it denotes a function call. In general such a scenario
       --  will produce a transient scope, but this will lead to wrong
@@ -8477,9 +8573,9 @@ package body Exp_Aggr is
       --    Adjust (Comp);
       --    Finalize (Res);
 
-      if Present (Comp_Typ)
+      elsif Nkind (Init_Expr_Q) /= N_Aggregate
+        and then Present (Comp_Typ)
         and then Needs_Finalization (Comp_Typ)
-        and then Nkind (Unqualify (Init_Expr)) /= N_Aggregate
       then
          Initialize_Controlled_Component
            (N         => N,
-- 
2.40.0


                 reply	other threads:[~2023-06-13  7:37 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=20230613073753.239309-1-poulhies@adacore.com \
    --to=poulhies@adacore.com \
    --cc=ebotcazou@adacore.com \
    --cc=gcc-patches@gcc.gnu.org \
    /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).