aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGary Dismukes <dismukes@adacore.com>2019-07-22 13:57:13 +0000
committerPierre-Marie de Rodat <pmderodat@gcc.gnu.org>2019-07-22 13:57:13 +0000
commit2418e23139edd33f1cab2158b46ac9bbd81b8bd7 (patch)
tree86ff13cbe12830f1d6fafeae04b53d040aa96296
parente7f4682af254be73f91ddbb543bc0bc3fcd27659 (diff)
downloadgcc-2418e23139edd33f1cab2158b46ac9bbd81b8bd7.zip
gcc-2418e23139edd33f1cab2158b46ac9bbd81b8bd7.tar.gz
gcc-2418e23139edd33f1cab2158b46ac9bbd81b8bd7.tar.bz2
[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
-rw-r--r--gcc/ada/ChangeLog7
-rw-r--r--gcc/ada/exp_ch5.adb23
2 files changed, 23 insertions, 7 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 0081c3e..e9a4cbd 100644
--- 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 18e9708..682c855 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;