From: Gary Dismukes <dismukes@adacore.com>
Date: Mon, 22 Jul 2019 13:57:13 +0000 (+0000)
Subject: [Ada] Premature finalization of controlled temporaries in case expressions
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=2418e23139edd33f1cab2158b46ac9bbd81b8bd7;p=gcc.git

[Ada] Premature finalization of controlled temporaries in case expressions

The compiler was generating finalization of temporary objects used in
evaluating case expressions for controlled types in cases where the case
statement created by Expand_N_Expression_With_Actions is rewritten as an
if statement. This is fixed by inheriting the From_Condition_Expression
flag from the rewritten case statement.

The test below must generate the following output when executed:

$ main
Xs(1): 1

----

package Test is

   type E is (E1, E2);
   procedure Test (A : in E);

end Test;

----

with Ada.Text_IO;
with Ada.Finalization;

package body Test is

   type T is new Ada.Finalization.Controlled with
      record
         N : Natural := 0;
      end record;

   overriding procedure Finalize (X : in out T) is
   begin
      X.N := 42;
   end Finalize;

   type T_Array is array (Positive range <>) of T;

   function Make_T (N : Natural) return T is
   begin
      return (Ada.Finalization.Controlled with N => N);
   end Make_T;

   X1 : constant T := Make_T (1);
   X2 : constant T := Make_T (2);

   procedure Test (A : in E)
   is
      Xs : constant T_Array := (case A is
                                   when E1 => (1 => X1),
                                   when E2 => (1 => X2));
   begin
      Ada.Text_IO.Put_Line ("Xs(1):" & Natural'Image (Xs (1).N));
   end Test;

end Test;

----

with Test;

procedure Main is
begin
   Test.Test (Test.E1);
end Main;

2019-07-22  Gary Dismukes  <dismukes@adacore.com>

gcc/ada/

	* exp_ch5.adb (Expand_N_Case_Statement): In the case where a
	case statement is rewritten as an equivalent if statement,
	inherit the From_Condition_Expression flag from the case
	statement.

From-SVN: r273678
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0081c3e90ad..e9a4cbd9d05 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,10 @@
+2019-07-22  Gary Dismukes  <dismukes@adacore.com>
+
+	* exp_ch5.adb (Expand_N_Case_Statement): In the case where a
+	case statement is rewritten as an equivalent if statement,
+	inherit the From_Condition_Expression flag from the case
+	statement.
+
 2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* sem_ch8.adb (Check_Constrained_Object): Further extend the
diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb
index 18e9708cf7f..682c855d39b 100644
--- a/gcc/ada/exp_ch5.adb
+++ b/gcc/ada/exp_ch5.adb
@@ -2856,13 +2856,14 @@ package body Exp_Ch5 is
    -----------------------------
 
    procedure Expand_N_Case_Statement (N : Node_Id) is
-      Loc    : constant Source_Ptr := Sloc (N);
-      Expr   : constant Node_Id    := Expression (N);
-      Alt    : Node_Id;
-      Len    : Nat;
-      Cond   : Node_Id;
-      Choice : Node_Id;
-      Chlist : List_Id;
+      Loc            : constant Source_Ptr := Sloc (N);
+      Expr           : constant Node_Id    := Expression (N);
+      From_Cond_Expr : constant Boolean    := From_Conditional_Expression (N);
+      Alt            : Node_Id;
+      Len            : Nat;
+      Cond           : Node_Id;
+      Choice         : Node_Id;
+      Chlist         : List_Id;
 
    begin
       --  Check for the situation where we know at compile time which branch
@@ -3073,7 +3074,15 @@ package body Exp_Ch5 is
                    Condition => Cond,
                    Then_Statements => Then_Stms,
                    Else_Statements => Else_Stms));
+
+               --  The rewritten if statement needs to inherit whether the
+               --  case statement was expanded from a conditional expression,
+               --  for proper handling of nested controlled objects.
+
+               Set_From_Conditional_Expression (N, From_Cond_Expr);
+
                Analyze (N);
+
                return;
             end if;
          end if;