ada: Fix too late finalization of temporary object

The problem is that Is_Finalizable_Transient returns false when a transient
object is subject to a renaming by another transient object present in the
same transient scope, thus forcing its finalization to be deferred to the
enclosing scope.  That's not necessary, as only renamings by nontransient
objects serviced by transient scopes need to be rejected by the predicate.

The change also removes now dead code in the finalization machinery.

gcc/ada/

	PR ada/114710
	* exp_ch7.adb (Build_Finalizer.Process_Declarations): Remove dead
	code dealing with renamings.
	* exp_util.ads (Is_Finalizable_Transient): Rename Rel_Node to N.
	* exp_util.adb (Is_Finalizable_Transient): Likewise.
	(Is_Aliased): Remove obsolete code dealing wih EWA nodes and only
	consider renamings present in N itself.
	(Requires_Cleanup_Actions): Remove dead code dealing with renamings.

diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb
index fd1d9db06544e3d2e6660b603268cd4ff9469bad..3583ed3138f4092fc7334220b7107f48f4a9da87 100644 (file)
--- a/gcc/ada/exp_ch7.adb
+++ b/gcc/ada/exp_ch7.adb
@@ -2477,26 +2477,6 @@ package body Exp_Ch7 is
                   Processing_Actions (Decl, Is_Protected => True);
                end if;
 
-            --  Specific cases of object renamings
-
-            elsif Nkind (Decl) = N_Object_Renaming_Declaration then
-               Obj_Id  := Defining_Identifier (Decl);
-               Obj_Typ := Base_Type (Etype (Obj_Id));
-
-               --  Bypass any form of processing for objects which have their
-               --  finalization disabled. This applies only to objects at the
-               --  library level.
-
-               if For_Package and then Finalize_Storage_Only (Obj_Typ) then
-                  null;
-
-               --  Ignored Ghost object renamings do not need any cleanup
-               --  actions because they will not appear in the final tree.
-
-               elsif Is_Ignored_Ghost_Entity (Obj_Id) then
-                  null;
-               end if;
-
             --  Inspect the freeze node of an access-to-controlled type and
             --  look for a delayed finalization collection. This case arises
             --  when the freeze actions are inserted at a later time than the

diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb
index 654ea7d912458aedbfa3633e5cfe12c59325c8b9..6ad464e6701054bd7c1e5f86cab206b5ae974913 100644 (file)
--- a/gcc/ada/exp_util.adb
+++ b/gcc/ada/exp_util.adb
@@ -8646,8 +8646,8 @@ package body Exp_Util is
    ------------------------------
 
    function Is_Finalizable_Transient
-     (Decl     : Node_Id;
-      Rel_Node : Node_Id) return Boolean
+     (Decl : Node_Id;
+      N    : Node_Id) return Boolean
    is
       Obj_Id  : constant Entity_Id := Defining_Identifier (Decl);
       Obj_Typ : constant Entity_Id := Base_Type (Etype (Obj_Id));
@@ -8889,61 +8889,53 @@ package body Exp_Util is
       --  Start of processing for Is_Aliased
 
       begin
-         --  A controlled transient object is not considered aliased when it
-         --  appears inside an expression_with_actions node even when there are
-         --  explicit aliases of it:
-
-         --    do
-         --       Trans_Id : Ctrl_Typ ...;  --  transient object
-         --       Alias : ... := Trans_Id;  --  object is aliased
-         --       Val : constant Boolean :=
-         --               ... Alias ...;    --  aliasing ends
-         --       <finalize Trans_Id>       --  object safe to finalize
-         --    in Val end;
-
-         --  Expansion ensures that all aliases are encapsulated in the actions
-         --  list and do not leak to the expression by forcing the evaluation
-         --  of the expression.
-
-         if Nkind (Rel_Node) = N_Expression_With_Actions then
-            return False;
-
-         --  Otherwise examine the statements after the controlled transient
-         --  object and look for various forms of aliasing.
-
-         else
-            Stmt := First_Stmt;
-            while Present (Stmt) loop
-               if Nkind (Stmt) = N_Object_Declaration then
-                  Expr := Expression (Stmt);
+         --  Examine the statements following the controlled object and look
+         --  for various forms of aliasing.
+
+         Stmt := First_Stmt;
+         while Present (Stmt) loop
+            --  Transient objects initialized by a reference are finalized
+            --  (see Initialized_By_Reference above), so we must make sure
+            --  not to finalize the referenced object twice. And we cannot
+            --  finalize it at all if it is referenced by the nontransient
+            --  object serviced by the transient scope.
+
+            if Nkind (Stmt) = N_Object_Declaration then
+               Expr := Expression (Stmt);
+
+               --  Aliasing of the form:
+               --    Obj : ... := Trans_Id'reference;
+
+               if Present (Expr)
+                 and then Nkind (Expr) = N_Reference
+                 and then Is_Entity_Name (Prefix (Expr))
+                 and then Entity (Prefix (Expr)) = Trans_Id
+               then
+                  return True;
+               end if;
 
