2016-10-13 Hristian Kirtchev <kirtchev@adacore.com>

	* sem_ch6.adb (Create_Extra_Formals): Generate
	an Itype reference for the object extra formal in case the
	subprogram is called within the same or nested scope.

2016-10-13  Claire Dross  <dross@adacore.com>

	* sem_ch5.adb (Analyze_Iterator_Specification):
	Also create a renaming in GNATprove mode.

2016-10-13  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Freeze_Fixed_Point_Type): in SPARK mode, the
	given bounds of the type must be strictly representable, and the
	range reduction by one delta ("shaving") allowed by the Ada RM,
	is not applicable in SPARK.

2016-10-13  Javier Miranda  <miranda@adacore.com>

	* debug.adb (switch d.9): Used to temporarily disable the support
	needed for this enhancement since it causes regressions with
	large sources.
	* gnat1drv.adb (Post_Compilation_Validation_Checks): Temporarily
	leave the validation of pragmas Compile_Time_Warning and
	Compile_Time_Error under control of -gnatd.9/



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@241115 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 106 insertions, 30 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 7ea6b94515f..71014fb429b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,32 @@
 2016-10-13  Hristian Kirtchev  <kirtchev@adacore.com>
 
+	* sem_ch6.adb (Create_Extra_Formals): Generate
+	an Itype reference for the object extra formal in case the
+	subprogram is called within the same or nested scope.
+
+2016-10-13  Claire Dross  <dross@adacore.com>
+
+	* sem_ch5.adb (Analyze_Iterator_Specification):
+	Also create a renaming in GNATprove mode.
+
+2016-10-13  Ed Schonberg  <schonberg@adacore.com>
+
+	* freeze.adb (Freeze_Fixed_Point_Type): in SPARK mode, the
+	given bounds of the type must be strictly representable, and the
+	range reduction by one delta ("shaving") allowed by the Ada RM,
+	is not applicable in SPARK.
+
+2016-10-13  Javier Miranda  <miranda@adacore.com>
+
+	* debug.adb (switch d.9): Used to temporarily disable the support
+	needed for this enhancement since it causes regressions with
+	large sources.
+	* gnat1drv.adb (Post_Compilation_Validation_Checks): Temporarily
+	leave the validation of pragmas Compile_Time_Warning and
+	Compile_Time_Error under control of -gnatd.9/
+
+2016-10-13  Hristian Kirtchev  <kirtchev@adacore.com>
+
 	* sem_ch10.adb (Entity_Needs_Body): A generic
 	subprogram renaming needs a body if the renamed unit is declared
 	outside the current compilation unit.
diff --git a/gcc/ada/debug.adb b/gcc/ada/debug.adb
index e3c53dda462..d9367375e7b 100644
--- a/gcc/ada/debug.adb
+++ b/gcc/ada/debug.adb
@@ -163,7 +163,7 @@ package body Debug is
    --  d.6
    --  d.7
    --  d.8
-   --  d.9
+   --  d.9  Enable validation of pragma Compile_Time_[Error/Warning]
 
    --  Debug flags for binder (GNATBIND)
 
@@ -774,6 +774,10 @@ package body Debug is
    --  d.5  By default a subprogram imported generates a subprogram profile.
    --       This debug flag disables this generation when generating C code,
    --       assuming a proper #include will be used instead.
+   --
+   --  d.9  Flag used temporarily to enable the validation of pragmas Compile_
+   --       Time_Error and Compile_Time_Warning after the back end has been
+   --       called.
 
    ------------------------------------------
    -- Documentation for Binder Debug Flags --
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index b28be4fcecb..96ae4e4c98c 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -7661,18 +7661,37 @@ package body Freeze is
       --  Check for shaving
 
       if Comes_From_Source (Typ) then
-         if Orig_Lo < Expr_Value_R (Lo) then
-            Error_Msg_N
-              ("declared low bound of type & is outside type range??", Typ);
-            Error_Msg_N
-              ("\low bound adjusted up by delta (RM 3.5.9(13))??", Typ);
-         end if;
 
-         if Orig_Hi > Expr_Value_R (Hi) then
-            Error_Msg_N
-              ("declared high bound of type & is outside type range??", Typ);
-            Error_Msg_N
-              ("\high bound adjusted down by delta (RM 3.5.9(13))??", Typ);
+         --  In SPARK mode the given bounds must be strictly representable
+
+         if SPARK_Mode = On then
+            if Orig_Lo < Expr_Value_R (Lo) then
+               Error_Msg_NE
+                 ("declared low bound of type & is outside type range",
+                  Lo, Typ);
+            end if;
+
+            if Orig_Hi > Expr_Value_R (Hi) then
+               Error_Msg_NE
+                 ("declared high bound of type & is outside type range",
+                  Hi, Typ);
+            end if;
+
+         else
+            if Orig_Lo < Expr_Value_R (Lo) then
+               Error_Msg_N
+                 ("declared low bound of type & is outside type range??", Typ);
+               Error_Msg_N
+                 ("\low bound adjusted up by delta (RM 3.5.9(13))??", Typ);
+            end if;
+
+            if Orig_Hi > Expr_Value_R (Hi) then
+               Error_Msg_N
+                 ("declared high bound of type & is outside type range??",
+                  Typ);
+               Error_Msg_N
+                 ("\high bound adjusted down by delta (RM 3.5.9(13))??", Typ);
+            end if;
          end if;
       end if;
    end Freeze_Fixed_Point_Type;
