[Ada] Secondary stack leak in "for X of ..." loops

This patch fixes a memory leak bug. In particular, in a loop of the form "for X
of ...", with a type that has the Iterable aspect specified, if the result of
the Element function is returned on the secondary stack (e.g. the result
subtype has caller-unknown size), then memory for the secondary stack could
leak.

2018-05-30  Bob Duff  <duff@adacore.com>

gcc/ada/

	* exp_ch5.adb (Expand_Formal_Container_Element_Loop): Remove the code
	to analyze the Elmt_Decl, because it gets analyzed in the wrong scope.
	We need to analyze it as part of analyzing the block, so that if the
	call to Element that initializes Elmt_Decl returns on the secondary
	stack, the block will ss_mark/ss_release. This block is inside the
	loop; we don't want to leak memory until the loop exits.  The purpose
	of analyzing Elmt_Decl first was to catch the error of modifying it,
	which is illegal because it's a loop parameter. The above causes us to
	miss that error.  Therefore, we add a flag Is_Loop_Parameter, and set
	it on the Element entity, so we end up with an E_Variable node with the
	flag set.
	* einfo.ads, einfo.adb (Is_Loop_Parameter): New flag.
	* sem_ch5.adb (Diagnose_Non_Variable_Lhs): Give the "assignment to loop
	parameter not allowed" error if Is_Loop_Parameter.
	* sem_util.adb (Is_Variable): Return False if Is_Loop_Parameter, to
	trigger the call to Diagnose_Non_Variable_Lhs.

From-SVN: r260930
This commit is contained in:
Bob Duff 2018-05-30 08:56:59 +00:00 committed by Pierre-Marie de Rodat
parent 88ad52c90d
commit 5a0c86bdde
6 changed files with 59 additions and 16 deletions

View File

@ -1,3 +1,22 @@
2018-05-30 Bob Duff <duff@adacore.com>
* exp_ch5.adb (Expand_Formal_Container_Element_Loop): Remove the code
to analyze the Elmt_Decl, because it gets analyzed in the wrong scope.
We need to analyze it as part of analyzing the block, so that if the
call to Element that initializes Elmt_Decl returns on the secondary
stack, the block will ss_mark/ss_release. This block is inside the
loop; we don't want to leak memory until the loop exits. The purpose
of analyzing Elmt_Decl first was to catch the error of modifying it,
which is illegal because it's a loop parameter. The above causes us to
miss that error. Therefore, we add a flag Is_Loop_Parameter, and set
it on the Element entity, so we end up with an E_Variable node with the
flag set.
* einfo.ads, einfo.adb (Is_Loop_Parameter): New flag.
* sem_ch5.adb (Diagnose_Non_Variable_Lhs): Give the "assignment to loop
parameter not allowed" error if Is_Loop_Parameter.
* sem_util.adb (Is_Variable): Return False if Is_Loop_Parameter, to
trigger the call to Diagnose_Non_Variable_Lhs.
2018-05-30 Arnaud Charlet <charlet@adacore.com>
* checks.adb (Apply_Scalar_Range_Check):

View File

@ -630,8 +630,8 @@ package body Einfo is
-- Is_Elaboration_Warnings_OK_Id Flag304
-- Is_Activation_Record Flag305
-- Needs_Activation_Record Flag306
-- Is_Loop_Parameter Flag307
-- (unused) Flag307
-- (unused) Flag308
-- (unused) Flag309
@ -2486,6 +2486,11 @@ package body Einfo is
return Flag194 (Id);
end Is_Local_Anonymous_Access;
function Is_Loop_Parameter (Id : E) return B is
begin
return Flag307 (Id);
end Is_Loop_Parameter;
function Is_Machine_Code_Subprogram (Id : E) return B is
begin
pragma Assert (Is_Subprogram (Id));
@ -5715,6 +5720,11 @@ package body Einfo is
Set_Flag25 (Id, V);
end Set_Is_Limited_Record;
procedure Set_Is_Loop_Parameter (Id : E; V : B := True) is
begin
Set_Flag307 (Id, V);
end Set_Is_Loop_Parameter;
procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True) is
begin
pragma Assert (Is_Subprogram (Id));
@ -9865,6 +9875,7 @@ package body Einfo is
W ("Is_Limited_Interface", Flag197 (Id));
W ("Is_Limited_Record", Flag25 (Id));
W ("Is_Local_Anonymous_Access", Flag194 (Id));
W ("Is_Loop_Parameter", Flag307 (Id));
W ("Is_Machine_Code_Subprogram", Flag137 (Id));
W ("Is_Non_Static_Subtype", Flag109 (Id));
W ("Is_Null_Init_Proc", Flag178 (Id));

View File

