ada: Fix missing finalization for qualified expression in conditional expression

A qualified expression around a function call may cause a temporary to be
created and, therefore, cannot be bypassed in Expand_Ctrl_Function_Call.

gcc/ada/ChangeLog:

	* exp_util.ads (Unqualified_Unconditional_Parent): New function.
	* exp_util.adb (Unconditional_Parent): Do not look through qualified
	expressions.
	(Unqualified_Unconditional_Parent): New function identical to the
	original Unconditional_Parent.
	* exp_aggr.adb (Convert_To_Assignments): Replace Unconditional_Parent
	with Unqualified_Unconditional_Parent.
	(Expand_Array_Aggregate): Likewse.
	* exp_ch4.adb (Expand_N_Case_Expression): Likewise.
	(Expand_N_If_Expression): Likewise.
	* exp_ch6.adb (Expand_Ctrl_Function_Call): Do not bypass an enclosing
	qualified expression in the parent chain.

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index 6b4f4a19d1f9cb665a008c700f748a023e883f04..d62b7351e862ec450a66771326eed254ffe749a7 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -4283,7 +4283,7 @@ package body Exp_Aggr is
       --  Set the Expansion_Delayed flag in the cases where the transformation
       --  will be done top down from above.
 
-      Parent_Node := Unconditional_Parent (N);
+      Parent_Node := Unqualified_Unconditional_Parent (N);
 
       if
          --  Internal aggregates (transformed when expanding the parent),
@@ -6254,7 +6254,7 @@ package body Exp_Aggr is
       --  Set the Expansion_Delayed flag in the cases where the transformation
       --  will be done top down from above.
 
-      Parent_Node := Unconditional_Parent (N);
+      Parent_Node := Unqualified_Unconditional_Parent (N);
 
       if
          --  Internal aggregates (transformed when expanding the parent),

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 23a59de6f87225dead22498159a1529223db4ca7..8fba1c4e71fad83aad956f410733c87d80696081 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5198,7 +5198,8 @@ package body Exp_Ch4 is
 
       if not Expansion_Delayed (N) then
          declare
-            Uncond_Par : constant Node_Id := Unconditional_Parent (N);
+            Uncond_Par : constant Node_Id :=
+                           Unqualified_Unconditional_Parent (N);
          begin
             if Nkind (Uncond_Par) = N_Simple_Return_Statement
               or else Is_Optimizable_Declaration (Uncond_Par)
@@ -5807,7 +5808,8 @@ package body Exp_Ch4 is
 
       if not Expansion_Delayed (N) then
          declare
-            Uncond_Par : constant Node_Id := Unconditional_Parent (N);
+            Uncond_Par : constant Node_Id :=
+                           Unqualified_Unconditional_Parent (N);
          begin
             if Nkind (Uncond_Par) = N_Simple_Return_Statement
               or else Is_Optimizable_Declaration (Uncond_Par)

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 32e96bed2349599a33bec3a0ebc271566fb30269..5056b1f990fa47206b8f936634ce454bdf92bb27 100644 (file)
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5793,11 +5793,14 @@ package body Exp_Ch6 is
    is
       Par        : constant Node_Id := Parent (N);
       Uncond_Par : constant Node_Id := Unconditional_Parent (N);
+     --  Beware that a qualified expression around a function call cannot be
+     --  considered as transparent (like around an aggregate) because it may
+     --  cause a temporary to be created.
 
    begin
       --  Optimization: if the returned value is returned again, then no need
       --  to copy/readjust/finalize, we can just pass the value through (see
-      --  Expand_N_Simple_Return_Statement), and thus no attachment is needed.
+      --  Expand_Simple_Function_Return), and thus no attachment is needed.
       --  Note that simple return statements are distributed into conditional
       --  expressions, but we may be invoked before this distribution is done.
 

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 6ce6c0cd81d67d0d0705db93e6f8321f3a06d93d..4135e24424d3c9f0a55d48ee571b361411dcac0e 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -14903,6 +14903,37 @@ package body Exp_Util is
       Node        : Node_Id := N;
       Parent_Node : Node_Id := Parent (Node);
 
+   begin
+      loop
+         case Nkind (Parent_Node) is
+            when N_Case_Expression_Alternative =>
+               null;
+
+            when N_Case_Expression =>
+               exit when Node = Expression (Parent_Node);
+
+            when N_If_Expression =>
+               exit when Node = First (Expressions (Parent_Node));
+
+            when others =>
+               exit;
+         end case;
+
+         Node        := Parent_Node;
+         Parent_Node := Parent (Node);
+      end loop;
+
+      return Parent_Node;
+   end Unconditional_Parent;
+
+   --------------------------------------
+   -- Unqualified_Unconditional_Parent --
+   --------------------------------------
+
+   function Unqualified_Unconditional_Parent (N : Node_Id) return Node_Id is
+      Node        : Node_Id := N;
+      Parent_Node : Node_Id := Parent (Node);
+
    begin
       loop
          case Nkind (Parent_Node) is
@@ -14927,7 +14958,7 @@ package body Exp_Util is
       end loop;
 
       return Parent_Node;
-   end Unconditional_Parent;
+   end Unqualified_Unconditional_Parent;
 
    -------------------------------
    -- Update_Primitives_Mapping --

diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 4226fcc937773238b89e6286a798762ffa80f251..b7d8a185f4bd7688a03fc265c3ffbcf039429540 100644 (file)
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -1344,6 +1344,10 @@ package Exp_Util is
 
    function Unconditional_Parent (N : Node_Id) return Node_Id;
    --  Return the first parent of arbitrary node N that is not a conditional
+   --  expression, one of whose dependent expressions is N, recursively.
+
+   function Unqualified_Unconditional_Parent (N : Node_Id) return Node_Id;
+   --  Return the first parent of arbitrary node N that is not a conditional
    --  expression, one of whose dependent expressions is N, and that is not
    --  a qualified expression, whose expression is N, recursively.