ada: Fix memory leak for unconstrained limited arrays in anonymous contexts

A change made a long time ago has introduced a leak of the secondary stack
at run time for unconstrained limited non-controlled arrays in anonymous
contexts, because of the lack of a transient scope in these contexts.

The large comment preceding the call to Establish_Transient_Scope in the
Resolve_Call procedure explains the strategy for build-in-place functions,
so the best course of action is probably to revert the commit and to fix
the original problem along the lines of the comment.

gcc/ada/ChangeLog:

	* exp_ch3.adb (Expand_N_Object_Declaration): Delete ancient comment.
	* exp_ch6.adb (Expand_Call_Helper): Do not establish a transient
	scope for build-in-place functions in anonymous contexts here...
	(Make_Build_In_Place_Call_In_Anonymous_Context): ...but here instead.
	* sem_attr.adb (Resolve_Attribute) <Attribute_Range>: Remove obsolete
	code dealing with transient scopes.
	* sem_res.adb (Resolve_Actuals): Likewise.
	(Resolve_Call): Adjust comment on the strategy for transient scopes.

diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index db41ab75d3e454fb1acd6e29051c465c0a0bb431..fbc7060a7442f6077f61f6a314f2b44d034120eb 100644 (file)
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -7858,10 +7858,7 @@ package body Exp_Ch3 is
 
          --  Ada 2005 (AI-318-02): If the initialization expression is a call
          --  to a build-in-place function, then access to the declared object
-         --  must be passed to the function. Currently we limit such functions
-         --  to those with constrained limited result subtypes, but eventually
-         --  plan to expand the allowed forms of functions that are treated as
-         --  build-in-place.
+         --  must be passed to the function.
 
          elsif Is_Build_In_Place_Function_Call (Expr_Q) then
             Make_Build_In_Place_Call_In_Object_Declaration (N, Expr_Q);

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index eb141839a3efb185f7beef8435c625d81bb195e6..f41dca311d1d49127e745e438e054a623871f1e2 100644 (file)
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -5713,38 +5713,13 @@ package body Exp_Ch6 is
 
       if Nkind (Call_Node) = N_Function_Call
         and then Needs_Finalization (Etype (Call_Node))
+        and then not Is_Build_In_Place_Function_Call (Call_Node)
+        and then (No (First_Formal (Subp))
+                   or else not
+                     Is_Concurrent_Record_Type (Etype (First_Formal (Subp))))
       then
-         if not Is_Build_In_Place_Function_Call (Call_Node)
-           and then
-             (No (First_Formal (Subp))
-               or else
-                 not Is_Concurrent_Record_Type (Etype (First_Formal (Subp))))
-         then
-            Expand_Ctrl_Function_Call
-              (Call_Node, Needs_Secondary_Stack (Etype (Call_Node)));
-
-         --  Build-in-place function calls which appear in anonymous contexts
-         --  need a transient scope to ensure the proper finalization of the
-         --  intermediate result after its use.
-
-         elsif Is_Build_In_Place_Function_Call (Call_Node)
-           and then Nkind (Parent (Unqual_Conv (Call_Node))) in
-                      N_Attribute_Reference
-                    | N_Function_Call
-                    | N_Indexed_Component
-                    | N_Object_Renaming_Declaration
-                    | N_Procedure_Call_Statement
-                    | N_Selected_Component
-                    | N_Slice
-           and then
-             (Ekind (Current_Scope) /= E_Loop
-               or else Nkind (Parent (Call_Node)) /= N_Function_Call
-               or else not
-                 Is_Build_In_Place_Function_Call (Parent (Call_Node)))
-         then
-            Establish_Transient_Scope
-              (Call_Node, Needs_Secondary_Stack (Etype (Call_Node)));
-         end if;
+         Expand_Ctrl_Function_Call
+           (Call_Node, Needs_Secondary_Stack (Etype (Call_Node)));
 
       --  Functions returning noncontrolled objects that may be subject to
       --  user-defined indexing also need special attention. The problem
@@ -9313,6 +9288,8 @@ package body Exp_Ch6 is
       Loc         : constant Source_Ptr := Sloc (Function_Call);
       Func_Call   : constant Node_Id    := Unqual_Conv (Function_Call);
       Function_Id : Entity_Id;
+      Known_Size  : Boolean;
+      Needs_Fin   : Boolean;
       Result_Subt : Entity_Id;
 
    begin
