+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):
-- Is_Elaboration_Warnings_OK_Id Flag304
-- Is_Activation_Record Flag305
-- Needs_Activation_Record Flag306
+ -- Is_Loop_Parameter Flag307
- -- (unused) Flag307
-- (unused) Flag308
-- (unused) Flag309
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));
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));
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));
-- 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
-- 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)
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;
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);
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);
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);
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 :=
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,
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;
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;
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;
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
projects / gcc.git / commitdiff