+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,
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;
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;
Write_Str ("Related_Instance");
when E_Constant
+ | E_Loop_Parameter
| E_Variable
=>
Write_Str ("Status_Flag_Or_Transient_Decl");
-- 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]
-- 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)
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];
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];
--
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
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 --
----------------------
("?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
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
projects / platform / upstream / gcc.git / commitdiff