When expanding a limited aggregate into individual assignments, we create a
transient scope if the type of a component requires it. This must not be done
if the context is an initialization procedure, because the target of the
assignment must be visible outside of the block, and stack cleanup will happen
on return from the initialization call. Otherwise this may result in dangling
stack references in the back-end, which produce garbled results when compiled
at higher optimization levels.
Executing the following:
gnatmake -q -O2 cutdown
cutdown
must yield:
0.00000E+00
---
with Text_IO; use Text_IO;
procedure Cutdown is
type Angle_Object_T is tagged record
M_Value : Float := 0.0;
end record;
Zero : constant Angle_Object_T := (M_Value => 0.0);
type Platform_T is record
M_Roll : Angle_Object_T := Zero;
end record;
package Observable_Nongeneric is
type Writer_T is tagged limited record
M_Value : Platform_T;
end record;
function Init (Value : in Platform_T) return Writer_T;
end Observable_Nongeneric;
package body Observable_Nongeneric is
--------------------------------------------------------------------------
function Init (Value : in Platform_T) return Writer_T is
begin
return (M_Value => Value);
end Init;
--------------------------------------------------------------------------
end Observable_Nongeneric;
type Object_T is tagged limited record
M_Platform : aliased Observable_Nongeneric.Writer_T :=
Observable_Nongeneric.Init (Platform_T'(others => <>));
end record;
Data : Object_T;
begin
Put_Line (Data.M_Platform.M_Value.M_Roll.M_Value'Img);
if Data.M_Platform.M_Value.M_Roll.M_Value /= 0.0 then
raise Program_Error;
end if;
end Cutdown;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-10-20 Ed Schonberg <schonb...@adacore.com>
* exp_aggr.adb (Convert_To_Assignments): Do not create a
transient scope for a component whose type requires it, if the
context is an initialization procedure, because the target of
the assignment must be visible outside of the block.
Index: exp_aggr.adb
===================================================================
--- exp_aggr.adb (revision 216469)
+++ exp_aggr.adb (working copy)
@@ -3396,7 +3396,7 @@
-- that any finalization chain will be associated with that scope.
-- For extended returns, we delay expansion to avoid the creation
-- of an unwanted transient scope that could result in premature
- -- finalization of the return object (which is built in in place
+ -- finalization of the return object (which is built in place
-- within the caller's scope).
or else
@@ -3409,7 +3409,14 @@
return;
end if;
- if Requires_Transient_Scope (Typ) then
+ -- Otherwise, if a transient scope is required, create it now. If we
+ -- are within an initialization procedure do not create such, because
+ -- the target of the assignment must not be declared within a local
+ -- block, and because cleanup will take place on return from the
+ -- initialization procedure.
+ -- Should the condition be more restrictive ???
+
+ if Requires_Transient_Scope (Typ) and then not Inside_Init_Proc then
Establish_Transient_Scope (N, Sec_Stack => Needs_Finalization (Typ));
end if;
