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 --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 8b5e0e4bb984f0ee4982b1b3b5996eb6f742a7d7..50fffdffd8e2b9a46a7f4a7ba57fd7b5839de7f3 100644 (file)
--- 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 488ed9fd1c1335061aebd88616933ab1fe473d07..785bc5736cf8fc537841a4567b7c7a879cec6aca 100644 (file)
--- 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 d93e3b10017d9746cd52825b1f48ba56ca56eb01..35861d2ad29ecfb33cea0aae73d8f690127c8f95 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -13943,7 +13943,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);