From 6877306fbd70a365ebb8e427e108a399ae924498 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Wed, 6 Sep 2017 12:27:22 +0200 Subject: [PATCH] [multiple changes] 2017-09-06 Yannick Moy * sem_warn.adb (Warn_On_Suspicious_Index): Improve warning when the literal index used to access a string is null or negative. 2017-09-06 Hristian Kirtchev * einfo.adb (Status_Flag_Or_Transient_Decl): The attribute is now allowed on loop parameters. (Set_Status_Flag_Or_Transient_Decl): The attribute is now allowed on loop parameters. (Write_Field15_Name): Update the output for Status_Flag_Or_Transient_Decl. * einfo.ads: Attribute Status_Flag_Or_Transient_Decl now applies to loop parameters. Update the documentation of the attribute and the E_Loop_Parameter entity. * exp_ch7.adb (Process_Declarations): Remove the bogus guard which assumes that cursors can never be controlled. * exp_util.adb (Requires_Cleanup_Actions): Remove the bogus guard which assumes that cursors can never be controlled. From-SVN: r251773 --- gcc/ada/ChangeLog | 21 +++++++++++++ gcc/ada/einfo.adb | 9 ++++-- gcc/ada/einfo.ads | 14 ++++----- gcc/ada/exp_ch7.adb | 9 ------ gcc/ada/exp_util.adb | 10 ------- gcc/ada/sem_warn.adb | 70 ++++++++++++++++++++++++++++++++++++-------- 6 files changed, 93 insertions(+), 40 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 49642c31441..f7ec8616684 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,24 @@ +2017-09-06 Yannick Moy + + * sem_warn.adb (Warn_On_Suspicious_Index): Improve warning when the + literal index used to access a string is null or negative. + +2017-09-06 Hristian Kirtchev + + * einfo.adb (Status_Flag_Or_Transient_Decl): The attribute is now + allowed on loop parameters. + (Set_Status_Flag_Or_Transient_Decl): The attribute is now allowed + on loop parameters. + (Write_Field15_Name): Update the output for + Status_Flag_Or_Transient_Decl. + * einfo.ads: Attribute Status_Flag_Or_Transient_Decl now applies + to loop parameters. Update the documentation of the attribute + and the E_Loop_Parameter entity. + * exp_ch7.adb (Process_Declarations): Remove the bogus guard + which assumes that cursors can never be controlled. + * exp_util.adb (Requires_Cleanup_Actions): Remove the bogus + guard which assumes that cursors can never be controlled. + 2017-09-06 Hristian Kirtchev * exp_attr.adb, sem_util.adb, sem_attr.adb, sem_ch6.adb, sem_ch8.adb, diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 1f70a405d1f..4c9f5747e80 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -3371,7 +3371,9 @@ package body Einfo is function Status_Flag_Or_Transient_Decl (Id : E) return N is begin - pragma Assert (Ekind_In (Id, E_Constant, E_Variable)); + pragma Assert (Ekind_In (Id, E_Constant, + E_Loop_Parameter, + E_Variable)); return Node15 (Id); end Status_Flag_Or_Transient_Decl; @@ -6546,7 +6548,9 @@ package body Einfo is procedure Set_Status_Flag_Or_Transient_Decl (Id : E; V : E) is begin - pragma Assert (Ekind_In (Id, E_Constant, E_Variable)); + pragma Assert (Ekind_In (Id, E_Constant, + E_Loop_Parameter, + E_Variable)); Set_Node15 (Id, V); end Set_Status_Flag_Or_Transient_Decl; @@ -10087,6 +10091,7 @@ package body Einfo is Write_Str ("Related_Instance"); when E_Constant + | E_Loop_Parameter | E_Variable => Write_Str ("Status_Flag_Or_Transient_Decl"); diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads index 49852311af0..7826d42093c 100644 --- a/gcc/ada/einfo.ads +++ b/gcc/ada/einfo.ads @@ -4325,12 +4325,12 @@ package Einfo is -- expression may consist of the above xxxPredicate call on its own. -- Status_Flag_Or_Transient_Decl (Node15) --- Defined in variables and constants. Applies to objects that require --- special treatment by the finalization machinery, such as extended --- return results, IF and CASE expression results, and objects inside --- N_Expression_With_Actions nodes. The attribute contains the entity --- of a flag which specifies particular behavior over a region of code --- or the declaration of a "hook" object. +-- Defined in constant, loop, and variable entities. Applies to objects +-- that require special treatment by the finalization machinery, such as +-- extended return results, IF and CASE expression results, and objects +-- inside N_Expression_With_Actions nodes. The attribute contains the +-- entity of a flag which specifies particular behavior over a region of +-- code or the declaration of a "hook" object. -- In which case is it a flag, or a hook object??? -- Storage_Size_Variable (Node26) [implementation base type only] @@ -5846,7 +5846,7 @@ package Einfo is -- Esize (Uint12) -- Extra_Accessibility (Node13) (constants only) -- Alignment (Uint14) - -- Status_Flag_Or_Transient_Decl (Node15) (constants only) + -- Status_Flag_Or_Transient_Decl (Node15) -- Actual_Subtype (Node17) -- Renamed_Object (Node18) -- Size_Check_Code (Node19) (constants only) diff --git a/gcc/ada/exp_ch7.adb b/gcc/ada/exp_ch7.adb index d25ad63f87a..f8225452f5a 100644 --- a/gcc/ada/exp_ch7.adb +++ b/gcc/ada/exp_ch7.adb @@ -2100,15 +2100,6 @@ package body Exp_Ch7 is elsif Is_Ignored_Ghost_Entity (Obj_Id) then null; - -- The expansion of iterator loops generates an object - -- declaration where the Ekind is explicitly set to loop - -- parameter. This is to ensure that the loop parameter behaves - -- as a constant from user code point of view. Such object are - -- never controlled and do not require finalization. - - elsif Ekind (Obj_Id) = E_Loop_Parameter then - null; - -- The object is of the form: -- Obj : [constant] Typ [:= Expr]; diff --git a/gcc/ada/exp_util.adb b/gcc/ada/exp_util.adb index 7f7bc0bd977..baffe28ad69 100644 --- a/gcc/ada/exp_util.adb +++ b/gcc/ada/exp_util.adb @@ -11972,16 +11972,6 @@ package body Exp_Util is elsif Is_Ignored_Ghost_Entity (Obj_Id) then null; - -- The expansion of iterator loops generates an object declaration - -- where the Ekind is explicitly set to loop parameter. This is to - -- ensure that the loop parameter behaves as a constant from user - -- code point of view. Such object are never controlled and do not - -- require cleanup actions. An iterator loop over a container of - -- controlled objects does not produce such object declarations. - - elsif Ekind (Obj_Id) = E_Loop_Parameter then - return False; - -- The object is of the form: -- Obj : [constant] Typ [:= Expr]; -- diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb index 76e1f1bc092..fd31316eb5d 100644 --- a/gcc/ada/sem_warn.adb +++ b/gcc/ada/sem_warn.adb @@ -46,6 +46,7 @@ with Sinput; use Sinput; with Snames; use Snames; with Stand; use Stand; with Stringt; use Stringt; +with Tbuild; use Tbuild; with Uintp; use Uintp; package body Sem_Warn is @@ -3878,6 +3879,13 @@ package body Sem_Warn is procedure Warn1; -- Generate first warning line + procedure Warn_On_Index_Below_Lower_Bound; + -- Generate a warning on indexing the array with a literal value + -- below the lower bound of the index type. + + procedure Warn_On_Literal_Index; + -- Generate a warning on indexing the array with a literal value + ---------------------- -- Length_Reference -- ---------------------- @@ -3903,21 +3911,31 @@ package body Sem_Warn is ("?w?index for& may assume lower bound of^", X, Ent); end Warn1; - -- Start of processing for Test_Suspicious_Index - - begin - -- Nothing to do if subscript does not come from source (we don't - -- want to give garbage warnings on compiler expanded code, e.g. the - -- loops generated for slice assignments. Such junk warnings would - -- be placed on source constructs with no subscript in sight). + ------------------------------------- + -- Warn_On_Index_Below_Lower_Bound -- + ------------------------------------- - if not Comes_From_Source (Original_Node (X)) then - return; - end if; + procedure Warn_On_Index_Below_Lower_Bound is + begin + if Is_Standard_String_Type (Typ) then + Discard_Node + (Compile_Time_Constraint_Error + (N => X, + Msg => "?w?string index should be positive")); + else + Discard_Node + (Compile_Time_Constraint_Error + (N => X, + Msg => "?w?index out of the allowed range")); + end if; + end Warn_On_Index_Below_Lower_Bound; - -- Case where subscript is a constant integer + --------------------------- + -- Warn_On_Literal_Index -- + --------------------------- - if Nkind (X) = N_Integer_Literal then + procedure Warn_On_Literal_Index is + begin Warn1; -- Case where original form of subscript is an integer literal @@ -4037,6 +4055,34 @@ package body Sem_Warn is Error_Msg_FE -- CODEFIX ("\?w?suggested replacement: `&~`", Original_Node (X), Ent); end if; + end Warn_On_Literal_Index; + + -- Start of processing for Test_Suspicious_Index + + begin + -- Nothing to do if subscript does not come from source (we don't + -- want to give garbage warnings on compiler expanded code, e.g. the + -- loops generated for slice assignments. Such junk warnings would + -- be placed on source constructs with no subscript in sight). + + if not Comes_From_Source (Original_Node (X)) then + return; + end if; + + -- Case where subscript is a constant integer + + if Nkind (X) = N_Integer_Literal then + + -- Case where subscript is lower than the lowest possible bound. + -- This might be the case for example when programmers try to + -- access a string at index 0, as they are used to in other + -- programming languages like C. + + if Intval (X) < Low_Bound then + Warn_On_Index_Below_Lower_Bound; + else + Warn_On_Literal_Index; + end if; -- Case where subscript is of the form X'Length -- 2.30.2