ada: Distribute declaration of return object into conditional expressions

This lifts one of the limitations of the distribution of a declaration of
an object into the dependent expressions of its initialization expression
when it is a conditional expression, namely the case of the return object
of an extended return statement.

gcc/ada/ChangeLog:

	* exp_ch4.adb (Expand_N_Case_Expression): Deal with initialization
	expression of return object.
	(Expand_N_If_Expression): Likewise.
	(Insert_Conditional_Object_Declaration): Likewise.
	* exp_util.adb (Is_Distributable_Declaration): Lift limitation for
	return objects, including those with a class-wide type.
	* sem_ch3.adb (Analyze_Object_Declaration): Set Return_Applies_To
	on artificial return objects created from within a transient scope.
	Remove test on Expander_Active for better error recovery.

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 9a77084f524178afb3c31afeaae17cbc148e9e20..fa567d32e5afedc8920f073dfc34ffacbf397143 100644 (file)
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5219,10 +5219,10 @@ package body Exp_Ch4 is
       --    case X is
       --       when A =>
       --          then-obj : typ := then_expr;
-      --          target :=  then-obj'Unrestricted_Access;
+      --          target := then-obj'Unrestricted_Access;
       --       when B =>
       --          else-obj : typ := else-expr;
-      --          target :=  else-obj'Unrestricted_Access;
+      --          target := else-obj'Unrestricted_Access;
       --       ...
       --    end case
       --
@@ -5463,8 +5463,10 @@ package body Exp_Ch4 is
             --    Target := Obj'Unrestricted_Access;
 
             elsif Optimize_Object_Decl then
+               Par_Obj := Defining_Identifier (Par);
                Obj := Make_Temporary (Loc, 'C', Alt_Expr);
 
+               Set_Is_Return_Object (Obj, Is_Return_Object (Par_Obj));
                Insert_Conditional_Object_Declaration
                  (Obj, Typ, Alt_Expr, Const => Constant_Present (Par));
 
@@ -5827,10 +5829,10 @@ package body Exp_Ch4 is
 
       --    if cond then
       --       then-obj : typ := then_expr;
-      --       target :=  then-obj'Unrestricted_Access;
+      --       target := then-obj'Unrestricted_Access;
       --    else
       --       else-obj : typ := else-expr;
-      --       target :=  else-obj'Unrestricted_Access;
+      --       target := else-obj'Unrestricted_Access;
       --    end if;
       --
       --    obj : typ renames target.all;
@@ -6046,8 +6048,11 @@ package body Exp_Ch4 is
             Target   : constant Entity_Id := Make_Temporary (Loc, 'C', N);
 
          begin
+            Set_Is_Return_Object (Then_Obj, Is_Return_Object (Par_Obj));
             Insert_Conditional_Object_Declaration
               (Then_Obj, Typ, Thenx, Const => Constant_Present (Par));
+
+            Set_Is_Return_Object (Else_Obj, Is_Return_Object (Par_Obj));
             Insert_Conditional_Object_Declaration
               (Else_Obj, Typ, Elsex, Const => Constant_Present (Par));
 
@@ -13647,7 +13652,9 @@ package body Exp_Ch4 is
       --  cannot invoke Process_Transients_In_Expression on it since it is not
       --  a transient object (it has the lifetime of the original object).
 
-      if Needs_Finalization (Base_Type (Etype (Obj_Id))) then
+      if Needs_Finalization (Base_Type (Etype (Obj_Id)))
+        and then not Is_Return_Object (Obj_Id)
+      then
          Master_Node_Id := Make_Temporary (Loc, 'N');
          Master_Node_Decl :=
            Make_Master_Node_Declaration (Loc, Master_Node_Id, Obj_Id);

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index ea7aeb4d2c8d700a8b4228083031cbb62989d3d6..172039b3a716ac19ab19b2faa73f5d0d23f02baf 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -9090,20 +9090,18 @@ package body Exp_Util is
       Obj_Def : Node_Id;
 
    begin
-      --  First limitation: distribution is not implemented for return objects
-
-      if Nkind (N) /= N_Object_Declaration
-        or else Is_Return_Object (Defining_Identifier (N))
-      then
+      if Nkind (N) /= N_Object_Declaration then
          return False;
       end if;
 
       Obj_Def := Object_Definition (N);
 
-      --  Second limitation: distribution is not implemented for CW types
+      --  Current limitation: distribution is not implemented for CW types,
+      --  except for return objects which always live on the secondary stack.
 
       if Is_Entity_Name (Obj_Def)
-        and then Is_Class_Wide_Type (Entity (Obj_Def))
+        and then (Is_Class_Wide_Type (Entity (Obj_Def))
+                   and then not Is_Return_Object (Defining_Identifier (N)))
       then
          return False;
       end if;

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 710d09a4192c92b1e0b8d0ded50ddad309e974f0..3348303b99a15af42c7b894673a136551d7188b0 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -4520,6 +4520,14 @@ package body Sem_Ch3 is
          Generate_Definition (Id);
          Enter_Name (Id);
 
+         --  For artificial return objects created from within a transient
+         --  scope, propagate Return_Applies_To from the enclosing return.
+
+         if Is_Return_Object (Id) and then Scope_Is_Transient then
+            Set_Return_Applies_To
+              (Scope (Id), Return_Applies_To (Scope (Scope (Id))));
+         end if;
+
          Mark_Coextensions (N, Object_Definition (N));
 
          T := Find_Type_Of_Object (Object_Definition (N), N);
@@ -4775,8 +4783,7 @@ package body Sem_Ch3 is
          --  has been replaced by a renaming declaration during its expansion
          --  (see Expand_N_Case_Expression and Expand_N_If_Expression).
 
-         if Expander_Active
-           and then Nkind (E) in N_Case_Expression | N_If_Expression
+         if Nkind (E) in N_Case_Expression | N_If_Expression
            and then Nkind (N) = N_Object_Renaming_Declaration
          then
             goto Leave;