===================================================================
@@ -258,6 +258,13 @@
-- Expand simple return from function. In the case where we are returning
-- from a function body this is called by Expand_N_Simple_Return_Statement.
+ procedure Set_Enclosing_Sec_Stack_Return (N : Node_Id);
+ -- N is a return statement for a function that returns its result on the
+ -- secondary stack. This sets the Sec_Stack_Needed_For_Return flag on the
+ -- function and all blocks and loops that the return statement is jumping
+ -- out of. This ensures that the secondary stack is not released; otherwise
+ -- the function result would be reclaimed before returning to the caller.
+
----------------------------------------------
-- Add_Access_Actual_To_Build_In_Place_Call --
----------------------------------------------
@@ -4662,18 +4669,18 @@
-- The allocator is returned on the secondary stack,
-- so indicate that the function return, as well as
- -- the block that encloses the allocator, must not
+ -- all blocks that encloses the allocator, must not
-- release it. The flags must be set now because
-- the decision to use the secondary stack is done
-- very late in the course of expanding the return
-- statement, past the point where these flags are
-- normally set.
- Set_Sec_Stack_Needed_For_Return (Func_Id);
+ Set_Uses_Sec_Stack (Func_Id);
+ Set_Uses_Sec_Stack (Return_Statement_Entity (N));
Set_Sec_Stack_Needed_For_Return
(Return_Statement_Entity (N));
- Set_Uses_Sec_Stack (Func_Id);
- Set_Uses_Sec_Stack (Return_Statement_Entity (N));
+ Set_Enclosing_Sec_Stack_Return (N);
-- Create an if statement to test the BIP_Alloc_Form
-- formal and initialize the access object to either the
@@ -5966,45 +5973,11 @@
else
-- Prevent the reclamation of the secondary stack by all enclosing
- -- blocks and loops as well as the related function, otherwise the
- -- result will be reclaimed too early or even clobbered. Due to a
- -- possible mix of internally generated blocks, source blocks and
- -- loops, the scope stack may not be contiguous as all labels are
- -- inserted at the top level within the related function. Instead,
- -- perform a parent-based traversal and mark all appropriate
- -- constructs.
+ -- blocks and loops as well as the related function; otherwise the
+ -- result would be reclaimed too early.
- declare
- P : Node_Id;
+ Set_Enclosing_Sec_Stack_Return (N);
- begin
- P := N;
- while Present (P) loop
-
- -- Mark the label of a source or internally generated block or
- -- loop.
-
- if Nkind_In (P, N_Block_Statement, N_Loop_Statement) then
- Set_Sec_Stack_Needed_For_Return (Entity (Identifier (P)));
-
- -- Mark the enclosing function
-
- elsif Nkind (P) = N_Subprogram_Body then
- if Present (Corresponding_Spec (P)) then
- Set_Sec_Stack_Needed_For_Return (Corresponding_Spec (P));
- else
- Set_Sec_Stack_Needed_For_Return (Defining_Entity (P));
- end if;
-
- -- Do not go beyond the enclosing function
-
- exit;
- end if;
-
- P := Parent (P);
- end loop;
- end;
-
-- Optimize the case where the result is a function call. In this
-- case either the result is already on the secondary stack, or is
-- already being returned with the stack pointer depressed and no
@@ -9418,6 +9391,45 @@
end if;
end Needs_Result_Accessibility_Level;
+ ------------------------------------
+ -- Set_Enclosing_Sec_Stack_Return --
+ ------------------------------------
+
+ procedure Set_Enclosing_Sec_Stack_Return (N : Node_Id) is
+ P : Node_Id := N;
+
+ begin
+ -- Due to a possible mix of internally generated blocks, source blocks
+ -- and loops, the scope stack may not be contiguous as all labels are
+ -- inserted at the top level within the related function. Instead,
+ -- perform a parent-based traversal and mark all appropriate constructs.
+
+ while Present (P) loop
+
+ -- Mark the label of a source or internally generated block or
+ -- loop.
+
+ if Nkind_In (P, N_Block_Statement, N_Loop_Statement) then
+ Set_Sec_Stack_Needed_For_Return (Entity (Identifier (P)));
+
+ -- Mark the enclosing function
+
+ elsif Nkind (P) = N_Subprogram_Body then
+ if Present (Corresponding_Spec (P)) then
+ Set_Sec_Stack_Needed_For_Return (Corresponding_Spec (P));
+ else
+ Set_Sec_Stack_Needed_For_Return (Defining_Entity (P));
+ end if;
+
+ -- Do not go beyond the enclosing function
+
+ exit;
+ end if;
+
+ P := Parent (P);
+ end loop;
+ end Set_Enclosing_Sec_Stack_Return;
+
------------------------
-- Unnest_Subprograms --
------------------------
For a build-in-place return of an unconstrained limited type (for example, a limited class-wide type), the result is returned on the secondary stack. This patch fixes a bug in the case where the return statement is inside a block statement nested inside the function, and that block uses the secondary stack for some unrelated purpose. The block was calling SS_Release, causing the function to return a dangling pointer to the secondary stack. This patch removes such SS_Release calls. The following test should compile and run quietly. package Types is type Root_Type is tagged limited record I : Integer; end record; type Root_Access is access all Root_Type'Class; function Get_Object (S : String) return Root_Type'Class; function Get_String return String; end Types; with System.Address_Image; package body Types is function Get_Object (S : String) return Root_Type'Class is begin declare S2 : constant String := System.Address_Image (S'Address); begin return Root_Type'(I => 0); end; end Get_Object; function Get_String return String is begin return (1 .. 100 => 'A'); end Get_String; end Types; with Types; use Types; procedure Foo is Obj : aliased Root_Type'Class := Get_Object ("Hello"); Str : constant String := Get_String; begin null; end Foo; Tested on x86_64-pc-linux-gnu, committed on trunk 2015-10-23 Bob Duff <duff@adacore.com> * exp_ch6.adb (Expand_N_Extended_Return_Statement): Do not call SS_Release for a block statement enclosing the return statement in the case where a build-in-place function return is returning the result on the secondary stack. This is accomplished by setting the Sec_Stack_Needed_For_Return flag on such blocks. It was already being set for the function itself, and it was already set correctly for blocks in the non-build-in-place case (in Expand_Simple_Function_Return). (Set_Enclosing_Sec_Stack_Return): New procedure to perform the Set_Sec_Stack_Needed_For_Return calls. Called in the build-in-place and non-build-in-place cases. (Expand_Simple_Function_Return): Call Set_Enclosing_Sec_Stack_Return instead of performing the loop in line.