2012-04-02 Emmanuel Briot <briot@adacore.com>

	* g-expect.adb (Expect_Internal): Fix leak of the input file descriptor.

2012-04-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch4.adb (Expand_N_Quantified_Expression): Reimplemented.
	The expansion no longer uses the copy of the original QE created
	during analysis.
	* sem.adb (Analyze): Add processing for loop parameter specifications.
	* sem_ch4.adb (Analyze_Quantified_Expression): Reimplemented. The
	routine no longer creates a copy of the original QE. All
	constituents of a QE are now preanalyzed and resolved.
	* sem_ch5.adb (Analyze_Iteration_Scheme): Remove the guard which
	bypasses all processing when the iteration scheme is related to a
	QE. Relovate the code which analyzes loop parameter specifications
	to a separate routine.	(Analyze_Iterator_Specification):
	Preanalyze the iterator name. This action was originally
	done in Analyze_Iteration_Scheme. Update the check which
	detects an iterator specification in the context of a QE.
	(Analyze_Loop_Parameter_Specification): New routine. This
	procedure allows for a stand-alone analysis of a loop parameter
	specification without the need of a parent iteration scheme. Add
	code to update the type of the loop variable when the range
	generates an itype and the context is a QE.
	(Pre_Analyze_Range): Renamed to Preanalyze_Range. Update all references
	to the routine.
	* sem_ch5.ads: Code reformatting.
	(Analyze_Loop_Parameter_Specification): New routine.
	* sem_ch6.adb (Fully_Conformant_Expressions): Detect a case
	when establishing conformance between two QEs utilizing different
	specifications.
	* sem_res.adb (Proper_Current_Scope): New routine.
	(Resolve): Do not resolve a QE as there is nothing to be done now.
	Ignore any loop scopes generated for QEs when detecting an expression
	function as the scopes are cosmetic and do not appear in the tree.
	(Resolve_Quantified_Expression): Removed. All resolution of
	QE constituents is now performed during analysis. This ensures
	that loop variables appearing in array aggregates are properly
	resolved.

2012-04-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_util.adb (Build_Default_Subtype): If the base type is
	private and its full view is available, use the full view in
	the subtype declaration.



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

10 files changed, 790 insertions, 791 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 2e4f8e52721..73da5454856 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,50 @@
+2012-04-02  Emmanuel Briot  <briot@adacore.com>
+
+	* g-expect.adb (Expect_Internal): Fix leak of the input file descriptor.
+
+2012-04-02  Hristian Kirtchev  <kirtchev@adacore.com>
+
+	* exp_ch4.adb (Expand_N_Quantified_Expression): Reimplemented.
+	The expansion no longer uses the copy of the original QE created
+	during analysis.
+	* sem.adb (Analyze): Add processing for loop parameter specifications.
+	* sem_ch4.adb (Analyze_Quantified_Expression): Reimplemented. The
+	routine no longer creates a copy of the original QE. All
+	constituents of a QE are now preanalyzed and resolved.
+	* sem_ch5.adb (Analyze_Iteration_Scheme): Remove the guard which
+	bypasses all processing when the iteration scheme is related to a
+	QE. Relovate the code which analyzes loop parameter specifications
+	to a separate routine.	(Analyze_Iterator_Specification):
+	Preanalyze the iterator name. This action was originally
+	done in Analyze_Iteration_Scheme. Update the check which
+	detects an iterator specification in the context of a QE.
+	(Analyze_Loop_Parameter_Specification): New routine. This
+	procedure allows for a stand-alone analysis of a loop parameter
+	specification without the need of a parent iteration scheme. Add
+	code to update the type of the loop variable when the range
+	generates an itype and the context is a QE.
+	(Pre_Analyze_Range): Renamed to Preanalyze_Range. Update all references
+	to the routine.
+	* sem_ch5.ads: Code reformatting.
+	(Analyze_Loop_Parameter_Specification): New routine.
+	* sem_ch6.adb (Fully_Conformant_Expressions): Detect a case
+	when establishing conformance between two QEs utilizing different
+	specifications.
+	* sem_res.adb (Proper_Current_Scope): New routine.
+	(Resolve): Do not resolve a QE as there is nothing to be done now.
+	Ignore any loop scopes generated for QEs when detecting an expression
+	function as the scopes are cosmetic and do not appear in the tree.
+	(Resolve_Quantified_Expression): Removed. All resolution of
+	QE constituents is now performed during analysis. This ensures
+	that loop variables appearing in array aggregates are properly
+	resolved.
+
+2012-04-02  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_util.adb (Build_Default_Subtype): If the base type is
+	private and its full view is available, use the full view in
+	the subtype declaration.
+
 2012-04-02  Jose Ruiz  <ruiz@adacore.com>
 
 	* gnat_ugn.texi: Add some minimal documentation about how to
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index 09949a1c650..d08e375c96e 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -7884,73 +7884,78 @@ package body Exp_Ch4 is
    --  given by an iterator specification, not a loop parameter specification.
 
    procedure Expand_N_Quantified_Expression (N : Node_Id) is
-      Loc          : constant Source_Ptr := Sloc (N);
-      Is_Universal : constant Boolean := All_Present (N);
-      Actions      : constant List_Id := New_List;
-      Tnn          : constant Entity_Id := Make_Temporary (Loc, 'T', N);
-      Cond         : Node_Id;
-      Decl         : Node_Id;
-      I_Scheme     : Node_Id;
-      Original_N   : Node_Id;
-      Test         : Node_Id;
+      Actions   : constant List_Id    := New_List;
+      For_All   : constant Boolean    := All_Present (N);
+      Iter_Spec : constant Node_Id    := Iterator_Specification (N);
+      Loc       : constant Source_Ptr := Sloc (N);
+      Loop_Spec : constant Node_Id    := Loop_Parameter_Specification (N);
+      Cond      : Node_Id;
+      Flag      : Entity_Id;
+      Scheme    : Node_Id;
+      Stmts     : List_Id;
 
    begin
-      --  Retrieve the original quantified expression (non analyzed)
+      --  Create the declaration of the flag which tracks the status of the
+      --  quantified expression. Generate:
 
-      if Present (Loop_Parameter_Specification (N)) then
-         Original_N := Parent (Parent (Loop_Parameter_Specification (N)));
-      else
-         Original_N := Parent (Parent (Iterator_Specification (N)));
-      end if;
+      --    Flag : Boolean := (True | False);
 
-      --  Rewrite N with the original quantified expression
+      Flag := Make_Temporary (Loc, 'T', N);
 
-      Rewrite (N, Original_N);
-
-      Decl :=
+      Append_To (Actions,
         Make_Object_Declaration (Loc,
-          Defining_Identifier => Tnn,
+          Defining_Identifier => Flag,
           Object_Definition   => New_Occurrence_Of (Standard_Boolean, Loc),
           Expression          =>
-            New_Occurrence_Of (Boolean_Literals (Is_Universal), Loc));
-      Append_To (Actions, Decl);
+            New_Occurrence_Of (Boolean_Literals (For_All), Loc)));
+
+      --  Construct the circuitry which tracks the status of the quantified
+      --  expression. Generate:
+
+      --    if [not] Cond then
+      --       Flag := (False | True);
+      --       exit;
+      --    end if;
 
       Cond := Relocate_Node (Condition (N));
 
-      if Is_Universal then
+      if For_All then
          Cond := Make_Op_Not (Loc, Cond);
       end if;
 
-      Test :=
+      Stmts := New_List (
         Make_Implicit_If_Statement (N,
           Condition       => Cond,
           Then_Statements => New_List (
             Make_Assignment_Statement (Loc,
-              Name       => New_Occurrence_Of (Tnn, Loc),
+              Name       => New_Occurrence_Of (Flag, Loc),
               Expression =>
-                New_Occurrence_Of (Boolean_Literals (not Is_Universal), Loc)),
-            Make_Exit_Statement (Loc)));
+                New_Occurrence_Of (Boolean_Literals (not For_All), Loc)),
+            Make_Exit_Statement (Loc))));
 
-      if Present (Loop_Parameter_Specification (N)) then
-         I_Scheme :=
+      --  Build the loop equivalent of the quantified expression
+
+      if Present (Iter_Spec) then
+         Scheme :=
            Make_Iteration_Scheme (Loc,
-              Loop_Parameter_Specification =>
-                Loop_Parameter_Specification (N));
+             Iterator_Specification => Iter_Spec);
       else
-         I_Scheme :=
+         Scheme :=
            Make_Iteration_Scheme (Loc,
-             Iterator_Specification => Iterator_Specification (N));
+             Loop_Parameter_Specification => Loop_Spec);
       end if;
 
       Append_To (Actions,
         Make_Loop_Statement (Loc,
-          Iteration_Scheme => I_Scheme,
-          Statements       => New_List (Test),
+          Iteration_Scheme => Scheme,
+          Statements       => Stmts,
           End_Label        => Empty));
 
