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 <dismu...@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.
--- gcc/ada/exp_ch5.adb
+++ 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;