[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 0081c3e90ade82047c9c1c8d3fa436dbdb37df48..e9a4cbd9d052785d54f0c5223bd78bbe1140f9c9 100644 (file)
--- 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 18e9708cf7fc3934d5a5ccea302e3e93bd6a9c81..682c855d39b15c38120b99887fef28fa07d75321 100644 (file)
--- 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;