[Ada] Premature finalization of controlled temporaries in case expressions

[Pierre-Marie de Rodat]

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;

Tested on x86_64-pc-linux-gnu, committed on trunk

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.
-------------- next part --------------
A non-text attachment was scrubbed...
Name: patch.diff
Type: text/x-diff
Size: 1446 bytes
Desc: not available
URL: <http://gcc.gnu.org/pipermail/gcc-patches/attachments/20190722/aaf124a0/attachment.bin>