+      --  Transform the quantified expression
+
       Rewrite (N,
         Make_Expression_With_Actions (Loc,
-          Expression => New_Occurrence_Of (Tnn, Loc),
+          Expression => New_Occurrence_Of (Flag, Loc),
           Actions    => Actions));
 
       Analyze_And_Resolve (N, Standard_Boolean);
diff --git a/gcc/ada/g-expect.adb b/gcc/ada/g-expect.adb
index c6e18efa5b7..94f69642af4 100644
--- a/gcc/ada/g-expect.adb
+++ b/gcc/ada/g-expect.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---                     Copyright (C) 2000-2011, AdaCore                     --
+--                     Copyright (C) 2000-2012, AdaCore                     --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -33,7 +33,7 @@ with System;              use System;
 with System.OS_Constants; use System.OS_Constants;
 with Ada.Calendar;        use Ada.Calendar;
 
-with GNAT.IO;
+with GNAT.IO;      use GNAT.IO;
 with GNAT.OS_Lib;  use GNAT.OS_Lib;
 with GNAT.Regpat;  use GNAT.Regpat;
 
@@ -678,6 +678,7 @@ package body GNAT.Expect is
                            --  ??? Note that ddd tries again up to three times
                            --  in that case. See LiterateA.C:174
 
+                           Close (Descriptors (D).Input_Fd);
                            Descriptors (D).Input_Fd := Invalid_FD;
                            Result := Expect_Process_Died;
                            return;
@@ -893,7 +894,8 @@ package body GNAT.Expect is
 
    begin
       Non_Blocking_Spawn
-        (Process, Command, Arguments, Err_To_Out => Err_To_Out);
+        (Process, Command, Arguments, Err_To_Out => Err_To_Out,
+         Buffer_Size => 0);
 
       if Input'Length > 0 then
          Send (Process, Input);
@@ -1055,17 +1057,18 @@ package body GNAT.Expect is
       Command_With_Path : String_Access;
 
    begin
