+2014-01-20 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * exp_ch4.adb (Expand_N_Slice): Relocate some variables and
+ constants to the "Local variables" area. Add new constant D. Add
+ new variables Drange and Index_Typ. Rename Pfx to Rep and Ptp
+ to Pref_Typ and update all occurrences. Add circuitry to extract
+ the discrete_range and the index type and build a range check.
+
+2014-01-20 Arnaud Charlet <charlet@adacore.com>
+
+ * gnat1drv.adb (Adjust_Global_Switches): Enable
+ Treat_Categorization_Errors_As_Warnings when Relaxed_RM_Semantics
+ is set.
+
+2014-01-20 Thomas Quinot <quinot@adacore.com>
+
+ * sem_ch5.adb, sem_ch4.adb: Minor reformatting.
+
+2014-01-20 Hristian Kirtchev <kirtchev@adacore.com>
+
+ * sem_ch13.adb (Analyze_Aspect_Specifications):
+ When aspect SPARK_Mode appears on a package body, insert the
+ generated pragma at the top of the body declarations.
+
2014-01-20 Robert Dewar <dewar@adacore.com>
* sem_aggr.adb, exp_prag.adb, sem_aux.adb, sinfo.ads, sem_ch10.adb,
--------------------
procedure Expand_N_Slice (N : Node_Id) is
- Loc : constant Source_Ptr := Sloc (N);
- Typ : constant Entity_Id := Etype (N);
- Pfx : constant Node_Id := Prefix (N);
- Ptp : Entity_Id := Etype (Pfx);
+ Loc : constant Source_Ptr := Sloc (N);
+ Typ : constant Entity_Id := Etype (N);
function Is_Procedure_Actual (N : Node_Id) return Boolean;
-- Check whether the argument is an actual for a procedure call, in
------------------------------
procedure Make_Temporary_For_Slice is
- Decl : Node_Id;
Ent : constant Entity_Id := Make_Temporary (Loc, 'T', N);
+ Decl : Node_Id;
begin
Decl :=
Insert_Actions (N, New_List (
Decl,
Make_Assignment_Statement (Loc,
- Name => New_Occurrence_Of (Ent, Loc),
+ Name => New_Occurrence_Of (Ent, Loc),
Expression => Relocate_Node (N))));
Rewrite (N, New_Occurrence_Of (Ent, Loc));
Analyze_And_Resolve (N, Typ);
end Make_Temporary_For_Slice;
+ -- Local variables
+
+ D : constant Node_Id := Discrete_Range (N);
+ Pref : constant Node_Id := Prefix (N);
+ Pref_Typ : Entity_Id := Etype (Pref);
+ Drange : Node_Id;
+ Index_Typ : Entity_Id;
+
-- Start of processing for Expand_N_Slice
begin
-- Special handling for access types
- if Is_Access_Type (Ptp) then
+ if Is_Access_Type (Pref_Typ) then
+ Pref_Typ := Designated_Type (Pref_Typ);
- Ptp := Designated_Type (Ptp);
-
- Rewrite (Pfx,
+ Rewrite (Pref,
Make_Explicit_Dereference (Sloc (N),
- Prefix => Relocate_Node (Pfx)));
+ Prefix => Relocate_Node (Pref)));
- Analyze_And_Resolve (Pfx, Ptp);
+ Analyze_And_Resolve (Pref, Pref_Typ);
end if;
-- Ada 2005 (AI-318-02): If the prefix is a call to a build-in-place
-- function, then additional actuals must be passed.
if Ada_Version >= Ada_2005
- and then Is_Build_In_Place_Function_Call (Pfx)
+ and then Is_Build_In_Place_Function_Call (Pref)
then
- Make_Build_In_Place_Call_In_Anonymous_Context (Pfx);
+ Make_Build_In_Place_Call_In_Anonymous_Context (Pref);
end if;
+ -- Find the range of the discrete_range. For ranges that do not appear
+ -- in the slice itself, we make a shallow copy and inherit the source
+ -- location and the parent field from the discrete_range. This ensures
+ -- that the range check is inserted relative to the slice and that the
+ -- runtime exception poins to the proper construct.
+
+ if Nkind (D) = N_Range then
+ Drange := D;
+
+ elsif Nkind_In (D, N_Expanded_Name, N_Identifier) then
+ Drange := New_Copy (Scalar_Range (Entity (D)));
+ Set_Etype (Drange, Entity (D));
+ Set_Parent (Drange, Parent (D));
+ Set_Sloc (Drange, Sloc (D));
+
+ else pragma Assert (Nkind (D) = N_Subtype_Indication);
+ Drange := New_Copy (Range_Expression (Constraint (D)));
+ Set_Etype (Drange, Etype (D));
+ Set_Parent (Drange, Parent (D));
+ Set_Sloc (Drange, Sloc (D));
+ end if;
+
+ -- Find the type of the array index
+
+ if Ekind (Pref_Typ) = E_String_Literal_Subtype then
+ Index_Typ := Etype (String_Literal_Low_Bound (Pref_Typ));
+ else
+ Index_Typ := Etype (First_Index (Pref_Typ));
+ end if;
+
+ -- Add a runtime check to test the compatibility between the array range
+ -- and the discrete_range.
+
+ Apply_Range_Check (Drange, Index_Typ);
+
-- The remaining case to be handled is packed slices. We can leave
-- packed slices as they are in the following situations:
-- SPARK_Mode
- when Aspect_SPARK_Mode =>
+ when Aspect_SPARK_Mode => SPARK_Mode : declare
+ Decls : List_Id;
+
+ begin
Make_Aitem_Pragma
(Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
Expression => Relocate_Node (Expr))),
Pragma_Name => Name_SPARK_Mode);
+ -- When the aspect appears on a package body, insert the
+ -- generated pragma at the top of the body declarations to
+ -- emulate the behavior of a source pragma.
+
+ if Nkind (N) = N_Package_Body then
+ Decorate_Delayed_Aspect_And_Pragma (Aspect, Aitem);
+ Decls := Declarations (N);
+
+ if No (Decls) then
+ Decls := New_List;
+ Set_Declarations (N, Decls);
+ end if;
+
+ Prepend_To (Decls, Aitem);
+ goto Continue;
+ end if;
+ end SPARK_Mode;
+
-- Refined_Depends
-- Aspect Refined_Depends must be delayed because it can
projects / thirdparty / gcc.git / commitdiff