@ -2915,6 +2915,12 @@ package Einfo is
-- that are created for access parameters, access discriminants, and
-- (as of Ada 2012) stand-alone objects.
-- Is_Loop_Parameter (Flag307)
-- Applies to all entities. Certain loops, in particular "for ... of"
-- loops, get transformed so that the loop parameter is declared by a
-- variable declaration, so the entity is an E_Variable. This is True for
-- such E_Variables; False otherwise.
-- Is_Machine_Code_Subprogram (Flag137)
-- Defined in subprogram entities. Set to indicate that the subprogram
-- is a machine code subprogram (i.e. its body includes at least one
@ -5621,6 +5627,7 @@ package Einfo is
-- Is_Known_Valid (Flag170)
-- Is_Limited_Composite (Flag106)
-- Is_Limited_Record (Flag25)
-- Is_Loop_Parameter (Flag307)
-- Is_Obsolescent (Flag153)
-- Is_Package_Body_Entity (Flag160)
-- Is_Packed_Array_Impl_Type (Flag138)
@ -7343,6 +7350,7 @@ package Einfo is
function Is_Limited_Composite (Id : E) return B;
function Is_Limited_Interface (Id : E) return B;
function Is_Local_Anonymous_Access (Id : E) return B;
function Is_Loop_Parameter (Id : E) return B;
function Is_Machine_Code_Subprogram (Id : E) return B;
function Is_Non_Static_Subtype (Id : E) return B;
function Is_Null_Init_Proc (Id : E) return B;
@ -8049,6 +8057,7 @@ package Einfo is
procedure Set_Is_Limited_Interface (Id : E; V : B := True);
procedure Set_Is_Limited_Record (Id : E; V : B := True);
procedure Set_Is_Local_Anonymous_Access (Id : E; V : B := True);
procedure Set_Is_Loop_Parameter (Id : E; V : B := True);
procedure Set_Is_Machine_Code_Subprogram (Id : E; V : B := True);
procedure Set_Is_Non_Static_Subtype (Id : E; V : B := True);
procedure Set_Is_Null_Init_Proc (Id : E; V : B := True);
@ -8905,6 +8914,7 @@ package Einfo is
pragma Inline (Is_Limited_Interface);
pragma Inline (Is_Limited_Record);
pragma Inline (Is_Local_Anonymous_Access);
pragma Inline (Is_Loop_Parameter);
pragma Inline (Is_Machine_Code_Subprogram);
pragma Inline (Is_Modular_Integer_Type);
pragma Inline (Is_Named_Number);
@ -9415,6 +9425,7 @@ package Einfo is
pragma Inline (Set_Is_Limited_Interface);
pragma Inline (Set_Is_Limited_Record);
pragma Inline (Set_Is_Local_Anonymous_Access);
pragma Inline (Set_Is_Loop_Parameter);
pragma Inline (Set_Is_Machine_Code_Subprogram);
pragma Inline (Set_Is_Non_Static_Subtype);
pragma Inline (Set_Is_Null_Init_Proc);

View File

@ -3266,6 +3266,12 @@ package body Exp_Ch5 is
Set_Ekind (Cursor, E_Variable);
Insert_Action (N, Init);
-- The loop parameter is declared by an object declaration, but within
-- the loop we must prevent user assignments to it; the following flag
-- accomplishes that.
Set_Is_Loop_Parameter (Element);
-- Declaration for Element
Elmt_Decl :=
@ -3280,7 +3286,6 @@ package body Exp_Ch5 is
Parameter_Associations => New_List (
Convert_To_Iterable_Type (Container, Loc),
New_Occurrence_Of (Cursor, Loc))));
Set_Statements (New_Loop,
New_List
(Make_Block_Statement (Loc,
@ -3323,15 +3328,6 @@ package body Exp_Ch5 is
Set_Warnings_Off (Element);
Rewrite (N, New_Loop);
-- The loop parameter is declared by an object declaration, but within
-- the loop we must prevent user assignments to it, so we analyze the
-- declaration and reset the entity kind, before analyzing the rest of
-- the loop.
Analyze (Elmt_Decl);
Set_Ekind (Defining_Identifier (Elmt_Decl), E_Loop_Parameter);
Analyze (N);
end Expand_Formal_Container_Element_Loop;

View File

@ -169,7 +169,13 @@ package body Sem_Ch5 is
Ent : constant Entity_Id := Entity (N);
begin
if Ekind (Ent) = E_In_Parameter then
if Ekind (Ent) = E_Loop_Parameter
or else Is_Loop_Parameter (Ent)
then
Error_Msg_N ("assignment to loop parameter not allowed", N);
return;
elsif Ekind (Ent) = E_In_Parameter then
Error_Msg_N
("assignment to IN mode parameter not allowed", N);
return;
@ -187,10 +193,6 @@ package body Sem_Ch5 is
Error_Msg_N
("protected function cannot modify protected object", N);
return;
elsif Ekind (Ent) = E_Loop_Parameter then
Error_Msg_N ("assignment to loop parameter not allowed", N);
return;
end if;
end;

View File

@ -17761,6 +17761,10 @@ package body Sem_Util is
K : constant Entity_Kind := Ekind (E);
begin
if Is_Loop_Parameter (E) then
return False;
end if;
return (K = E_Variable
and then Nkind (Parent (E)) /= N_Exception_Handler)
or else (K = E_Component