diff --git a/gcc/ada/gnat1drv.adb b/gcc/ada/gnat1drv.adb
index 929bfcc316d..605bac59858 100644
--- a/gcc/ada/gnat1drv.adb
+++ b/gcc/ada/gnat1drv.adb
@@ -875,13 +875,18 @@ procedure Gnat1drv is
       --  and alignment annotated by the backend where possible). We need to
       --  unlock temporarily these tables to reanalyze their expression.
 
-      Atree.Unlock;
-      Nlists.Unlock;
-      Sem.Unlock;
-      Sem_Ch13.Validate_Compile_Time_Warning_Errors;
-      Sem.Lock;
-      Nlists.Lock;
-      Atree.Lock;
+      --  ??? temporarily disabled since it causes regressions with large
+      --  sources
+
+      if Debug_Flag_Dot_9 then
+         Atree.Unlock;
+         Nlists.Unlock;
+         Sem.Unlock;
+         Sem_Ch13.Validate_Compile_Time_Warning_Errors;
+         Sem.Lock;
+         Nlists.Lock;
+         Atree.Lock;
+      end if;
 
       --  Validate unchecked conversions (using the values for size and
       --  alignment annotated by the backend where possible).
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 8e9e2b6d4bf..5897454d427 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -1932,13 +1932,11 @@ package body Sem_Ch5 is
         and then (Nkind (Parent (N)) /= N_Quantified_Expression
                    or else Operating_Mode = Check_Semantics)
 
-        --  Do not perform this expansion in SPARK mode, since the formal
-        --  verification directly deals with the source form of the iterator.
-        --  Ditto for ASIS and when expansion is disabled, where the temporary
-        --  may hide the transformation of a selected component into a prefixed
-        --  function call, and references need to see the original expression.
+        --  Do not perform this expansion for ASIS and when expansion is
+        --  disabled, where the temporary may hide the transformation of a
+        --  selected component into a prefixed function call, and references
+        --  need to see the original expression.
 
-        and then not GNATprove_Mode
         and then Expander_Active
       then
          declare
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 4544e0b7861..814d1183003 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -7307,11 +7307,9 @@ package body Sem_Ch6 is
    --------------------------
 
    procedure Create_Extra_Formals (E : Entity_Id) is
-      Formal      : Entity_Id;
       First_Extra : Entity_Id := Empty;
-      Last_Extra  : Entity_Id;
-      Formal_Type : Entity_Id;
-      P_Formal    : Entity_Id := Empty;
+      Formal      : Entity_Id;
+      Last_Extra  : Entity_Id := Empty;
 
       function Add_Extra_Formal
         (Assoc_Entity : Entity_Id;
@@ -7377,6 +7375,11 @@ package body Sem_Ch6 is
          return EF;
       end Add_Extra_Formal;
 
+      --  Local variables
+
+      Formal_Type : Entity_Id;
+      P_Formal    : Entity_Id := Empty;
+
    --  Start of processing for Create_Extra_Formals
 
    begin
@@ -7402,7 +7405,6 @@ package body Sem_Ch6 is
          P_Formal := First_Formal (Alias (E));
       end if;
 
-      Last_Extra := Empty;
       Formal := First_Formal (E);
       while Present (Formal) loop
          Last_Extra := Formal;
@@ -7548,6 +7550,7 @@ package body Sem_Ch6 is
             Result_Subt : constant Entity_Id := Etype (E);
             Full_Subt   : constant Entity_Id := Available_View (Result_Subt);
             Formal_Typ  : Entity_Id;
+            Subp_Decl   : Node_Id;
 
             Discard : Entity_Id;
             pragma Warnings (Off, Discard);
@@ -7630,6 +7633,26 @@ package body Sem_Ch6 is
 
             Layout_Type (Formal_Typ);
 
+            --  Force the definition of the Itype in case of internal function
+            --  calls within the same or nested scope.
+
+            if Is_Subprogram_Or_Generic_Subprogram (E) then
+               Subp_Decl := Parent (E);
+
+               --  The insertion point for an Itype reference should be after
+               --  the unit declaration node of the subprogram. An exception
+               --  to this are inherited operations from a parent type in which
+               --  case the derived type acts as their parent.
+
+               if Nkind_In (Subp_Decl, N_Function_Specification,
+                                       N_Procedure_Specification)
+               then
+                  Subp_Decl := Parent (Subp_Decl);
+               end if;
+
+               Build_Itype_Reference (Formal_Typ, Subp_Decl);
+            end if;
+
             Discard :=
               Add_Extra_Formal
                 (E, Formal_Typ, E, BIP_Formal_Suffix (BIP_Object_Access));