@@ -9339,11 +9316,12 @@ package body Exp_Ch6 is
       Warn_BIP (Func_Call);
 
       Result_Subt := Etype (Function_Id);
+      Known_Size := Caller_Known_Size (Func_Call, Result_Subt);
+      Needs_Fin := Needs_Finalization (Result_Subt);
 
       --  If the build-in-place function returns a controlled object, then the
-      --  object needs to be finalized immediately after the context. Since
-      --  this case produces a transient scope, the servicing finalizer needs
-      --  to name the returned object.
+      --  object needs to be finalized immediately after the context is exited,
+      --  which requires the creation of a transient scope and a named object.
 
       --  If the build-in-place function returns a definite subtype, then an
       --  object also needs to be created and an access value designating it
@@ -9357,9 +9335,12 @@ package body Exp_Ch6 is
       --  the expander using the appropriate mechanism in Make_Build_In_Place_
       --  Call_In_Object_Declaration.
 
-      if Needs_Finalization (Result_Subt)
-        or else Caller_Known_Size (Func_Call, Result_Subt)
-      then
+      if Needs_Fin or else Known_Size then
+         if Needs_Fin then
+            Establish_Transient_Scope
+              (Func_Call, Manage_Sec_Stack => not Known_Size);
+         end if;
+
          declare
             Temp_Id   : constant Entity_Id := Make_Temporary (Loc, 'R');
             Temp_Decl : constant Node_Id   :=
@@ -9400,6 +9381,8 @@ package body Exp_Ch6 is
          Add_Access_Actual_To_Build_In_Place_Call
            (Func_Call, Function_Id, Empty);
 
+         Establish_Transient_Scope (Func_Call, Manage_Sec_Stack => True);
+
          --  Mark the call as processed as a build-in-place call
 
          Set_Is_Expanded_Build_In_Place_Call (Func_Call);

diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 20270c20fe13d2ae66536b86995b7c148ea767c5..95f1466968a932bffbedef43eb7e5150b684b501 100644 (file)
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -12631,16 +12631,6 @@ package body Sem_Attr is
          begin
             if not Is_Entity_Name (P) or else not Is_Type (Entity (P)) then
                Resolve (P);
-
-               --  If the prefix is a function call returning on the secondary
-               --  stack, we must make sure to mark/release the stack.
-
-               if Nkind (P) = N_Function_Call
-                 and then Nkind (Parent (N)) = N_Loop_Parameter_Specification
-                 and then Requires_Transient_Scope (Etype (P))
-               then
-                  Set_Uses_Sec_Stack (Scope (Current_Scope));
-               end if;
             end if;
 
             Dims := Expressions (N);

diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index a0287f1abe579f8543fda11abadedc0fd62a4160..a44016c8012c7da9c14937bdca52ed2858e4b970 100644 (file)
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -4486,21 +4486,6 @@ package body Sem_Res is
                   Set_Do_Range_Check (Expression (A));
                end if;
 
-            --  If the actual is a function call that returns a limited
-            --  unconstrained object that needs finalization, create a
-            --  transient scope for it, so that it can receive the proper
-            --  finalization list.
-
-            elsif Expander_Active
-              and then Nkind (A) = N_Function_Call
-              and then Is_Limited_Record (Etype (F))
-              and then not Is_Constrained (Etype (F))
-              and then (Needs_Finalization (Etype (F))
-                         or else Has_Task (Etype (F)))
-            then
-               Establish_Transient_Scope (A, Manage_Sec_Stack => False);
-               Resolve (A, Etype (F));
-
             --  A small optimization: if one of the actuals is a concatenation
             --  create a block around a procedure call to recover stack space.
             --  This alleviates stack usage when several procedure calls in
@@ -7063,10 +7048,11 @@ package body Sem_Res is
 
       --  b) Subprograms that are ignored ghost entities do not return anything
 
-      --  c) Calls to a build-in-place function, since such functions may
-      --  allocate their result directly in a target object, and cases where
-      --  the result does get allocated in the secondary stack are checked for
-      --  within the specialized Exp_Ch6 procedures for expanding those
+      --  c) Calls to a build-in-place function, since such functions allocate
+      --  their result directly in the target object or on the secondary stack,
+      --  and cases where the target object needs to be created and destroyed
+      --  on exit to the context, or the secondary stack is used, are checked
+      --  for within the specialized Exp_Ch6 procedures for expanding those
       --  build-in-place calls.
 
       --  d) Calls to inlinable expression functions do not use the secondary