[multiple changes]

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.

From-SVN: r206814

6 files changed, 104 insertions, 18 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f0f8471..aec17d6 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,27 @@
+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,
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 32d430b..c8cded1 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -9329,10 +9329,8 @@ package body Exp_Ch4 is
    --------------------
 
    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
@@ -9390,8 +9388,8 @@ package body Exp_Ch4 is
       ------------------------------
 
       procedure Make_Temporary_For_Slice is
-         Decl : Node_Id;
          Ent  : constant Entity_Id := Make_Temporary (Loc, 'T', N);
+         Decl : Node_Id;
 
       begin
          Decl :=
@@ -9404,38 +9402,80 @@ package body Exp_Ch4 is
          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:
 
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index d380468..8eb9173 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -291,6 +291,7 @@ procedure Gnat1drv is
 
       if Relaxed_RM_Semantics then
          Overriding_Renamings := True;
+         Treat_Categorization_Errors_As_Warnings := True;
       end if;
 
       --  Set switches for formal verification mode
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index fa5ed8d..67dfd8d 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2132,13 +2132,34 @@ package body Sem_Ch13 is
 
                --  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
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index d458192..457b581 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -6839,8 +6839,8 @@ package body Sem_Ch4 is
 
       if No (Func_Name) then
 
-         --  The prefix itself may be an indexing of a container
-         --  rewrite as such and re-analyze.
+         --  The prefix itself may be an indexing of a container: rewrite
+         --  as such and re-analyze.
 
          if Has_Implicit_Dereference (Etype (Prefix)) then
             Build_Explicit_Dereference
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index b0d59e3..bb66856 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -187,7 +187,7 @@ package body Sem_Ch5 is
       end Diagnose_Non_Variable_Lhs;
 
       --------------
-      -- Kill_LHS --
+      -- Kill_Lhs --
       --------------
 
       procedure Kill_Lhs is