-                  --  Aliasing of the form:
-                  --    Obj : ... := Trans_Id'reference;
+            --  (Transient) renamings are never finalized so we need not bother
+            --  about finalizing transient renamed objects twice. Therefore, we
+            --  we only need to look at the nontransient object serviced by the
+            --  transient scope, if it exists and is declared as a renaming.
 
-                  if Present (Expr)
-                    and then Nkind (Expr) = N_Reference
-                    and then Nkind (Prefix (Expr)) = N_Identifier
-                    and then Entity (Prefix (Expr)) = Trans_Id
-                  then
-                     return True;
-                  end if;
-
-               elsif Nkind (Stmt) = N_Object_Renaming_Declaration then
-                  Ren_Obj := Find_Renamed_Object (Stmt);
+            elsif Nkind (Stmt) = N_Object_Renaming_Declaration
+              and then Stmt = N
+            then
+               Ren_Obj := Find_Renamed_Object (Stmt);
 
-                  --  Aliasing of the form:
-                  --    Obj : ... renames ... Trans_Id ...;
+               --  Aliasing of the form:
+               --    Obj : ... renames ... Trans_Id ...;
 
-                  if Present (Ren_Obj) and then Ren_Obj = Trans_Id then
-                     return True;
-                  end if;
+               if Present (Ren_Obj) and then Ren_Obj = Trans_Id then
+                  return True;
                end if;
+            end if;
 
-               Next (Stmt);
-            end loop;
+            Next (Stmt);
+         end loop;
 
-            return False;
-         end if;
+         return False;
       end Is_Aliased;
 
       --------------------------
@@ -9161,8 +9153,8 @@ package body Exp_Util is
       return
         Ekind (Obj_Id) in E_Constant | E_Variable
           and then Needs_Finalization (Desig)
-          and then Nkind (Rel_Node) /= N_Simple_Return_Statement
-          and then not Is_Part_Of_BIP_Return_Statement (Rel_Node)
+          and then Nkind (N) /= N_Simple_Return_Statement
+          and then not Is_Part_Of_BIP_Return_Statement (N)
 
           --  Do not consider a transient object that was already processed
 
@@ -13488,26 +13480,6 @@ package body Exp_Util is
                return True;
             end if;
 
-         --  Specific cases of object renamings
-
-         elsif Nkind (Decl) = N_Object_Renaming_Declaration then
-            Obj_Id  := Defining_Identifier (Decl);
-            Obj_Typ := Base_Type (Etype (Obj_Id));
-
-            --  Bypass any form of processing for objects which have their
-            --  finalization disabled. This applies only to objects at the
-            --  library level.
-
-            if Lib_Level and then Finalize_Storage_Only (Obj_Typ) then
-               null;
-
-            --  Ignored Ghost object renamings do not need any cleanup actions
-            --  because they will not appear in the final tree.
-
-            elsif Is_Ignored_Ghost_Entity (Obj_Id) then
-               null;
-            end if;
-
          --  Inspect the freeze node of an access-to-controlled type and look
          --  for a delayed finalization collection. This case arises when the
          --  freeze actions are inserted at a later time than the expansion of

diff --git a/gcc/ada/exp_util.ads b/gcc/ada/exp_util.ads
index 3c7e70ed13b70481eb0848cc86a26391b1873e82..8d64b11d750b15afecee51d34b99958b45a57ca6 100644 (file)
--- a/gcc/ada/exp_util.ads
+++ b/gcc/ada/exp_util.ads
@@ -764,12 +764,10 @@ package Exp_Util is
    --    Rnn.all
 
    function Is_Finalizable_Transient
-     (Decl     : Node_Id;
-      Rel_Node : Node_Id) return Boolean;
-   --  Determine whether declaration Decl denotes a controlled transient which
-   --  should be finalized. Rel_Node is the related context. Even though some
-   --  transients are controlled, they may act as renamings of other objects or
-   --  function calls.
+     (Decl : Node_Id;
+      N    : Node_Id) return Boolean;
+   --  Determine whether declaration Decl denotes a controlled transient object
+   --  that must be finalized. N is the node serviced by the transient context.
 
    function Is_Fully_Repped_Tagged_Type (T : Entity_Id) return Boolean;
    --  Tests given type T, and returns True if T is a non-discriminated tagged