https://gcc.gnu.org/g:2a27188924a81fc3948c56353e35935b6d5682fd
commit r17-932-g2a27188924a81fc3948c56353e35935b6d5682fd Author: Eric Botcazou <[email protected]> Date: Mon Mar 9 18:59:11 2026 +0100 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: --- gcc/ada/exp_ch4.adb | 17 ++++++++++++----- gcc/ada/exp_util.adb | 12 +++++------- gcc/ada/sem_ch3.adb | 11 +++++++++-- 3 files changed, 26 insertions(+), 14 deletions(-) diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb index 9a77084f5241..fa567d32e5af 100644 --- 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 ea7aeb4d2c8d..172039b3a716 100644 --- 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 710d09a4192c..3348303b99a1 100644 --- 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;
