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 <d...@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.
Index: exp_ch6.adb
===================================================================
--- exp_ch6.adb (revision 229224)
+++ exp_ch6.adb (working copy)
@@ -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 --
------------------------
