@@ -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;
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.