diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 026d3ef1cd1..c2b6338f4ee 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,22 @@ +2018-05-30 Bob Duff + + * 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 * checks.adb (Apply_Scalar_Range_Check): diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 5d1433b5ae6..320b16715ed 100644 --- a/gcc/ada/einfo.adb +++ b/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)); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 6c37941bd9c..384de07134d 100644 --- a/gcc/ada/einfo.ads +++ b/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); diff --git a/gcc/ada/exp_ch5.adb b/gcc/ada/exp_ch5.adb index 0989370d5e8..cf1b5c55d39 100644 --- a/gcc/ada/exp_ch5.adb +++ b/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; diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb index f18fd4089f4..7df4fa99d13 100644 --- a/gcc/ada/sem_ch5.adb +++ b/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; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 7d881a1d10d..16ba8e890ac 100644 --- a/gcc/ada/sem_util.adb +++ b/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