From 2418e23139edd33f1cab2158b46ac9bbd81b8bd7 Mon Sep 17 00:00:00 2001 From: Gary Dismukes Date: Mon, 22 Jul 2019 13:57:13 +0000 Subject: [PATCH] [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 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 --- gcc/ada/ChangeLog | 7 +++++++ gcc/ada/exp_ch5.adb | 23 ++++++++++++++++------- 2 files changed, 23 insertions(+), 7 deletions(-) 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 + + * 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 * 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; -- 2.30.2