https://gcc.gnu.org/g:bee720e9cc76c3d3e4d95d8a6f000c01a2803fe9

commit r16-8978-gbee720e9cc76c3d3e4d95d8a6f000c01a2803fe9
Author: Eric Botcazou <[email protected]>
Date:   Mon Jan 12 21:45:44 2026 +0100

    ada: Fix incorrect finalization of renamed function call at library level
    
    This is a regression present in recent releases for the peculiar case of the
    renaming of a controlled function call done at library level, which causes
    the compiler to create a dangling reference to a temporary created on the
    stack of the elaboration routine to hold the result of the function call.
    
    gcc/ada/ChangeLog:
    
            * exp_ch6.adb (Expand_Ctrl_Function_Call): Bail out for the name
            of an object renaming declaration at library level, if the call
            does not return on the secondary stack.
            * exp_ch8.adb (Expand_N_Object_Renaming_Declaration): Rewrite the
            renaming as a regular object declaration if it is declared at
            library level and the name is a controlled function call whose
            result is not returned on the secondary stack.
            * exp_util.adb (Rewrite_Object_Declaration_As_Renaming): Minor fix.

Diff:
---
 gcc/ada/exp_ch6.adb  | 12 ++++++++++++
 gcc/ada/exp_ch8.adb  | 41 +++++++++++++++++++++++++++++++++++++----
 gcc/ada/exp_util.adb |  2 +-
 3 files changed, 50 insertions(+), 5 deletions(-)

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index f96c6bc8d1ee..a3888d4a8f0b 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5824,6 +5824,18 @@ package body Exp_Ch6 is
          return;
       end if;
 
+      --  Do not expand the name of an object renaming declaration at library
+      --  level if the call does not return on the secondary stack, since the
+      --  renaming will eventually be turned into a regular object declaration
+      --  in Expand_N_Object_Renaming_Declaration.
+
+      if Nkind (Par) = N_Object_Renaming_Declaration
+        and then not Use_Sec_Stack
+        and then Is_Library_Level_Entity (Defining_Identifier (Par))
+      then
+         return;
+      end if;
+
       --  Resolution is now finished, make sure we don't start analysis again
       --  because of the duplication.
 
diff --git a/gcc/ada/exp_ch8.adb b/gcc/ada/exp_ch8.adb
index 488ed9fd1c13..785bc5736cf8 100644
--- a/gcc/ada/exp_ch8.adb
+++ b/gcc/ada/exp_ch8.adb
@@ -160,9 +160,11 @@ package body Exp_Ch8 is
 
       --  Local variables
 
+      Def_Id : constant Entity_Id := Defining_Identifier (N);
+      Nam    : constant Node_Id   := Name (N);
+      T      : constant Entity_Id := Etype (Def_Id);
+
       Decl : Node_Id;
-      Nam  : constant Node_Id   := Name (N);
-      T    : constant Entity_Id := Etype (Defining_Identifier (N));
 
    --  Start of processing for Expand_N_Object_Renaming_Declaration
 
@@ -171,7 +173,7 @@ package body Exp_Ch8 is
 
       if Evaluation_Required (Nam) then
          Evaluate_Name (Nam);
-         Set_Is_Renaming_Of_Object (Defining_Identifier (N));
+         Set_Is_Renaming_Of_Object (Def_Id);
       end if;
 
       --  Deal with construction of subtype in class-wide case
@@ -179,7 +181,7 @@ package body Exp_Ch8 is
       if Is_Class_Wide_Type (T) then
          Expand_Subtype_From_Expr (N, T, Subtype_Mark (N), Name (N));
          Find_Type (Subtype_Mark (N));
-         Set_Etype (Defining_Identifier (N), Entity (Subtype_Mark (N)));
+         Set_Etype (Def_Id, Entity (Subtype_Mark (N)));
 
          --  Freeze the class-wide subtype here to ensure that the subtype
          --  and equivalent type are frozen before the renaming.
@@ -200,6 +202,37 @@ package body Exp_Ch8 is
 
       elsif Present (Unqual_BIP_Iface_Function_Call (Nam)) then
          Make_Build_In_Place_Iface_Call_In_Anonymous_Context (Nam);
+
+      --  The renaming of a controlled function call declared at library level
+      --  must be turned into a regular object declaration if the result is not
+      --  returned on the secondary stack because, otherwise, the finalization
+      --  machinery of the library level would have the address of a temporary
+      --  created on the stack of the elaboration routine to hold the result.
+
+      elsif Nkind (Nam) = N_Function_Call
+        and then Is_Controlled (T)
+        and then not Needs_Secondary_Stack (T)
+        and then Is_Library_Level_Entity (Def_Id)
+      then
+         Rewrite (N,
+           Make_Object_Declaration (Sloc (N),
+             Defining_Identifier => Def_Id,
+             Constant_Present    => True,
+             Object_Definition   => New_Occurrence_Of (T, Sloc (N)),
+             Expression          => Nam));
+
+         --  We do not analyze this object declaration, because all its
+         --  components have already been analyzed, and if we were to go
+         --  ahead and analyze it, we would in effect be trying to generate
+         --  another declaration of Def_Id, which won't do.
+
+         Set_Analyzed (N);
+
+         --  Therefore we need to set the Has_Completion flag manually
+
+         Set_Has_Completion (Def_Id);
+
+         return;
       end if;
 
       --  Create renaming entry for debug information. Mark the entity as
diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 6909c65b34e2..6cdb4f21be1d 100644
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -13816,7 +13816,7 @@ package body Exp_Util is
       --  We do not analyze this renaming declaration, because all its
       --  components have already been analyzed, and if we were to go
       --  ahead and analyze it, we would in effect be trying to generate
-      --  another declaration of X, which won't do.
+      --  another declaration of Def_Id, which won't do.
 
       Set_Renamed_Object (Def_Id, Nam);
       Set_Analyzed (N);

Reply via email to