[multiple changes]

2017-09-06  Yannick Moy  <moy@adacore.com>

	* 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  <kirtchev@adacore.com>

	* 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

6 files changed, 93 insertions, 40 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 49642c3..f7ec861 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,24 @@
+2017-09-06  Yannick Moy  <moy@adacore.com>
+
+	* 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  <kirtchev@adacore.com>
+
+	* 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  <kirtchev@adacore.com>
 
 	* 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 1f70a40..4c9f574 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 4985231..7826d42 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 d25ad63..f822545 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 7f7bc0b..baffe28 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 76e1f1b..fd31316 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