-      --  Create the rest of the pipes
-
-      Set_Up_Communications
-        (Descriptor, Err_To_Out, Pipe1'Access, Pipe2'Access, Pipe3'Access);
-
       Command_With_Path := Locate_Exec_On_Path (Command);
 
       if Command_With_Path = null then
          raise Invalid_Process;
       end if;
 
+      --  Create the rest of the pipes once we know we will be able to
+      --  execute the process.
+
+      Set_Up_Communications
+        (Descriptor, Err_To_Out, Pipe1'Access, Pipe2'Access, Pipe3'Access);
+
       --  Fork a new process
 
       Descriptor.Pid := Fork;
@@ -1365,6 +1368,8 @@ package body GNAT.Expect is
       end if;
 
       if Create_Pipe (Pipe2) /= 0 then
+         Close (Pipe1.Input);
+         Close (Pipe1.Output);
          return;
       end if;
 
@@ -1389,7 +1394,7 @@ package body GNAT.Expect is
          --  Create a separate pipe for standard error
 
          if Create_Pipe (Pipe3) /= 0 then
-            return;
+            Pipe3.all := Pipe2.all;
          end if;
       end if;
 
diff --git a/gcc/ada/sem.adb b/gcc/ada/sem.adb
index 2e50d3dc73b..503d1f40d43 100644
--- a/gcc/ada/sem.adb
+++ b/gcc/ada/sem.adb
@@ -314,6 +314,9 @@ package body Sem is
          when N_Label =>
             Analyze_Label (N);
 
+         when N_Loop_Parameter_Specification =>
+            Analyze_Loop_Parameter_Specification (N);
+
          when N_Loop_Statement =>
             Analyze_Loop_Statement (N);
 
@@ -681,7 +684,6 @@ package body Sem is
            N_Generic_Association                    |
            N_Index_Or_Discriminant_Constraint       |
            N_Iteration_Scheme                       |
-           N_Loop_Parameter_Specification           |
            N_Mod_Clause                             |
            N_Modular_Type_Definition                |
            N_Ordinary_Fixed_Point_Definition        |
diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index d56da36f3fa..55238e2ca11 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -47,7 +47,6 @@ with Sem_Aux;  use Sem_Aux;
 with Sem_Case; use Sem_Case;
 with Sem_Cat;  use Sem_Cat;
 with Sem_Ch3;  use Sem_Ch3;
-with Sem_Ch5;  use Sem_Ch5;
 with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Dim;  use Sem_Dim;
@@ -3403,101 +3402,38 @@ package body Sem_Ch4 is
    -----------------------------------
 
    procedure Analyze_Quantified_Expression (N : Node_Id) is
-      Loc : constant Source_Ptr := Sloc (N);
-      Ent : constant Entity_Id :=
-             New_Internal_Entity (E_Loop, Current_Scope, Sloc (N), 'L');
-
-      Need_Preanalysis : constant Boolean :=
-                           Operating_Mode /= Check_Semantics
-                             and then not Alfa_Mode;
-
-      Iterator   : Node_Id;
-      Original_N : Node_Id;
+      QE_Scop : Entity_Id;
 
    begin
-      --  The approach in this procedure is very non-standard and at the
-      --  very least, extensive comments are required saying why this very
-      --  non-standard approach is needed???
-
-      --  Also general comments are needed in any case saying what is going
-      --  on here, since tree rewriting of this kind should normally be done
-      --  by the expander and not by the analyzer ??? Probably Ent, Iterator,
-      --  and Original_N, and Needs_Preanalysis, all need comments above ???
-
-      --  Preserve the original node used for the expansion of the quantified
-      --  expression.
-
-      --  This is a very unusual use of Copy_Separate_Tree, needs looking at???
-
-      if Need_Preanalysis then
-         Original_N := Copy_Separate_Tree (N);
-      end if;
-
-      Set_Etype  (Ent, Standard_Void_Type);
-      Set_Scope  (Ent, Current_Scope);
-      Set_Parent (Ent, N);
-
       Check_SPARK_Restriction ("quantified expression is not allowed", N);
 
-      --  The following seems like expansion activity done at analysis
-      --  time, which seems weird ???
+      --  Create a scope to emulate the loop-like behavior of the quantified
+      --  expression. The scope is needed to provide proper visibility of the
+      --  loop variable.
 
-      if Present (Loop_Parameter_Specification (N)) then
-         Iterator :=
-           Make_Iteration_Scheme (Loc,
-             Loop_Parameter_Specification =>
-               Loop_Parameter_Specification (N));
-      else
-         Iterator :=
-           Make_Iteration_Scheme (Loc,
-              Iterator_Specification =>
-                Iterator_Specification (N));
-      end if;
+      QE_Scop := New_Internal_Entity (E_Loop, Current_Scope, Sloc (N), 'L');
+      Set_Etype  (QE_Scop, Standard_Void_Type);
+      Set_Scope  (QE_Scop, Current_Scope);
+      Set_Parent (QE_Scop, N);
 
-      Push_Scope (Ent);
-      Set_Parent (Iterator, N);
-      Analyze_Iteration_Scheme (Iterator);
+      Push_Scope (QE_Scop);
 
-      --  The loop specification may have been converted into an iterator
-      --  specification during its analysis. Update the quantified node
-      --  accordingly.
+      --  All constituents are preanalyzed and resolved to avoid untimely
+      --  generation of various temporaries and types. Full analysis and
+      --  expansion is carried out when the quantified expression is
+      --  transformed into an expression with actions.
 
-      if Present (Iterator_Specification (Iterator)) then
-         Set_Iterator_Specification
-           (N, Iterator_Specification (Iterator));
-         Set_Loop_Parameter_Specification (N, Empty);
-         Set_Parent (Iterator_Specification (Iterator), Iterator);
-      end if;
-
-      if Need_Preanalysis then
-
-         --  The full analysis will be performed during the expansion of the
-         --  quantified expression, only a preanalysis of the condition needs
-         --  to be done.
-
-         --  This is strange for two reasons
-
-         --  First, there is almost no situation in which Preanalyze vs
-         --  Analyze should be conditioned on -gnatc mode (since error msgs
-         --  must be 100% unaffected by -gnatc). Seconed doing a Preanalyze
-         --  with no resolution almost certainly means that some messages are
-         --  either missed, or flagged differently in the two cases.
-
-         Preanalyze (Condition (N));
+      if Present (Iterator_Specification (N)) then
+         Preanalyze (Iterator_Specification (N));
       else
-         Analyze (Condition (N));
+         Preanalyze (Loop_Parameter_Specification (N));
       end if;
 
+      Preanalyze_And_Resolve (Condition (N), Standard_Boolean);
+
       End_Scope;
 
       Set_Etype (N, Standard_Boolean);
-
-      --  Attach the original node to the iteration scheme created above
-
-      if Need_Preanalysis then
-         Set_Etype (Original_N, Standard_Boolean);
-         Set_Parent (Iterator, Original_N);
-      end if;
    end Analyze_Quantified_Expression;
 
    -------------------
diff --git a/gcc/ada/sem_ch5.adb b/gcc/ada/sem_ch5.adb
index 7155ba90177..6b45c075ae9 100644
--- a/gcc/ada/sem_ch5.adb
+++ b/gcc/ada/sem_ch5.adb
@@ -76,7 +76,7 @@ package body Sem_Ch5 is
    --  messages. This variable is recursively saved on entry to processing the
    --  construct, and restored on exit.
 
-   procedure Pre_Analyze_Range (R_Copy : Node_Id);
+   procedure Preanalyze_Range (R_Copy : Node_Id);
    --  Determine expected type of range or domain of iteration of Ada 2012
    --  loop by analyzing separate copy. Do the analysis and resolution of the
    --  copy of the bound(s) with expansion disabled, to prevent the generation
@@ -1607,618 +1607,32 @@ package body Sem_Ch5 is
    ------------------------------
 
    procedure Analyze_Iteration_Scheme (N : Node_Id) is
-
-      procedure Process_Bounds (R : Node_Id);
-      --  If the iteration is given by a range, create temporaries and
-      --  assignment statements block to capture the bounds and perform
-      --  required finalization actions in case a bound includes a function
-      --  call that uses the temporary stack. We first pre-analyze a copy of
-      --  the range in order to determine the expected type, and analyze and
-      --  resolve the original bounds.
-
-      procedure Check_Controlled_Array_Attribute (DS : Node_Id);
-      --  If the bounds are given by a 'Range reference on a function call
-      --  that returns a controlled array, introduce an explicit declaration
-      --  to capture the bounds, so that the function result can be finalized
-      --  in timely fashion.
-
-      function Has_Call_Using_Secondary_Stack (N : Node_Id) return Boolean;
-      --  N is the node for an arbitrary construct. This function searches the
-      --  construct N to see if any expressions within it contain function
-      --  calls that use the secondary stack, returning True if any such call
-      --  is found, and False otherwise.
-
-      --------------------
-      -- Process_Bounds --
-      --------------------
-
-      procedure Process_Bounds (R : Node_Id) is
-         Loc          : constant Source_Ptr := Sloc (N);
-         R_Copy       : constant Node_Id := New_Copy_Tree (R);
-         Lo           : constant Node_Id := Low_Bound  (R);
-         Hi           : constant Node_Id := High_Bound (R);
-         New_Lo_Bound : Node_Id;
-         New_Hi_Bound : Node_Id;
-         Typ          : Entity_Id;
-
-         function One_Bound
-           (Original_Bound : Node_Id;
-            Analyzed_Bound : Node_Id) return Node_Id;
-         --  Capture value of bound and return captured value
-
-         ---------------
-         -- One_Bound --
-         ---------------
-
-         function One_Bound
-           (Original_Bound : Node_Id;
-            Analyzed_Bound : Node_Id) return Node_Id
-         is
-            Assign : Node_Id;
-            Decl   : Node_Id;
-            Id     : Entity_Id;
-
-         begin
-            --  If the bound is a constant or an object, no need for a separate
-            --  declaration. If the bound is the result of previous expansion
-            --  it is already analyzed and should not be modified. Note that
-            --  the Bound will be resolved later, if needed, as part of the
-            --  call to Make_Index (literal bounds may need to be resolved to
-            --  type Integer).
-
-            if Analyzed (Original_Bound) then
-               return Original_Bound;
-
-            elsif Nkind_In (Analyzed_Bound, N_Integer_Literal,
-                                            N_Character_Literal)
-              or else Is_Entity_Name (Analyzed_Bound)
-            then
-               Analyze_And_Resolve (Original_Bound, Typ);
-               return Original_Bound;
-            end if;
-
-            --  Normally, the best approach is simply to generate a constant
-            --  declaration that captures the bound. However, there is a nasty
-            --  case where this is wrong. If the bound is complex, and has a
-            --  possible use of the secondary stack, we need to generate a
-            --  separate assignment statement to ensure the creation of a block
-            --  which will release the secondary stack.
-
-            --  We prefer the constant declaration, since it leaves us with a
-            --  proper trace of the value, useful in optimizations that get rid
-            --  of junk range checks.
-
-            if not Has_Call_Using_Secondary_Stack (Analyzed_Bound) then
-               Analyze_And_Resolve (Original_Bound, Typ);
-               Force_Evaluation (Original_Bound);
-               return Original_Bound;
-            end if;
-
-            Id := Make_Temporary (Loc, 'R', Original_Bound);
-
-            --  Here we make a declaration with a separate assignment
-            --  statement, and insert before loop header.
-
-            Decl :=
-              Make_Object_Declaration (Loc,
-                Defining_Identifier => Id,
-                Object_Definition   => New_Occurrence_Of (Typ, Loc));
-
-            Assign :=
-              Make_Assignment_Statement (Loc,
-                Name        => New_Occurrence_Of (Id, Loc),
-                Expression  => Relocate_Node (Original_Bound));
-
-            Insert_Actions (Parent (N), New_List (Decl, Assign));
-
-            --  Now that this temporary variable is initialized we decorate it
-            --  as safe-to-reevaluate to inform to the backend that no further
-            --  asignment will be issued and hence it can be handled as side
-            --  effect free. Note that this decoration must be done when the
-            --  assignment has been analyzed because otherwise it will be
-            --  rejected (see Analyze_Assignment).
-
-            Set_Is_Safe_To_Reevaluate (Id);
-
-            Rewrite (Original_Bound, New_Occurrence_Of (Id, Loc));
-
-            if Nkind (Assign) = N_Assignment_Statement then
-               return Expression (Assign);
-            else
-               return Original_Bound;
-            end if;
-         end One_Bound;
-
-      --  Start of processing for Process_Bounds
-
-      begin
-         Set_Parent (R_Copy, Parent (R));
-         Pre_Analyze_Range (R_Copy);
-         Typ := Etype (R_Copy);
-
-         --  If the type of the discrete range is Universal_Integer, then the
-         --  bound's type must be resolved to Integer, and any object used to
-         --  hold the bound must also have type Integer, unless the literal
-         --  bounds are constant-folded expressions with a user-defined type.
-
-         if Typ = Universal_Integer then
-            if Nkind (Lo) = N_Integer_Literal
-              and then Present (Etype (Lo))
-              and then Scope (Etype (Lo)) /= Standard_Standard
-            then
-               Typ := Etype (Lo);
-
-            elsif Nkind (Hi) = N_Integer_Literal
-              and then Present (Etype (Hi))
-              and then Scope (Etype (Hi)) /= Standard_Standard
-            then
-               Typ := Etype (Hi);
-
-            else
-               Typ := Standard_Integer;
-            end if;
-         end if;
-
-         Set_Etype (R, Typ);
-
-         New_Lo_Bound := One_Bound (Lo, Low_Bound  (R_Copy));
-         New_Hi_Bound := One_Bound (Hi, High_Bound (R_Copy));
-
-         --  Propagate staticness to loop range itself, in case the
-         --  corresponding subtype is static.
-
-         if New_Lo_Bound /= Lo
-           and then Is_Static_Expression (New_Lo_Bound)
-         then
-            Rewrite (Low_Bound (R), New_Copy (New_Lo_Bound));
-         end if;
-
-         if New_Hi_Bound /= Hi
-           and then Is_Static_Expression (New_Hi_Bound)
-         then
-            Rewrite (High_Bound (R), New_Copy (New_Hi_Bound));
-         end if;
-      end Process_Bounds;
-
-      --------------------------------------
-      -- Check_Controlled_Array_Attribute --
-      --------------------------------------
-
-      procedure Check_Controlled_Array_Attribute (DS : Node_Id) is
-      begin
-         if Nkind (DS) = N_Attribute_Reference
-            and then Is_Entity_Name (Prefix (DS))
-            and then Ekind (Entity (Prefix (DS))) = E_Function
-            and then Is_Array_Type (Etype (Entity (Prefix (DS))))
-            and then
-              Is_Controlled (
-                Component_Type (Etype (Entity (Prefix (DS)))))
-            and then Expander_Active
-         then
-            declare
-               Loc  : constant Source_Ptr := Sloc (N);
-               Arr  : constant Entity_Id := Etype (Entity (Prefix (DS)));
-               Indx : constant Entity_Id :=
-                        Base_Type (Etype (First_Index (Arr)));
-               Subt : constant Entity_Id := Make_Temporary (Loc, 'S');
-               Decl : Node_Id;
-
-            begin
-               Decl :=
-                 Make_Subtype_Declaration (Loc,
-                   Defining_Identifier => Subt,
-                   Subtype_Indication  =>
-                      Make_Subtype_Indication (Loc,
-                        Subtype_Mark  => New_Reference_To (Indx, Loc),
-                        Constraint =>
-                          Make_Range_Constraint (Loc,
-                            Relocate_Node (DS))));
-               Insert_Before (Parent (N), Decl);
-               Analyze (Decl);
-
-               Rewrite (DS,
-                  Make_Attribute_Reference (Loc,
-                    Prefix => New_Reference_To (Subt, Loc),
-                    Attribute_Name => Attribute_Name (DS)));
-               Analyze (DS);
-            end;
-         end if;
-      end Check_Controlled_Array_Attribute;
-
-      ------------------------------------
-      -- Has_Call_Using_Secondary_Stack --
-      ------------------------------------
-
-      function Has_Call_Using_Secondary_Stack (N : Node_Id) return Boolean is
-
-         function Check_Call (N : Node_Id) return Traverse_Result;
-         --  Check if N is a function call which uses the secondary stack
-
-         ----------------
-         -- Check_Call --
-         ----------------
-
-         function Check_Call (N : Node_Id) return Traverse_Result is
-            Nam        : Node_Id;
-            Subp       : Entity_Id;
-            Return_Typ : Entity_Id;
-
-         begin
-            if Nkind (N) = N_Function_Call then
-               Nam := Name (N);
-
-               --  Call using access to subprogram with explicit dereference
-
-               if Nkind (Nam) = N_Explicit_Dereference then
-                  Subp := Etype (Nam);
-
-               --  Call using a selected component notation or Ada 2005 object
-               --  operation notation
-
-               elsif Nkind (Nam) = N_Selected_Component then
-                  Subp := Entity (Selector_Name (Nam));
-
-               --  Common case
-
-               else
-                  Subp := Entity (Nam);
-               end if;
-
-               Return_Typ := Etype (Subp);
-
-               if Is_Composite_Type (Return_Typ)
-                 and then not Is_Constrained (Return_Typ)
-               then
-                  return Abandon;
-
-               elsif Sec_Stack_Needed_For_Return (Subp) then
-                  return Abandon;
-               end if;
-            end if;
-
-            --  Continue traversing the tree
-
-            return OK;
-         end Check_Call;
-
-         function Check_Calls is new Traverse_Func (Check_Call);
-
-      --  Start of processing for Has_Call_Using_Secondary_Stack
-
-      begin
-         return Check_Calls (N) = Abandon;
-      end Has_Call_Using_Secondary_Stack;
-
-   --  Start of processing for Analyze_Iteration_Scheme
+      Cond      : Node_Id;
+      Iter_Spec : Node_Id;
+      Loop_Spec : Node_Id;
 
    begin
-      --  If this is a rewritten quantified expression, the iteration scheme
-      --  has been analyzed already. Do no repeat analysis because the loop
-      --  variable is already declared.
-
-      if Analyzed (N) then
-         return;
-      end if;
-
       --  For an infinite loop, there is no iteration scheme
 
       if No (N) then
          return;
       end if;
 
-      --  Iteration scheme is present
-
-      declare
-         Cond : constant Node_Id := Condition (N);
-
-      begin
-         --  For WHILE loop, verify that the condition is a Boolean expression
-         --  and resolve and check it.
-
-         if Present (Cond) then
-            Analyze_And_Resolve (Cond, Any_Boolean);
-            Check_Unset_Reference (Cond);
-            Set_Current_Value_Condition (N);
-            return;
-
-         --  For an iterator specification with "of", pre-analyze range to
-         --  capture function calls that may require finalization actions.
-
-         elsif Present (Iterator_Specification (N)) then
-            Pre_Analyze_Range (Name (Iterator_Specification (N)));
-            Analyze_Iterator_Specification (Iterator_Specification (N));
-
-         --  Else we have a FOR loop
-
-         else
-            declare
-               LP : constant Node_Id   := Loop_Parameter_Specification (N);
-               Id : constant Entity_Id := Defining_Identifier (LP);
-               DS : constant Node_Id   := Discrete_Subtype_Definition (LP);
-
-               D_Copy : Node_Id;
-
-            begin
-               Enter_Name (Id);
-
-               --  We always consider the loop variable to be referenced, since
-               --  the loop may be used just for counting purposes.
-
-               Generate_Reference (Id, N, ' ');
-
-               --  Check for the case of loop variable hiding a local variable
-               --  (used later on to give a nice warning if the hidden variable
-               --  is never assigned).
-
-               declare
-                  H : constant Entity_Id := Homonym (Id);
-               begin
-                  if Present (H)
-                    and then Enclosing_Dynamic_Scope (H) =
-                               Enclosing_Dynamic_Scope (Id)
-                    and then Ekind (H) = E_Variable
-                    and then Is_Discrete_Type (Etype (H))
-                  then
-                     Set_Hiding_Loop_Variable (H, Id);
-                  end if;
-               end;
-
-               --  Loop parameter specification must include subtype mark in
-               --  SPARK.
-
-               if Nkind (DS) = N_Range then
-                  Check_SPARK_Restriction
-                    ("loop parameter specification must include subtype mark",
-                     N);
-               end if;
-
-               --  Analyze the subtype definition and create temporaries for
-               --  the bounds. Do not evaluate the range when preanalyzing a
-               --  quantified expression because bounds expressed as function
-               --  calls with side effects will be erroneously replicated.
-
-               if Nkind (DS) = N_Range
-                 and then Expander_Active
-                 and then Nkind (Parent (N)) /= N_Quantified_Expression
-               then
-                  Process_Bounds (DS);
-
-               --  Expander not active or else range of iteration is a subtype
-               --  indication, an entity, or a function call that yields an
-               --  aggregate or a container.
-
-               else
-                  D_Copy := New_Copy_Tree (DS);
-                  Set_Parent (D_Copy, Parent (DS));
-                  Pre_Analyze_Range (D_Copy);
-
-                  --  Ada 2012: If the domain of iteration is a function call,
-                  --  it is the new iterator form.
-
-                  --  We have also implemented the shorter form : for X in S
-                  --  for Alfa use. In this case, 'Old and 'Result must be
-                  --  treated as entity names over which iterators are legal.
+      Cond      := Condition (N);
+      Iter_Spec := Iterator_Specification (N);
+      Loop_Spec := Loop_Parameter_Specification (N);
 
-                  if Nkind (D_Copy) = N_Function_Call
-                    or else
-                      (Alfa_Mode
-                        and then (Nkind (D_Copy) = N_Attribute_Reference
-                        and then
-                          (Attribute_Name (D_Copy) = Name_Result
-                            or else Attribute_Name (D_Copy) = Name_Old)))
-                    or else
-                      (Is_Entity_Name (D_Copy)
-                        and then not Is_Type (Entity (D_Copy)))
-                  then
-                     --  This is an iterator specification. Rewrite as such
-                     --  and analyze, to capture function calls that may
-                     --  require finalization actions.
-
-                     declare
-                        I_Spec : constant Node_Id :=
-                                   Make_Iterator_Specification (Sloc (LP),
-                                     Defining_Identifier =>
-                                       Relocate_Node (Id),
-                                     Name                => D_Copy,
-                                     Subtype_Indication  => Empty,
-                                     Reverse_Present     =>
-                                       Reverse_Present (LP));
-                     begin
-                        Set_Iterator_Specification (N, I_Spec);
-                        Set_Loop_Parameter_Specification (N, Empty);
-                        Analyze_Iterator_Specification (I_Spec);
-
-                        --  In a generic context, analyze the original domain
-                        --  of iteration, for name capture.
-
-                        if not Expander_Active then
-                           Analyze (DS);
-                        end if;
-
-                        --  Set kind of loop parameter, which may be used in
-                        --  the subsequent analysis of the condition in a
-                        --  quantified expression.
-
-                        Set_Ekind (Id, E_Loop_Parameter);
-                        return;
-                     end;
-
-                  --  Domain of iteration is not a function call, and is
-                  --  side-effect free.
-
-                  else
-                     Analyze (DS);
-                  end if;
-               end if;
-
-               if DS = Error then
-                  return;
-               end if;
-
-               --  Some additional checks if we are iterating through a type
-
-               if Is_Entity_Name (DS)
-                 and then Present (Entity (DS))
-                 and then Is_Type (Entity (DS))
-               then
-                  --  The subtype indication may denote the completion of an
-                  --  incomplete type declaration.
-
-                  if Ekind (Entity (DS)) = E_Incomplete_Type then
-                     Set_Entity (DS, Get_Full_View (Entity (DS)));
-                     Set_Etype  (DS, Entity (DS));
-                  end if;
-
-                  --  Attempt to iterate through non-static predicate
-
-                  if Is_Discrete_Type (Entity (DS))
-                    and then Present (Predicate_Function (Entity (DS)))
-                    and then No (Static_Predicate (Entity (DS)))
-                  then
-                     Bad_Predicated_Subtype_Use
-                       ("cannot use subtype& with non-static "
-                        & "predicate for loop iteration", DS, Entity (DS));
-                  end if;
-               end if;
-
-               --  Error if not discrete type
-
-               if not Is_Discrete_Type (Etype (DS)) then
-                  Wrong_Type (DS, Any_Discrete);
-                  Set_Etype (DS, Any_Type);
-               end if;
-
-               Check_Controlled_Array_Attribute (DS);
-
-               --  The index is not processed during analysis of a quantified
-               --  expression but delayed to its expansion where the quantified
-               --  expression is transformed into an expression with actions.
-
-               if Nkind (Parent (N)) /= N_Quantified_Expression
-                 or else Operating_Mode = Check_Semantics
-                 or else Alfa_Mode
-               then
-                  Make_Index (DS, LP, In_Iter_Schm => True);
-               end if;
-
-               Set_Ekind (Id, E_Loop_Parameter);
-
-               --  If the loop is part of a predicate or precondition, it may
-               --  be analyzed twice, once in the source and once on the copy
-               --  used to check conformance. Preserve the original itype
-               --  because the second one may be created in a different scope,
-               --  e.g. a precondition procedure, leading to a crash in GIGI.
-
-               if No (Etype (Id)) or else Etype (Id) = Any_Type then
-                  Set_Etype (Id, Etype (DS));
-               end if;
-
-               --  Treat a range as an implicit reference to the type, to
-               --  inhibit spurious warnings.
-
-               Generate_Reference (Base_Type (Etype (DS)), N, ' ');
-               Set_Is_Known_Valid (Id, True);
-
-               --  The loop is not a declarative part, so the only entity
-               --  declared "within" must be frozen explicitly.
-
-               declare
-                  Flist : constant List_Id := Freeze_Entity (Id, N);
-               begin
-                  if Is_Non_Empty_List (Flist) then
-                     Insert_Actions (N, Flist);
-                  end if;
-               end;
-
-               --  Check for null or possibly null range and issue warning. We
-               --  suppress such messages in generic templates and instances,
-               --  because in practice they tend to be dubious in these cases.
-
-               if Nkind (DS) = N_Range and then Comes_From_Source (N) then
-                  declare
-                     L : constant Node_Id := Low_Bound  (DS);
-                     H : constant Node_Id := High_Bound (DS);
-
-                  begin
-                     --  If range of loop is null, issue warning
-
-                     if Compile_Time_Compare
-                          (L, H, Assume_Valid => True) = GT
-                     then
-                        --  Suppress the warning if inside a generic template
-                        --  or instance, since in practice they tend to be
-                        --  dubious in these cases since they can result from
-                        --  intended parametrization.
-
-                        if not Inside_A_Generic
-                          and then not In_Instance
-                        then
-                           --  Specialize msg if invalid values could make the
-                           --  loop non-null after all.
-
-                           if Compile_Time_Compare
-                                (L, H, Assume_Valid => False) = GT
-                           then
-                              Error_Msg_N
-                                ("?loop range is null, loop will not execute",
-                                 DS);
-
-                              --  Since we know the range of the loop is null,
-                              --  set the appropriate flag to remove the loop
-                              --  entirely during expansion.
-
-                              Set_Is_Null_Loop (Parent (N));
-
-                              --  Here is where the loop could execute because
-                              --  of invalid values, so issue appropriate
-                              --  message and in this case we do not set the
-                              --  Is_Null_Loop flag since the loop may execute.
-
-                           else
-                              Error_Msg_N
-                                ("?loop range may be null, "
-                                 & "loop may not execute",
-                                 DS);
-                              Error_Msg_N
-                                ("?can only execute if invalid values "
-                                 & "are present",
-                                 DS);
-                           end if;
-                        end if;
-
-                        --  In either case, suppress warnings in the body of
-                        --  the loop, since it is likely that these warnings
-                        --  will be inappropriate if the loop never actually
-                        --  executes, which is likely.
-
-                        Set_Suppress_Loop_Warnings (Parent (N));
-
-                        --  The other case for a warning is a reverse loop
-                        --  where the upper bound is the integer literal zero
-                        --  or one, and the lower bound can be positive.
-
-                        --  For example, we have
-
-                        --     for J in reverse N .. 1 loop
+      if Present (Cond) then
+         Analyze_And_Resolve (Cond, Any_Boolean);
+         Check_Unset_Reference (Cond);
+         Set_Current_Value_Condition (N);
 
-                        --  In practice, this is very likely to be a case of
-                        --  reversing the bounds incorrectly in the range.
+      elsif Present (Iter_Spec) then
+         Analyze_Iterator_Specification (Iter_Spec);
 
-                     elsif Reverse_Present (LP)
-                       and then Nkind (Original_Node (H)) =
-                                                      N_Integer_Literal
-                       and then (Intval (Original_Node (H)) = Uint_0
-                                  or else
-                                    Intval (Original_Node (H)) = Uint_1)
-                     then
-                        Error_Msg_N ("?loop range may be null", DS);
-                        Error_Msg_N ("\?bounds may be wrong way round", DS);
-                     end if;
-                  end;
-               end if;
-            end;
-         end if;
-      end;
+      else
+         Analyze_Loop_Parameter_Specification (Loop_Spec);
+      end if;
    end Analyze_Iteration_Scheme;
 
    ------------------------------------
@@ -2236,22 +1650,22 @@ package body Sem_Ch5 is
 
    begin
       Enter_Name (Def_Id);
-
       Set_Ekind (Def_Id, E_Variable);
 
       if Present (Subt) then
          Analyze (Subt);
       end if;
 
-      --  If domain of iteration is an expression, create a declaration for
+      Preanalyze_Range (Iter_Name);
+
+      --  If the domain of iteration is an expression, create a declaration for
       --  it, so that finalization actions are introduced outside of the loop.
       --  The declaration must be a renaming because the body of the loop may
-      --  assign to elements. In case of a quantified expression, this
-      --  declaration is delayed to its expansion where the node is rewritten
-      --  as an expression with actions.
+      --  assign to elements. When the context is a quantified expression, the
+      --  renaming declaration is delayed until the expansion phase.
 
       if not Is_Entity_Name (Iter_Name)
-        and then (Nkind (Parent (Parent (N))) /= N_Quantified_Expression
+        and then (Nkind (Parent (N)) /= N_Quantified_Expression
                    or else Operating_Mode = Check_Semantics
                    or else Alfa_Mode)
       then
@@ -2445,6 +1859,571 @@ package body Sem_Ch5 is
       Set_Reachable       (E, True);
    end Analyze_Label_Entity;
 
+   ------------------------------------------
+   -- Analyze_Loop_Parameter_Specification --
+   ------------------------------------------
+
+   procedure Analyze_Loop_Parameter_Specification (N : Node_Id) is
+      Loop_Nod : constant Node_Id := Parent (Parent (N));
+
+      procedure Check_Controlled_Array_Attribute (DS : Node_Id);
+      --  If the bounds are given by a 'Range reference on a function call
+      --  that returns a controlled array, introduce an explicit declaration
+      --  to capture the bounds, so that the function result can be finalized
+      --  in timely fashion.
+
+      function Has_Call_Using_Secondary_Stack (N : Node_Id) return Boolean;
+      --  N is the node for an arbitrary construct. This function searches the
+      --  construct N to see if any expressions within it contain function
+      --  calls that use the secondary stack, returning True if any such call
+      --  is found, and False otherwise.
+
+      procedure Process_Bounds (R : Node_Id);
+      --  If the iteration is given by a range, create temporaries and
+      --  assignment statements block to capture the bounds and perform
+      --  required finalization actions in case a bound includes a function
+      --  call that uses the temporary stack. We first pre-analyze a copy of
+      --  the range in order to determine the expected type, and analyze and
+      --  resolve the original bounds.
+
+      --------------------------------------
+      -- Check_Controlled_Array_Attribute --
+      --------------------------------------
+
+      procedure Check_Controlled_Array_Attribute (DS : Node_Id) is
+      begin
+         if Nkind (DS) = N_Attribute_Reference
+           and then Is_Entity_Name (Prefix (DS))
+           and then Ekind (Entity (Prefix (DS))) = E_Function
+           and then Is_Array_Type (Etype (Entity (Prefix (DS))))
+           and then
+             Is_Controlled (Component_Type (Etype (Entity (Prefix (DS)))))
+           and then Expander_Active
+         then
+            declare
+               Loc  : constant Source_Ptr := Sloc (N);
+               Arr  : constant Entity_Id := Etype (Entity (Prefix (DS)));
+               Indx : constant Entity_Id :=
+                        Base_Type (Etype (First_Index (Arr)));
+               Subt : constant Entity_Id := Make_Temporary (Loc, 'S');
+               Decl : Node_Id;
+
+            begin
+               Decl :=
+                 Make_Subtype_Declaration (Loc,
+                   Defining_Identifier => Subt,
+                   Subtype_Indication  =>
+                      Make_Subtype_Indication (Loc,
+                        Subtype_Mark => New_Reference_To (Indx, Loc),
+                        Constraint   =>
+                          Make_Range_Constraint (Loc, Relocate_Node (DS))));
+               Insert_Before (Loop_Nod, Decl);
+               Analyze (Decl);
+
+               Rewrite (DS,
+                 Make_Attribute_Reference (Loc,
+                   Prefix         => New_Reference_To (Subt, Loc),
+                   Attribute_Name => Attribute_Name (DS)));
+
+               Analyze (DS);
+            end;
+         end if;
+      end Check_Controlled_Array_Attribute;
+
+      ------------------------------------
+      -- Has_Call_Using_Secondary_Stack --
+      ------------------------------------
+
+      function Has_Call_Using_Secondary_Stack (N : Node_Id) return Boolean is
+
+         function Check_Call (N : Node_Id) return Traverse_Result;
+         --  Check if N is a function call which uses the secondary stack
+
+         ----------------
+         -- Check_Call --
+         ----------------
+
+         function Check_Call (N : Node_Id) return Traverse_Result is
+            Nam        : Node_Id;
+            Subp       : Entity_Id;
+            Return_Typ : Entity_Id;
+
+         begin
+            if Nkind (N) = N_Function_Call then
+               Nam := Name (N);
+
+               --  Call using access to subprogram with explicit dereference
+
+               if Nkind (Nam) = N_Explicit_Dereference then
+                  Subp := Etype (Nam);
+
+               --  Call using a selected component notation or Ada 2005 object
+               --  operation notation
+
+               elsif Nkind (Nam) = N_Selected_Component then
+                  Subp := Entity (Selector_Name (Nam));
+
+               --  Common case
+
+               else
+                  Subp := Entity (Nam);
+               end if;
+
+               Return_Typ := Etype (Subp);
+
+               if Is_Composite_Type (Return_Typ)
+                 and then not Is_Constrained (Return_Typ)
+               then
+                  return Abandon;
+
+               elsif Sec_Stack_Needed_For_Return (Subp) then
+                  return Abandon;
+               end if;
+            end if;
+
+            --  Continue traversing the tree
+
+            return OK;
+         end Check_Call;
+
+         function Check_Calls is new Traverse_Func (Check_Call);
+
+      --  Start of processing for Has_Call_Using_Secondary_Stack
+
+      begin
+         return Check_Calls (N) = Abandon;
+      end Has_Call_Using_Secondary_Stack;
+
+      --------------------
+      -- Process_Bounds --
+      --------------------
+
+      procedure Process_Bounds (R : Node_Id) is
+         Loc : constant Source_Ptr := Sloc (N);
+
+         function One_Bound
+           (Original_Bound : Node_Id;
+            Analyzed_Bound : Node_Id;
+            Typ            : Entity_Id) return Node_Id;
+         --  Capture value of bound and return captured value
+
+         ---------------
+         -- One_Bound --
+         ---------------
+
+         function One_Bound
+           (Original_Bound : Node_Id;
+            Analyzed_Bound : Node_Id;
+            Typ            : Entity_Id) return Node_Id
+         is
+            Assign : Node_Id;
+            Decl   : Node_Id;
+            Id     : Entity_Id;
+
+         begin
+            --  If the bound is a constant or an object, no need for a separate
+            --  declaration. If the bound is the result of previous expansion
+            --  it is already analyzed and should not be modified. Note that
+            --  the Bound will be resolved later, if needed, as part of the
+            --  call to Make_Index (literal bounds may need to be resolved to
+            --  type Integer).
+
+            if Analyzed (Original_Bound) then
+               return Original_Bound;
+
+            elsif Nkind_In (Analyzed_Bound, N_Integer_Literal,
+                                            N_Character_Literal)
+              or else Is_Entity_Name (Analyzed_Bound)
+            then
+               Analyze_And_Resolve (Original_Bound, Typ);
+               return Original_Bound;
+            end if;
+
+            --  Normally, the best approach is simply to generate a constant
+            --  declaration that captures the bound. However, there is a nasty
+            --  case where this is wrong. If the bound is complex, and has a
+            --  possible use of the secondary stack, we need to generate a
+            --  separate assignment statement to ensure the creation of a block
+            --  which will release the secondary stack.
+
+            --  We prefer the constant declaration, since it leaves us with a
+            --  proper trace of the value, useful in optimizations that get rid
+            --  of junk range checks.
+
+            if not Has_Call_Using_Secondary_Stack (Analyzed_Bound) then
+               Analyze_And_Resolve (Original_Bound, Typ);
+               Force_Evaluation (Original_Bound);
+               return Original_Bound;
+            end if;
+
+            Id := Make_Temporary (Loc, 'R', Original_Bound);
+
+            --  Here we make a declaration with a separate assignment
+            --  statement, and insert before loop header.
+
+            Decl :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => Id,
+                Object_Definition   => New_Occurrence_Of (Typ, Loc));
+
+            Assign :=
+              Make_Assignment_Statement (Loc,
+                Name        => New_Occurrence_Of (Id, Loc),
+                Expression  => Relocate_Node (Original_Bound));
+
+            Insert_Actions (Loop_Nod, New_List (Decl, Assign));
+
+            --  Now that this temporary variable is initialized we decorate it
+            --  as safe-to-reevaluate to inform to the backend that no further
+            --  asignment will be issued and hence it can be handled as side
+            --  effect free. Note that this decoration must be done when the
+            --  assignment has been analyzed because otherwise it will be
+            --  rejected (see Analyze_Assignment).
+
+            Set_Is_Safe_To_Reevaluate (Id);
+
+            Rewrite (Original_Bound, New_Occurrence_Of (Id, Loc));
+
+            if Nkind (Assign) = N_Assignment_Statement then
+               return Expression (Assign);
+            else
+               return Original_Bound;
+            end if;
+         end One_Bound;
+
+         Hi     : constant Node_Id := High_Bound (R);
+         Lo     : constant Node_Id := Low_Bound  (R);
+         R_Copy : constant Node_Id := New_Copy_Tree (R);
+         New_Hi : Node_Id;
+         New_Lo : Node_Id;
+         Typ    : Entity_Id;
+
+      --  Start of processing for Process_Bounds
+
+      begin
+         Set_Parent (R_Copy, Parent (R));
+         Preanalyze_Range (R_Copy);
+         Typ := Etype (R_Copy);
+
+         --  If the type of the discrete range is Universal_Integer, then the
+         --  bound's type must be resolved to Integer, and any object used to
+         --  hold the bound must also have type Integer, unless the literal
+         --  bounds are constant-folded expressions with a user-defined type.
+
+         if Typ = Universal_Integer then
+            if Nkind (Lo) = N_Integer_Literal
+              and then Present (Etype (Lo))
+              and then Scope (Etype (Lo)) /= Standard_Standard
+            then
+               Typ := Etype (Lo);
+
+            elsif Nkind (Hi) = N_Integer_Literal
+              and then Present (Etype (Hi))
+              and then Scope (Etype (Hi)) /= Standard_Standard
+            then
+               Typ := Etype (Hi);
+
+            else
+               Typ := Standard_Integer;
+            end if;
+         end if;
+
+         Set_Etype (R, Typ);
+
+         New_Lo := One_Bound (Lo, Low_Bound  (R_Copy), Typ);
+         New_Hi := One_Bound (Hi, High_Bound (R_Copy), Typ);
+
+         --  Propagate staticness to loop range itself, in case the
+         --  corresponding subtype is static.
+
+         if New_Lo /= Lo
+           and then Is_Static_Expression (New_Lo)
+         then
+            Rewrite (Low_Bound (R), New_Copy (New_Lo));
+         end if;
+
+         if New_Hi /= Hi
+           and then Is_Static_Expression (New_Hi)
+         then
+            Rewrite (High_Bound (R), New_Copy (New_Hi));
+         end if;
+      end Process_Bounds;
+
+      --  Local variables
+
+      DS : constant Node_Id   := Discrete_Subtype_Definition (N);
+      Id : constant Entity_Id := Defining_Identifier (N);
+
+      DS_Copy : Node_Id;
+
+   --  Start of processing for Analyze_Loop_Parameter_Specification
+
+   begin
+      Enter_Name (Id);
+
+      --  We always consider the loop variable to be referenced, since the loop
+      --  may be used just for counting purposes.
+
+      Generate_Reference (Id, N, ' ');
+
+      --  Check for the case of loop variable hiding a local variable (used
+      --  later on to give a nice warning if the hidden variable is never
+      --  assigned).
+
+      declare
+         H : constant Entity_Id := Homonym (Id);
+      begin
+         if Present (H)
+           and then Ekind (H) = E_Variable
+           and then Is_Discrete_Type (Etype (H))
+           and then Enclosing_Dynamic_Scope (H) = Enclosing_Dynamic_Scope (Id)
+         then
+            Set_Hiding_Loop_Variable (H, Id);
+         end if;
+      end;
+
+      --  Loop parameter specification must include subtype mark in SPARK
+
+      if Nkind (DS) = N_Range then
+         Check_SPARK_Restriction
+           ("loop parameter specification must include subtype mark", N);
+      end if;
+
+      --  Analyze the subtype definition and create temporaries for the bounds.
+      --  Do not evaluate the range when preanalyzing a quantified expression
+      --  because bounds expressed as function calls with side effects will be
+      --  erroneously replicated.
+
+      if Nkind (DS) = N_Range
+        and then Expander_Active
+        and then Nkind (Parent (N)) /= N_Quantified_Expression
+      then
+         Process_Bounds (DS);
+
+      --  Either the expander not active or the range of iteration is a subtype
+      --  indication, an entity, or a function call that yields an aggregate or
+      --  a container.
+
+      else
+         DS_Copy := New_Copy_Tree (DS);
+         Set_Parent (DS_Copy, Parent (DS));
+         Preanalyze_Range (DS_Copy);
+
+         --  Ada 2012: If the domain of iteration is a function call, it is the
+         --  new iterator form.
+
+         --  We have also implemented the shorter form : for X in S for Alfa
+         --  use. In this case, 'Old and 'Result must be treated as entity
+         --  names over which iterators are legal.
+
+         if Nkind (DS_Copy) = N_Function_Call
+           or else
+             (Alfa_Mode
+               and then (Nkind (DS_Copy) = N_Attribute_Reference
+               and then
+                 (Attribute_Name (DS_Copy) = Name_Result
+                   or else Attribute_Name (DS_Copy) = Name_Old)))
+           or else
+             (Is_Entity_Name (DS_Copy)
+               and then not Is_Type (Entity (DS_Copy)))
+         then
+            --  This is an iterator specification. Rewrite it as such and
+            --  analyze it to capture function calls that may require
+            --  finalization actions.
+
+            declare
+               I_Spec : constant Node_Id :=
+                          Make_Iterator_Specification (Sloc (N),
+                            Defining_Identifier => Relocate_Node (Id),
+                            Name                => DS_Copy,
+                            Subtype_Indication  => Empty,
+                            Reverse_Present     => Reverse_Present (N));
+               Scheme : constant Node_Id := Parent (N);
+
+            begin
+               Set_Iterator_Specification (Scheme, I_Spec);
+               Set_Loop_Parameter_Specification (Scheme, Empty);
+               Analyze_Iterator_Specification (I_Spec);
+
+               --  In a generic context, analyze the original domain of
+               --  iteration, for name capture.
+
+               if not Expander_Active then
+                  Analyze (DS);
+               end if;
+
+               --  Set kind of loop parameter, which may be used in the
+               --  subsequent analysis of the condition in a quantified
+               --  expression.
+
+               Set_Ekind (Id, E_Loop_Parameter);
+               return;
+            end;
+
+         --  Domain of iteration is not a function call, and is side-effect
+         --  free.
+
+         else
+            Analyze (DS);
+         end if;
+      end if;
+
+      if DS = Error then
+         return;
+      end if;
+
+      --  Some additional checks if we are iterating through a type
+
+      if Is_Entity_Name (DS)
+        and then Present (Entity (DS))
+        and then Is_Type (Entity (DS))
+      then
+         --  The subtype indication may denote the completion of an incomplete
+         --  type declaration.
+
+         if Ekind (Entity (DS)) = E_Incomplete_Type then
+            Set_Entity (DS, Get_Full_View (Entity (DS)));
+            Set_Etype  (DS, Entity (DS));
+         end if;
+
+         --  Attempt to iterate through non-static predicate
+
+         if Is_Discrete_Type (Entity (DS))
+           and then Present (Predicate_Function (Entity (DS)))
+           and then No (Static_Predicate (Entity (DS)))
+         then
+            Bad_Predicated_Subtype_Use
+              ("cannot use subtype& with non-static predicate for loop " &
+               "iteration", DS, Entity (DS));
+         end if;
+      end if;
+
+      --  Error if not discrete type
+
+      if not Is_Discrete_Type (Etype (DS)) then
+         Wrong_Type (DS, Any_Discrete);
+         Set_Etype (DS, Any_Type);
+      end if;
+
+      Check_Controlled_Array_Attribute (DS);
+
+      Make_Index (DS, N, In_Iter_Schm => True);
+      Set_Ekind (Id, E_Loop_Parameter);
+
+      --  A quantified expression which appears in a pre- or post-condition may
+      --  be analyzed multiple times. The analysis of the range creates several
+      --  itypes which reside in different scopes depending on whether the pre-
+      --  or post-condition has been expanded. Update the type of the loop
+      --  variable to reflect the proper itype at each stage of analysis.
+
+      if No (Etype (Id))
+        or else Etype (Id) = Any_Type
+        or else
+          (Present (Etype (Id))
+             and then Is_Itype (Etype (Id))
+             and then Nkind (Parent (Loop_Nod)) = N_Expression_With_Actions
+             and then Nkind (Original_Node (Parent (Loop_Nod))) =
+                        N_Quantified_Expression)
+      then
+         Set_Etype (Id, Etype (DS));
+      end if;
+
+      --  Treat a range as an implicit reference to the type, to inhibit
+      --  spurious warnings.
+
+      Generate_Reference (Base_Type (Etype (DS)), N, ' ');
+      Set_Is_Known_Valid (Id, True);
+
+      --  The loop is not a declarative part, so the only entity declared
+      --  "within" must be frozen explicitly.
+
+      declare
+         Flist : constant List_Id := Freeze_Entity (Id, N);
+      begin
+         if Is_Non_Empty_List (Flist) then
+            Insert_Actions (N, Flist);
+         end if;
+      end;
+
+      --  Check for null or possibly null range and issue warning. We suppress
+      --  such messages in generic templates and instances, because in practice
+      --  they tend to be dubious in these cases.
+
+      if Nkind (DS) = N_Range and then Comes_From_Source (N) then
+         declare
+            L : constant Node_Id := Low_Bound  (DS);
+            H : constant Node_Id := High_Bound (DS);
+
+         begin
+            --  If range of loop is null, issue warning
+
+            if Compile_Time_Compare (L, H, Assume_Valid => True) = GT then
+
+               --  Suppress the warning if inside a generic template or
+               --  instance, since in practice they tend to be dubious in these
+               --  cases since they can result from intended parametrization.
+
+               if not Inside_A_Generic
+                 and then not In_Instance
+               then
+                  --  Specialize msg if invalid values could make the loop
+                  --  non-null after all.
+
+                  if Compile_Time_Compare
+                       (L, H, Assume_Valid => False) = GT
+                  then
+                     Error_Msg_N
+                       ("?loop range is null, loop will not execute", DS);
+
+                     --  Since we know the range of the loop is null, set the
+                     --  appropriate flag to remove the loop entirely during
+                     --  expansion.
+
+                     Set_Is_Null_Loop (Loop_Nod);
+
+                  --  Here is where the loop could execute because of invalid
+                  --  values, so issue appropriate message and in this case we
+                  --  do not set the Is_Null_Loop flag since the loop may
+                  --  execute.
+
+                  else
+                     Error_Msg_N
+                       ("?loop range may be null, loop may not execute", DS);
+                     Error_Msg_N
+                       ("?can only execute if invalid values are present", DS);
+                  end if;
+               end if;
+
+               --  In either case, suppress warnings in the body of the loop,
+               --  since it is likely that these warnings will be inappropriate
+               --  if the loop never actually executes, which is likely.
+
+               Set_Suppress_Loop_Warnings (Loop_Nod);
+
+               --  The other case for a warning is a reverse loop where the
+               --  upper bound is the integer literal zero or one, and the
+               --  lower bound can be positive.
+
+               --  For example, we have
+
+               --     for J in reverse N .. 1 loop
+
+               --  In practice, this is very likely to be a case of reversing
+               --  the bounds incorrectly in the range.
+
+            elsif Reverse_Present (N)
+              and then Nkind (Original_Node (H)) = N_Integer_Literal
+              and then
+                (Intval (Original_Node (H)) = Uint_0
+                  or else Intval (Original_Node (H)) = Uint_1)
+            then
+               Error_Msg_N ("?loop range may be null", DS);
+               Error_Msg_N ("\?bounds may be wrong way round", DS);
+            end if;
+         end;
+      end if;
+   end Analyze_Loop_Parameter_Specification;
+
    ----------------------------
    -- Analyze_Loop_Statement --
    ----------------------------
@@ -2485,7 +2464,7 @@ package body Sem_Ch5 is
             begin
                Nam_Copy := New_Copy_Tree (Nam);
                Set_Parent (Nam_Copy, Parent (Nam));
-               Pre_Analyze_Range (Nam_Copy);
+               Preanalyze_Range (Nam_Copy);
 
                --  The only two options here are iteration over a container or
                --  an array.
@@ -2504,7 +2483,7 @@ package body Sem_Ch5 is
             begin
                DS_Copy := New_Copy_Tree (DS);
                Set_Parent (DS_Copy, Parent (DS));
-               Pre_Analyze_Range (DS_Copy);
+               Preanalyze_Range (DS_Copy);
 
                --  Check for a call to Iterate ()
 
@@ -2910,11 +2889,11 @@ package body Sem_Ch5 is
       end if;
    end Check_Unreachable_Code;
 
-   -----------------------
-   -- Pre_Analyze_Range --
-   -----------------------
+   ----------------------
+   -- Preanalyze_Range --
+   ----------------------
 
-   procedure Pre_Analyze_Range (R_Copy : Node_Id) is
+   procedure Preanalyze_Range (R_Copy : Node_Id) is
       Save_Analysis : constant Boolean := Full_Analysis;
 
    begin
@@ -2980,6 +2959,6 @@ package body Sem_Ch5 is
 
       Expander_Mode_Restore;
       Full_Analysis := Save_Analysis;
-   end Pre_Analyze_Range;
+   end Preanalyze_Range;
 
 end Sem_Ch5;
diff --git a/gcc/ada/sem_ch5.ads b/gcc/ada/sem_ch5.ads
index fdf09db32d5..86a92b76c5e 100644
--- a/gcc/ada/sem_ch5.ads
+++ b/gcc/ada/sem_ch5.ads
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -27,19 +27,20 @@ with Types; use Types;
 
 package Sem_Ch5 is
 
-   procedure Analyze_Assignment                 (N : Node_Id);
-   procedure Analyze_Block_Statement            (N : Node_Id);
-   procedure Analyze_Case_Statement             (N : Node_Id);
-   procedure Analyze_Exit_Statement             (N : Node_Id);
-   procedure Analyze_Goto_Statement             (N : Node_Id);
-   procedure Analyze_If_Statement               (N : Node_Id);
-   procedure Analyze_Implicit_Label_Declaration (N : Node_Id);
-   procedure Analyze_Iterator_Specification     (N : Node_Id);
-   procedure Analyze_Iteration_Scheme           (N : Node_Id);
-   procedure Analyze_Label                      (N : Node_Id);
-   procedure Analyze_Loop_Statement             (N : Node_Id);
-   procedure Analyze_Null_Statement             (N : Node_Id);
-   procedure Analyze_Statements                 (L : List_Id);
+   procedure Analyze_Assignment                   (N : Node_Id);
+   procedure Analyze_Block_Statement              (N : Node_Id);
+   procedure Analyze_Case_Statement               (N : Node_Id);
+   procedure Analyze_Exit_Statement               (N : Node_Id);
+   procedure Analyze_Goto_Statement               (N : Node_Id);
+   procedure Analyze_If_Statement                 (N : Node_Id);
+   procedure Analyze_Implicit_Label_Declaration   (N : Node_Id);
+   procedure Analyze_Iterator_Specification       (N : Node_Id);
+   procedure Analyze_Iteration_Scheme             (N : Node_Id);
+   procedure Analyze_Label                        (N : Node_Id);
+   procedure Analyze_Loop_Parameter_Specification (N : Node_Id);
+   procedure Analyze_Loop_Statement               (N : Node_Id);
+   procedure Analyze_Null_Statement               (N : Node_Id);
+   procedure Analyze_Statements                   (L : List_Id);
 
    procedure Analyze_Label_Entity (E : Entity_Id);
    --  This procedure performs direct analysis of the label entity E. It
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index f9259053389..4c7f2e47224 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -8702,7 +8702,9 @@ package body Sem_Ch6 is
                                 Discrete_Subtype_Definition (L2));
                   end;
 
-               else   --  quantified expression with an iterator
+               elsif Present (Iterator_Specification (E1))
+                 and then Present (Iterator_Specification (E2))
+               then
                   declare
                      I1 : constant Node_Id := Iterator_Specification (E1);
                      I2 : constant Node_Id := Iterator_Specification (E2);
@@ -8719,6 +8721,12 @@ package body Sem_Ch6 is
                        and then FCE (Subtype_Indication (I1),
                                       Subtype_Indication (I2));
                   end;
+
+               --  The quantified expressions used different specifications to
+               --  walk their respective ranges.
+
+               else
+                  return False;
                end if;
 
             when N_Range =>
diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb
index fc95bb8ed2d..ab08e77153b 100644
--- a/gcc/ada/sem_res.adb
+++ b/gcc/ada/sem_res.adb
@@ -193,7 +193,6 @@ package body Sem_Res is
    procedure Resolve_Op_Expon                  (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Op_Not                    (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Qualified_Expression      (N : Node_Id; Typ : Entity_Id);
-   procedure Resolve_Quantified_Expression     (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Range                     (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Real_Literal              (N : Node_Id; Typ : Entity_Id);
    procedure Resolve_Reference                 (N : Node_Id; Typ : Entity_Id);
@@ -1770,6 +1769,10 @@ package body Sem_Res is
       --  Try and fix up a literal so that it matches its expected type. New
       --  literals are manufactured if necessary to avoid cascaded errors.
 
+      function Proper_Current_Scope return Entity_Id;
+      --  Return the current scope. Skip loop scopes created for the purpose of
+      --  quantified expression analysis since those do not appear in the tree.
+
       procedure Report_Ambiguous_Argument;
       --  Additional diagnostics when an ambiguous call has an ambiguous
       --  argument (typically a controlling actual).
@@ -1832,6 +1835,30 @@ package body Sem_Res is
          end if;
       end Patch_Up_Value;
 
+      --------------------------
+      -- Proper_Current_Scope --
+      --------------------------
+
+      function Proper_Current_Scope return Entity_Id is
+         S : Entity_Id := Current_Scope;
+
+      begin
+         while Present (S) loop
+
+            --  Skip a loop scope created for quantified expression analysis
+
+            if Ekind (S) = E_Loop
+              and then Nkind (Parent (S)) = N_Quantified_Expression
+            then
+               S := Scope (S);
+            else
+               exit;
+            end if;
+         end loop;
+
+         return S;
+      end Proper_Current_Scope;
+
       -------------------------------
       -- Report_Ambiguous_Argument --
       -------------------------------
@@ -2761,8 +2788,7 @@ package body Sem_Res is
             when N_Qualified_Expression
                              => Resolve_Qualified_Expression     (N, Ctx_Type);
 
-            when N_Quantified_Expression
-                             => Resolve_Quantified_Expression    (N, Ctx_Type);
+            when N_Quantified_Expression => null;
 
             when N_Raise_xxx_Error
                              => Set_Etype (N, Ctx_Type);
@@ -2857,10 +2883,9 @@ package body Sem_Res is
          --  Ada 2012 (AI05-177): Expression functions do not freeze. Only
          --  their use (in an expanded call) freezes.
 
-         if Ekind (Current_Scope) /= E_Function
-           or else
-             Nkind (Original_Node (Unit_Declaration_Node (Current_Scope))) /=
-                                                        N_Expression_Function
+         if Ekind (Proper_Current_Scope) /= E_Function
+           or else Nkind (Original_Node (Unit_Declaration_Node
+                     (Proper_Current_Scope))) /= N_Expression_Function
          then
             Freeze_Expression (N);
          end if;
@@ -8290,31 +8315,6 @@ package body Sem_Res is
       Eval_Qualified_Expression (N);
    end Resolve_Qualified_Expression;
 
-   -----------------------------------
-   -- Resolve_Quantified_Expression --
-   -----------------------------------
-
-   procedure Resolve_Quantified_Expression (N : Node_Id; Typ : Entity_Id) is
-   begin
-      if not Alfa_Mode then
-
-         --  The loop structure is already resolved during its analysis, only
-         --  the resolution of the condition needs to be done. Expansion is
-         --  disabled so that checks and other generated code are inserted in
-         --  the tree after expression has been rewritten as a loop.
-
-         Expander_Mode_Save_And_Set (False);
-         Resolve (Condition (N), Typ);
-         Expander_Mode_Restore;
-
-      --  In Alfa mode, we need normal expansion in order to properly introduce
-      --  the necessary transient scopes.
-
-      else
-         Resolve (Condition (N), Typ);
-      end if;
-   end Resolve_Quantified_Expression;
-
    -------------------
    -- Resolve_Range --
    -------------------
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index e07d5bbb1fa..e7958058cd6 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -740,12 +740,28 @@ package body Sem_Util is
       N : Node_Id) return Entity_Id
    is
       Loc  : constant Source_Ptr := Sloc (N);
+      Bas  : Entity_Id;
+      --  The base type that is to be constrained by the defaults.
+
       Disc : Entity_Id;
 
    begin
       if not Has_Discriminants (T) or else Is_Constrained (T) then
          return T;
       end if;
+      Bas := Base_Type (T);
+
+      --  If T is non-private but its base type is private, this is
+      --  the completion of a subtype declaration whose parent type
+      --  is private (see Complete_Private_Subtype in sem_ch3). The
+      --  proper discriminants are to be found in the full view of
+      --  the base.
+
+      if Is_Private_Type (Bas)
+        and then Present (Full_View (Bas))
+      then
+         Bas := Full_View (Bas);
+      end if;
 
       Disc := First_Discriminant (T);
 
@@ -770,7 +786,7 @@ package body Sem_Util is
              Defining_Identifier => Act,
              Subtype_Indication =>
                Make_Subtype_Indication (Loc,
-                 Subtype_Mark => New_Occurrence_Of (T, Loc),
+                 Subtype_Mark => New_Occurrence_Of (Bas, Loc),
                  Constraint =>
                    Make_Index_Or_Discriminant_Constraint (Loc,
                      Constraints => Constraints)));