[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

gcc/ada/ChangeLog

+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):

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

@@ -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

@@ -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

@@ -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

@@ -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