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.
Tested on x86_64-pc-linux-gnu, committed on trunk
2018-05-30 Bob Duff <d...@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.--- gcc/ada/einfo.adb
+++ gcc/ada/einfo.adb
@@ -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));
--- gcc/ada/einfo.ads
+++ gcc/ada/einfo.ads
@@ -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);
--- gcc/ada/exp_ch5.adb
+++ gcc/ada/exp_ch5.adb
@@ -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;
--- gcc/ada/sem_ch5.adb
+++ gcc/ada/sem_ch5.adb
@@ -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;
--- gcc/ada/sem_util.adb
+++ gcc/ada/sem_util.adb
@@ -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
