[multiple changes]

2010-10-22  Robert Dewar  <dewar@adacore.com>

	* sem_util.ads, sem_util.adb, sem_aux.ads, sem_aux.adb
	(Is_Generic_Formal): Moved from Sem_Util to Sem_Aux.

2010-10-22  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch5.adb (Expand_Iterator_Loop): New subprogram, implements new
	iterator forms over arrays and containers, in loops and quantified
	expressions.
	* exp_util.adb (Insert_Actions): include N_Iterator_Specification.
	* par-ch4.adb (P_Quantified_Expression): Handle iterator specifications.
	* par-ch5.adb (P_Iterator_Specification): New subprogram. Modify
	P_Iteration_Scheme to handle both loop forms.
	* sem.adb: Handle N_Iterator_Specification.
	* sem_ch5.adb, sem_ch5.ads (Analyze_Iterator_Specification): New
	subprogram.
	* sinfo.adb, sinfo.ads: New node N_Iterator_Specification.
	N_Iteration_Scheme can now include an Iterator_Specification. Ditto
	for N_Quantified_Expression.
	* snames.ads-tmpl: Add names Cursor, Element, Element_Type, No_Element,
	and Previous, to support iterators over predefined containers.
	* sprint.adb: Handle N_Iterator_Specification.

From-SVN: r165811

gcc/ada/ChangeLog

+2010-10-22  Robert Dewar  <dewar@adacore.com>
+
+	* sem_util.ads, sem_util.adb, sem_aux.ads, sem_aux.adb
+	(Is_Generic_Formal): Moved from Sem_Util to Sem_Aux.
+
+2010-10-22  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_ch5.adb (Expand_Iterator_Loop): New subprogram, implements new
+	iterator forms over arrays and containers, in loops and quantified
+	expressions.
+	* exp_util.adb (Insert_Actions): include N_Iterator_Specification.
+	* par-ch4.adb (P_Quantified_Expression): Handle iterator specifications.
+	* par-ch5.adb (P_Iterator_Specification): New subprogram. Modify
+	P_Iteration_Scheme to handle both loop forms.
+	* sem.adb: Handle N_Iterator_Specification.
+	* sem_ch5.adb, sem_ch5.ads (Analyze_Iterator_Specification): New
+	subprogram.
+	* sinfo.adb, sinfo.ads: New node N_Iterator_Specification.
+	N_Iteration_Scheme can now include an Iterator_Specification. Ditto
+	for N_Quantified_Expression.
+	* snames.ads-tmpl: Add names Cursor, Element, Element_Type, No_Element,
+	and Previous, to support iterators over predefined containers.
+	* sprint.adb: Handle N_Iterator_Specification.
+
 2010-10-22  Thomas Quinot  <quinot@adacore.com>
 
 	* sem_prag.adb, sem_ch12.adb, sem_util.adb, sem_util.ads

gcc/ada/exp_ch5.adb

@@ -103,6 +103,10 @@ package body Exp_Ch5 is
    --  clause (this last case is required because holes in the tagged type
    --  might be filled with components from child types).
 
+   procedure Expand_Iterator_Loop (N : Node_Id);
+   --  Expand loops over arrays and containers that use the form "for X of C"
+   --  with an optional subtype mark, and "for Y in C".
+
    function Make_Tag_Ctrl_Assignment (N : Node_Id) return List_Id;
    --  Generate the necessary code for controlled and tagged assignment, that
    --  is to say, finalization of the target before, adjustment of the target
@@ -2747,6 +2751,201 @@ package body Exp_Ch5 is
       end if;
    end Expand_N_If_Statement;
 
+   --------------------------
+   -- Expand_Iterator_Loop --
+   --------------------------
+
+   procedure Expand_Iterator_Loop (N : Node_Id) is
+      Loc        : constant Source_Ptr := Sloc (N);
+      Isc        : constant Node_Id    := Iteration_Scheme (N);
+      I_Spec     : constant Node_Id    := Iterator_Specification (Isc);
+      Id         : constant Entity_Id  := Defining_Identifier (I_Spec);
+      Container  : constant Entity_Id :=  Entity (Name (I_Spec));
+
+      Typ        : constant Entity_Id := Etype (Container);
+
+      Cursor     : Entity_Id;
+      New_Loop   : Node_Id;
+      Stats      : List_Id;
+
+   begin
+      if Is_Array_Type (Typ) then
+         if Of_Present (I_Spec) then
+            Cursor := Make_Temporary (Loc, 'C');
+
+            --  For Elem of Arr loop ..
+
+            declare
+               Decl : constant Node_Id :=
+                        Make_Object_Renaming_Declaration (Loc,
+                          Defining_Identifier => Id,
+                          Subtype_Mark =>
+                            New_Occurrence_Of (Component_Type (Typ), Loc),
+                          Name => Make_Indexed_Component (Loc,
+                            Prefix => New_Occurrence_Of (Container, Loc),
+                            Expressions =>
+                              New_List (New_Occurrence_Of (Cursor, Loc))));
+            begin
+               Stats := Statements (N);
+               Prepend (Decl, Stats);
+
+               New_Loop := Make_Loop_Statement (Loc,
+                 Iteration_Scheme =>
+                   Make_Iteration_Scheme (Loc,
+                     Loop_Parameter_Specification =>
+                       Make_Loop_Parameter_Specification (Loc,
+                         Defining_Identifier => Cursor,
+                         Discrete_Subtype_Definition =>
+                            Make_Attribute_Reference (Loc,
+                              Prefix => New_Occurrence_Of (Container, Loc),
+                              Attribute_Name => Name_Range),
+                         Reverse_Present => Reverse_Present (I_Spec))),
+                 Statements => Stats,
+                 End_Label => Empty);
+            end;
+
+         else
+
+            --  For Index in Array loop
+            --
+            --  The cursor (index into the array) is the source Id.
+
+            Cursor := Id;
+            New_Loop := Make_Loop_Statement (Loc,
+              Iteration_Scheme =>
+                Make_Iteration_Scheme (Loc,
+                  Loop_Parameter_Specification =>
+                    Make_Loop_Parameter_Specification (Loc,
+                      Defining_Identifier => Cursor,
+                      Discrete_Subtype_Definition =>
+                         Make_Attribute_Reference (Loc,
+                           Prefix => New_Occurrence_Of (Container, Loc),
+                           Attribute_Name => Name_Range),
+                      Reverse_Present => Reverse_Present (I_Spec))),
+              Statements => Statements (N),
+              End_Label => Empty);
+         end if;
+
+      else
+
+         --  Iterators over containers. In both cases these require a
+         --  cursor of the proper type.
+
+         --  Cursor : P.Cursor_Type := Container.First;
+         --  while Cursor /= P.No_Element loop
+
+         --     --  for the "of" form, the element name renames
+         --     --  the element denoted by the cursor.
+
+         --     Obj : P.Element_Type renames Element (Cursor);
+         --     Statements;
+         --     P.Next (Cursor);
+         --  end loop;
+         --
+         --  with the obvious replacements if "reverse" is specified.
+
+         declare
+            Element_Type  : constant Entity_Id := Etype (Id);
+            Pack          : constant Entity_Id := Scope (Etype (Container));
+
+            Name_Init     : Name_Id;
+            Name_Step     : Name_Id;
+
+            Cond          : Node_Id;
+            Cursor_Decl   : Node_Id;
+            Renaming_Decl : Node_Id;
+
+         begin
+            Stats := Statements (N);
+
+            if Of_Present (I_Spec) then
+               Cursor := Make_Temporary (Loc, 'C');
+
+            else
+               Cursor := Id;
+            end if;
+
+            if Reverse_Present (I_Spec) then
+
+               --  Must verify that the container has a reverse iterator ???
+
+               Name_Init := Name_Last;
+               Name_Step := Name_Previous;
+
+            else
+               Name_Init := Name_First;
+               Name_Step := Name_Next;
+            end if;
+
+            --  C : Cursor_Type := Container.First;
+
+            Cursor_Decl := Make_Object_Declaration (Loc,
+              Defining_Identifier => Cursor,
+              Object_Definition =>
+                Make_Selected_Component (Loc,
+                  Prefix => New_Occurrence_Of (Pack, Loc),
+                  Selector_Name =>
+                    Make_Identifier (Loc, Name_Cursor)),
+              Expression =>
+                Make_Selected_Component (Loc,
+                  Prefix => New_Occurrence_Of (Container, Loc),
+                  Selector_Name => Make_Identifier (Loc, Name_Init)));
+
+            Insert_Action (N, Cursor_Decl);
+
+            --  while C /= No_Element loop
+
+            Cond := Make_Op_Ne (Loc,
+              Left_Opnd => New_Occurrence_Of (Cursor, Loc),
+              Right_Opnd => Make_Selected_Component (Loc,
+                 Prefix => New_Occurrence_Of (Pack, Loc),
+                 Selector_Name => Make_Identifier (Loc,
+                   Chars => Name_No_Element)));
+
+            if Of_Present (I_Spec) then
+
+               --  Id : Element_Type renames Pack.Element (Cursor);
+
+               Renaming_Decl :=
+                 Make_Object_Renaming_Declaration (Loc,
+                   Defining_Identifier => Id,
+                   Subtype_Mark => New_Occurrence_Of (Element_Type, Loc),
+                   Name => Make_Indexed_Component (Loc,
+                     Prefix =>
+                     Make_Selected_Component (Loc,
+                       Prefix =>  New_Occurrence_Of (Pack, Loc),
+                       Selector_Name =>
+                         Make_Identifier (Loc, Chars => Name_Element)),
+                     Expressions =>
+                       New_List (New_Occurrence_Of (Cursor, Loc))));
+
+               Prepend (Renaming_Decl, Stats);
+            end if;
+
+            --  For both iterator forms, add call to Next to advance cursor.
+
+            Append_To (Stats,
+              Make_Procedure_Call_Statement (Loc,
+                Name => Make_Selected_Component (Loc,
+                  Prefix => New_Occurrence_Of (Pack, Loc),
+                  Selector_Name => Make_Identifier (Loc, Name_Step)),
+                Parameter_Associations =>
+                  New_List (New_Occurrence_Of (Cursor, Loc))));
+
+            New_Loop := Make_Loop_Statement (Loc,
+              Iteration_Scheme =>
+                Make_Iteration_Scheme (Loc,
+                  Condition => Cond),
+              Statements => Stats,
+              End_Label => Empty);
+         end;
+      end if;
+
+      --  Set_Analyzed (I_Spec);
+      Rewrite (N, New_Loop);
+      Analyze (N);
+   end Expand_Iterator_Loop;
+
    -----------------------------
    -- Expand_N_Loop_Statement --
    -----------------------------
@@ -2755,7 +2954,8 @@ package body Exp_Ch5 is
    --  2. Deal with while condition for C/Fortran boolean
    --  3. Deal with loops with a non-standard enumeration type range
    --  4. Deal with while loops where Condition_Actions is set
-   --  5. Insert polling call if required
+   --  5. Deal with loops with iterators over arrays and containers
+   --  6. Insert polling call if required
 
    procedure Expand_N_Loop_Statement (N : Node_Id) is
       Loc  : constant Source_Ptr := Sloc (N);
@@ -2955,6 +3155,11 @@ package body Exp_Ch5 is
 
             Analyze (N);
          end;
+
+      elsif Present (Isc)
+        and then Present (Iterator_Specification (Isc))
+      then
+         Expand_Iterator_Loop (N);
       end if;
    end Expand_N_Loop_Statement;
 

gcc/ada/exp_util.adb

@@ -2828,6 +2828,7 @@ package body Exp_Util is
                N_Index_Or_Discriminant_Constraint       |
                N_Indexed_Component                      |
                N_Integer_Literal                        |
+               N_Iterator_Specification                 |
                N_Itype_Reference                        |
                N_Label                                  |
                N_Loop_Parameter_Specification           |

gcc/ada/par-ch4.adb

@@ -2514,7 +2514,8 @@ package body Ch4 is
    --    for QUANTIFIER ITERATOR_SPECIFICATION => PREDICATE
 
    function P_Quantified_Expression return Node_Id is
-      Node1 : Node_Id;
+      I_Spec : Node_Id;
+      Node1  : Node_Id;
 
    begin
       Scan;  --  past FOR
@@ -2536,7 +2537,13 @@ package body Ch4 is
       end if;
 
       Scan;
-      Set_Loop_Parameter_Specification (Node1, P_Loop_Parameter_Specification);
+      I_Spec := P_Loop_Parameter_Specification;
+
+      if Nkind (I_Spec) = N_Loop_Parameter_Specification then
+         Set_Loop_Parameter_Specification (Node1, I_Spec);
+      else
+         Set_Iterator_Specification (Node1, I_Spec);
+      end if;
 
       if Token = Tok_Arrow then
          Scan;

gcc/ada/par-ch5.adb

@@ -60,6 +60,11 @@ package body Ch5 is
    --  the N_Identifier node for the label on the loop. If Loop_Name is
    --  Empty on entry (the default), then the for statement is unlabeled.
 
+   function P_Iterator_Specification (Def_Id : Node_Id) return Node_Id;
+   --  Parse an iterator specification. The defining identifier has already
+   --  been scanned, as it is the common prefix between loop and iterator
+   --  specification.
+
    function P_Loop_Statement (Loop_Name : Node_Id := Empty) return Node_Id;
    --  Parse loop statement. If Loop_Name is non-Empty on entry, it is
    --  the N_Identifier node for the label on the loop. If Loop_Name is
@@ -1552,6 +1557,7 @@ package body Ch5 is
       Iter_Scheme_Node : Node_Id;
       Loop_For_Flag    : Boolean;
       Created_Name     : Node_Id;
+      Spec             : Node_Id;
 
    begin
       Push_Scope_Stack;
@@ -1563,8 +1569,13 @@ package body Ch5 is
       Loop_For_Flag := (Prev_Token = Tok_Loop);
       Scan; -- past FOR
       Iter_Scheme_Node := New_Node (N_Iteration_Scheme, Token_Ptr);
-      Set_Loop_Parameter_Specification
-         (Iter_Scheme_Node, P_Loop_Parameter_Specification);
+      Spec := P_Loop_Parameter_Specification;
+      if Nkind (Spec) = N_Loop_Parameter_Specification then
+         Set_Loop_Parameter_Specification
+           (Iter_Scheme_Node, Spec);
+      else
+         Set_Iterator_Specification (Iter_Scheme_Node, Spec);
+      end if;
 
       --  The following is a special test so that a miswritten for loop such
       --  as "loop for I in 1..10;" is handled nicely, without making an extra
@@ -1686,11 +1697,27 @@ package body Ch5 is
       Scan_State : Saved_Scan_State;
 
    begin
-      Loop_Param_Specification_Node :=
-        New_Node (N_Loop_Parameter_Specification, Token_Ptr);
 
       Save_Scan_State (Scan_State);
       ID_Node := P_Defining_Identifier (C_In);
+
+      --  If the next token is OF it indicates the Ada2012 iterator. If the
+      --  next token is a colon, the iterator includes a subtype indication
+      --  for the bound variable of the iteration. Otherwise we parse the
+      --  construct as a loop parameter specification. Note that the form:
+      --  "for A in B" is ambiguous, and must be resolved semantically: if B
+      --  is a discrete subtype this is a loop specification, but if it is an
+      --  expression it is an iterator specification. Ambiguity is resolved
+      --  during analysis of the loop parameter specification.
+
+      if Token = Tok_Of
+        or else Token = Tok_Colon
+      then
+         return P_Iterator_Specification (ID_Node);
+      end if;
+
+      Loop_Param_Specification_Node :=
+        New_Node (N_Loop_Parameter_Specification, Token_Ptr);
       Set_Defining_Identifier (Loop_Param_Specification_Node, ID_Node);
 
       if Token = Tok_Left_Paren then
@@ -1720,6 +1747,40 @@ package body Ch5 is
          return Error;
    end P_Loop_Parameter_Specification;
 
+   ----------------------------------
+   -- 5.5.1 Iterator_Specification --
+   ----------------------------------
+
+   function P_Iterator_Specification (Def_Id : Node_Id) return Node_Id is
+      Node1 : Node_Id;
+   begin
+      Node1 :=  New_Node (N_Iterator_Specification, Token_Ptr);
+      Set_Defining_Identifier (Node1, Def_Id);
+
+      if Token = Tok_Colon then
+         Scan;  --  past :
+         Set_Subtype_Indication (Node1, P_Subtype_Indication);
+      end if;
+
+      if Token = Tok_Of then
+         Set_Of_Present (Node1);
+         Scan;  --  past OF
+      elsif Token = Tok_In then
+         Scan;  --  past IN
+      else
+         return Error;
+      end if;
+
+      if Token = Tok_Reverse then
+         Scan; -- past REVERSE
+         Set_Reverse_Present (Node1, True);
+      end if;
+
+      Set_Name (Node1, P_Name);
+
+      return Node1;
+   end P_Iterator_Specification;
+
    --------------------------
    -- 5.6  Block Statement --
    --------------------------

gcc/ada/sem.adb

@@ -302,6 +302,9 @@ package body Sem is
          when N_Integer_Literal =>
             Analyze_Integer_Literal (N);
 
+         when N_Iterator_Specification =>
+            Analyze_Iterator_Specification (N);
+
          when N_Itype_Reference =>
             Analyze_Itype_Reference (N);
 

gcc/ada/sem_aux.adb

@@ -537,6 +537,25 @@ package body Sem_Aux is
       end if;
    end Is_Derived_Type;
 
+   -----------------------
+   -- Is_Generic_Formal --
+   -----------------------
+
+   function Is_Generic_Formal (E : Entity_Id) return Boolean is
+      Kind : Node_Kind;
+   begin
+      if No (E) then
+         return False;
+      else
+         Kind := Nkind (Parent (E));
+         return
+           Nkind_In (Kind, N_Formal_Object_Declaration,
+                           N_Formal_Package_Declaration,
+                           N_Formal_Type_Declaration)
+             or else Is_Formal_Subprogram (E);
+      end if;
+   end Is_Generic_Formal;
+
    ---------------------------
    -- Is_Indefinite_Subtype --
    ---------------------------

gcc/ada/sem_aux.ads

@@ -159,6 +159,11 @@ package Sem_Aux is
    --  Determines if the given entity Ent is a derived type. Result is always
    --  false if argument is not a type.
 
+   function Is_Generic_Formal (E : Entity_Id) return Boolean;
+   --  Determine whether E is a generic formal parameter. In particular this is
+   --  used to set the visibility of generic formals of a generic package
+   --  declared with a box or with partial parametrization.
+
    function Is_Indefinite_Subtype (Ent : Entity_Id) return Boolean;
    --  Ent is any entity. Determines if given entity is an unconstrained array
    --  type or subtype, a discriminated record type or subtype with no initial

gcc/ada/sem_ch5.adb

@@ -1734,6 +1734,10 @@ package body Sem_Ch5 is
    --  Start of processing for Analyze_Iteration_Scheme
 
    begin
+      if Analyzed (N) then
+         return;
+      end if;
+
       --  For an infinite loop, there is no iteration scheme
 
       if No (N) then
@@ -1753,6 +1757,9 @@ package body Sem_Ch5 is
                Set_Current_Value_Condition (N);
                return;
 
+            elsif Present (Iterator_Specification (N)) then
+               Analyze_Iterator_Specification (Iterator_Specification (N));
+
             --  Else we have a FOR loop
 
             else
@@ -1795,6 +1802,31 @@ package body Sem_Ch5 is
                      Process_Bounds (DS);
                   else
                      Analyze (DS);
+
+                     if Nkind (DS) = N_Function_Call
+                       or else
+                         (Is_Entity_Name (DS)
+                            and then not Is_Type (Entity (DS)))
+                     then
+
+                        --  this is an iterator specification. Rewrite as
+                        --  such and analyze.
+
+                        declare
+                           I_Spec : constant Node_Id :=
+                             Make_Iterator_Specification (Sloc (LP),
+                               Defining_Identifier => Relocate_Node (Id),
+                               Name => Relocate_Node (DS),
+                               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);
+                           return;
+                        end;
+                     end if;
                   end if;
 
                   if DS = Error then
@@ -1938,6 +1970,73 @@ package body Sem_Ch5 is
       end if;
    end Analyze_Iteration_Scheme;
 
+   -------------------------------------
+   --  Analyze_Iterator_Specification --
+   -------------------------------------
+
+   procedure Analyze_Iterator_Specification (N : Node_Id) is
+      Def_Id    : constant Node_Id := Defining_Identifier (N);
+      Subt      : constant Node_Id := Subtype_Indication (N);
+      Container : constant Node_Id := Name (N);
+
+      Ent       : Entity_Id;
+      Typ       : Entity_Id;
+
+   begin
+      Enter_Name (Def_Id);
+      Set_Ekind (Def_Id, E_Variable);
+
+      if Present (Subt) then
+         Analyze (Subt);
+      end if;
+
+      Analyze_And_Resolve (Container);
+      Typ := Etype (Container);
+
+      if Is_Array_Type (Typ) then
+         if Of_Present (N) then
+            Set_Etype (Def_Id, Component_Type (Typ));
+
+         else
+            Set_Etype (Def_Id, Etype (First_Index (Typ)));
+         end if;
+
+      else
+         --  Iteration over a container.
+
+         Set_Ekind (Def_Id, E_Loop_Parameter);
+         if Of_Present (N) then
+
+            --  Find the Element_Type in the package instance that defines
+            --  the container type.
+
+            Ent := First_Entity (Scope (Typ));
+            while Present (Ent) loop
+               if Chars (Ent) = Name_Element_Type then
+                  Set_Etype (Def_Id, Ent);
+                  exit;
+               end if;
+
+               Next_Entity (Ent);
+            end loop;
+
+         else
+
+            --  Find the Cursor type in similar fashion.
+
+            Ent := First_Entity (Scope (Typ));
+            while Present (Ent) loop
+               if Chars (Ent) = Name_Cursor then
+                  Set_Etype (Def_Id, Ent);
+                  exit;
+               end if;
+
+               Next_Entity (Ent);
+            end loop;
+         end if;
+      end if;
+   end Analyze_Iterator_Specification;
+
    -------------------
    -- Analyze_Label --
    -------------------

gcc/ada/sem_ch5.ads

@@ -34,6 +34,7 @@ package Sem_Ch5 is
    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);

gcc/ada/sem_util.adb

@@ -6559,25 +6559,6 @@ package body Sem_Util is
       end if;
    end Is_Fully_Initialized_Variant;
 
-   -----------------------
-   -- Is_Generic_Formal --
-   -----------------------
-
-   function Is_Generic_Formal (E : Entity_Id) return Boolean is
-      Kind : Node_Kind;
-   begin
-      if No (E) then
-         return False;
-      else
-         Kind := Nkind (Parent (E));
-         return
-           Nkind_In (Kind, N_Formal_Object_Declaration,
-                           N_Formal_Package_Declaration,
-                           N_Formal_Type_Declaration)
-             or else Is_Formal_Subprogram (E);
-      end if;
-   end Is_Generic_Formal;
-
    ------------
    -- Is_LHS --
    ------------

gcc/ada/sem_util.ads

@@ -733,11 +733,6 @@ package Sem_Util is
    --  means that the result returned is not crucial, but should err on the
    --  side of thinking things are fully initialized if it does not know.
 
-   function Is_Generic_Formal (E : Entity_Id) return Boolean;
-   --  Determine whether E is a generic formal parameter. In particular this is
-   --  used to set the visibility of generic formals of a generic package
-   --  declared with a box or with partial parametrization.
-
    function Is_Inherited_Operation (E : Entity_Id) return Boolean;
    --  E is a subprogram. Return True is E is an implicit operation inherited
    --  by a derived type declarations.

gcc/ada/sinfo.adb

@@ -744,6 +744,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Full_Type_Declaration
         or else NT (N).Nkind = N_Implicit_Label_Declaration
         or else NT (N).Nkind = N_Incomplete_Type_Declaration
+        or else NT (N).Nkind = N_Iterator_Specification
         or else NT (N).Nkind = N_Loop_Parameter_Specification
         or else NT (N).Nkind = N_Number_Declaration
         or else NT (N).Nkind = N_Object_Declaration
@@ -1866,6 +1867,15 @@ package body Sinfo is
       return Node2 (N);
    end Iteration_Scheme;
 
+   function Iterator_Specification
+     (N : Node_Id) return Node_Id is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Iteration_Scheme
+        or else NT (N).Nkind = N_Quantified_Expression);
+      return Node2 (N);
+   end Iterator_Specification;
+
    function Itype
       (N : Node_Id) return Node_Id is
    begin
@@ -2086,6 +2096,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Generic_Package_Renaming_Declaration
         or else NT (N).Nkind = N_Generic_Procedure_Renaming_Declaration
         or else NT (N).Nkind = N_Goto_Statement
+        or else NT (N).Nkind = N_Iterator_Specification
         or else NT (N).Nkind = N_Object_Renaming_Declaration
         or else NT (N).Nkind = N_Package_Instantiation
         or else NT (N).Nkind = N_Package_Renaming_Declaration
@@ -2270,6 +2281,14 @@ package body Sinfo is
       return Node4 (N);
    end Object_Definition;
 
+   function Of_Present
+      (N : Node_Id) return Boolean is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Iterator_Specification);
+      return Flag16 (N);
+   end Of_Present;
+
    function Original_Discriminant
       (N : Node_Id) return Node_Id is
    begin
@@ -2630,6 +2649,7 @@ package body Sinfo is
       (N : Node_Id) return Boolean is
    begin
       pragma Assert (False
+        or else NT (N).Nkind = N_Iterator_Specification
         or else NT (N).Nkind = N_Loop_Parameter_Specification);
       return Flag15 (N);
    end Reverse_Present;
@@ -2825,6 +2845,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Access_To_Object_Definition
         or else NT (N).Nkind = N_Component_Definition
         or else NT (N).Nkind = N_Derived_Type_Definition
+        or else NT (N).Nkind = N_Iterator_Specification
         or else NT (N).Nkind = N_Private_Extension_Declaration
         or else NT (N).Nkind = N_Subtype_Declaration);
       return Node5 (N);
@@ -3742,6 +3763,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Full_Type_Declaration
         or else NT (N).Nkind = N_Implicit_Label_Declaration
         or else NT (N).Nkind = N_Incomplete_Type_Declaration
+        or else NT (N).Nkind = N_Iterator_Specification
         or else NT (N).Nkind = N_Loop_Parameter_Specification
         or else NT (N).Nkind = N_Number_Declaration
         or else NT (N).Nkind = N_Object_Declaration
@@ -4856,6 +4878,15 @@ package body Sinfo is
       Set_Node2_With_Parent (N, Val);
    end Set_Iteration_Scheme;
 
+   procedure Set_Iterator_Specification
+     (N : Node_Id; Val : Node_Id) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Iteration_Scheme
+        or else NT (N).Nkind = N_Quantified_Expression);
+      Set_Node2_With_Parent (N, Val);
+   end Set_Iterator_Specification;
+
    procedure Set_Itype
       (N : Node_Id; Val : Entity_Id) is
    begin
@@ -5076,6 +5107,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Generic_Package_Renaming_Declaration
         or else NT (N).Nkind = N_Generic_Procedure_Renaming_Declaration
         or else NT (N).Nkind = N_Goto_Statement
+        or else NT (N).Nkind = N_Iterator_Specification
         or else NT (N).Nkind = N_Object_Renaming_Declaration
         or else NT (N).Nkind = N_Package_Instantiation
         or else NT (N).Nkind = N_Package_Renaming_Declaration
@@ -5260,6 +5292,14 @@ package body Sinfo is
       Set_Node4_With_Parent (N, Val);
    end Set_Object_Definition;
 
+   procedure Set_Of_Present
+      (N : Node_Id; Val : Boolean := True) is
+   begin
+      pragma Assert (False
+        or else NT (N).Nkind = N_Iterator_Specification);
+      Set_Flag16 (N, Val);
+   end Set_Of_Present;
+
    procedure Set_Original_Discriminant
       (N : Node_Id; Val : Node_Id) is
    begin
@@ -5620,6 +5660,7 @@ package body Sinfo is
       (N : Node_Id; Val : Boolean := True) is
    begin
       pragma Assert (False
+        or else NT (N).Nkind = N_Iterator_Specification
         or else NT (N).Nkind = N_Loop_Parameter_Specification);
       Set_Flag15 (N, Val);
    end Set_Reverse_Present;
@@ -5815,6 +5856,7 @@ package body Sinfo is
         or else NT (N).Nkind = N_Access_To_Object_Definition
         or else NT (N).Nkind = N_Component_Definition
         or else NT (N).Nkind = N_Derived_Type_Definition
+        or else NT (N).Nkind = N_Iterator_Specification
         or else NT (N).Nkind = N_Private_Extension_Declaration
         or else NT (N).Nkind = N_Subtype_Declaration);
       Set_Node5_With_Parent (N, Val);

gcc/ada/sinfo.ads

@@ -1544,6 +1544,10 @@ package Sinfo is
    --    is used for properly setting out of range values for use by pragmas
    --    Initialize_Scalars and Normalize_Scalars.
 
+   --  Of_Present (Flag16)
+   --  Present in N_Iterastor_Specification nodes, to mark the Ada2012 iterator
+   --  form over arrays and containers.
+
    --  Original_Discriminant (Node2-Sem)
    --    Present in identifiers. Used in references to discriminants that
    --    appear in generic units. Because the names of the discriminants may be
@@ -3829,6 +3833,7 @@ package Sinfo is
 
       --  N_Quantified_Expression
       --  Sloc points to FOR
+      --  Iterator_Specification (Node2) (set to Empty if not Present)
       --  Loop_Parameter_Specification (Node4)
       --  Condition (Node1)
       --  All_Present (Flag15)
@@ -4164,7 +4169,11 @@ package Sinfo is
       --------------------------
 
       --  ITERATION_SCHEME ::=
-      --    while CONDITION | for LOOP_PARAMETER_SPECIFICATION
+      --    while CONDITION | for LOOP_PARAMETER_SPECIFICATION |
+      --    for ITERATOR_SPECIFICATION
+
+      --  Only one of (Iterator_Specification, Loop_Parameter_Specification)
+      --  is present at a time, the other one is empty.
 
       --  Gigi restriction: This expander ensures that the type of the
       --  Condition field is always Standard.Boolean, even if the type
@@ -4174,6 +4183,7 @@ package Sinfo is
       --  Sloc points to WHILE or FOR
       --  Condition (Node1) (set to Empty if FOR case)
       --  Condition_Actions (List3-Sem)
+      --  Iterator_Specification (Node2) (set to Empty if not Present)
       --  Loop_Parameter_Specification (Node4) (set to Empty if WHILE case)
 
       ---------------------------------------
@@ -4189,6 +4199,22 @@ package Sinfo is
       --  Reverse_Present (Flag15)
       --  Discrete_Subtype_Definition (Node4)
 
+      ----------------------------------
+      -- 5.5.1 Iterator specification --
+      ----------------------------------
+
+      --  ITERATOR_SPECIFICATION ::=
+      --    DEFINING_IDENTIFIER in [reverse] NAME
+      --    DEFINING_IDENTIFIER [: SUBTYPE_INDICATION] of [reverse] NAME
+
+      --  N_Iterator_Specification
+      --  Sloc points to defining identifier
+      --  Defining_Identifier (Node1)
+      --  Name (Node2)
+      --  Reverse_Present (Flag15)
+      --  Of_Present (Flag16)
+      --  Subtype_Indication (Node5)
+
       --------------------------
       -- 5.6  Block Statement --
       --------------------------
@@ -7500,6 +7526,7 @@ package Sinfo is
       N_Formal_Type_Declaration,
       N_Full_Type_Declaration,
       N_Incomplete_Type_Declaration,
+      N_Iterator_Specification,
       N_Loop_Parameter_Specification,
       N_Object_Declaration,
       N_Parameterized_Expression,
@@ -8492,6 +8519,9 @@ package Sinfo is
    function Iteration_Scheme
      (N : Node_Id) return Node_Id;    -- Node2
 
+   function Iterator_Specification
+     (N : Node_Id) return Node_Id;    -- Node2
+
    function Itype
      (N : Node_Id) return Entity_Id;  -- Node1
 
@@ -8612,6 +8642,9 @@ package Sinfo is
    function Object_Definition
      (N : Node_Id) return Node_Id;    -- Node4
 
+   function Of_Present
+     (N : Node_Id) return Boolean;    -- Flag16
+
    function Original_Discriminant
      (N : Node_Id) return Node_Id;    -- Node2
 
@@ -9446,6 +9479,9 @@ package Sinfo is
    procedure Set_Iteration_Scheme
      (N : Node_Id; Val : Node_Id);            -- Node2
 
+   procedure Set_Iterator_Specification
+     (N : Node_Id; Val : Node_Id);            -- Node2
+
    procedure Set_Itype
      (N : Node_Id; Val : Entity_Id);          -- Node1
 
@@ -9566,6 +9602,9 @@ package Sinfo is
    procedure Set_Object_Definition
      (N : Node_Id; Val : Node_Id);            -- Node4
 
+   procedure Set_Of_Present
+     (N : Node_Id; Val : Boolean := True);   -- Flag16
+
    procedure Set_Original_Discriminant
      (N : Node_Id; Val : Node_Id);            -- Node2
 
@@ -10492,7 +10531,7 @@ package Sinfo is
 
      N_Quantified_Expression =>
        (1 => True,    --  Condition (Node1)
-        2 => False,   --  unused
+        2 => True,    --  Iterator_Specification
         3 => False,   --  unused
         4 => True,    --  Loop_Parameter_Specification (Node4)
         5 => False),  --  Etype (Node5-Sem)
@@ -10576,7 +10615,7 @@ package Sinfo is
 
      N_Iteration_Scheme =>
        (1 => True,    --  Condition (Node1)
-        2 => False,   --  unused
+        2 => True,    --  Iterator_Specification (Node2)
         3 => False,   --  Condition_Actions (List3-Sem)
         4 => True,    --  Loop_Parameter_Specification (Node4)
         5 => False),  --  unused
@@ -10588,6 +10627,13 @@ package Sinfo is
         4 => True,    --  Discrete_Subtype_Definition (Node4)
         5 => False),  --  unused
 
+     N_Iterator_Specification =>
+       (1 => True,    --  Defining_Identifier (Node1)
+        2 => True,    --  Name (Node2)
+        3 => False,   --  Unused
+        4 => False,   --  Unused
+        5 => True),   --  Subtype_Indication (Node5)
+
      N_Block_Statement =>
        (1 => True,    --  Identifier (Node1)
         2 => True,    --  Declarations (List2)

gcc/ada/snames.ads-tmpl

@@ -1198,6 +1198,14 @@ package Snames is
 
    Name_Unaligned_Valid                  : constant Name_Id := N + $;
 
+   --  Names used to implement iterators over predefined  containers.
+
+   Name_Cursor                           : constant Name_Id := N + $;
+   Name_Element                          : constant Name_Id := N + $;
+   Name_Element_Type                     : constant Name_Id := N + $;
+   Name_No_Element                       : constant Name_Id := N + $;
+   Name_Previous                         : constant Name_Id := N + $;
+
    --  Ada 05 reserved words
 
    First_2005_Reserved_Word              : constant Name_Id := N + $;

gcc/ada/sprint.adb

@@ -1995,11 +1995,36 @@ package body Sprint is
                Sprint_Node (Condition (Node));
             else
                Write_Str_With_Col_Check_Sloc ("for ");
-               Sprint_Node (Loop_Parameter_Specification (Node));
+               if Present (Iterator_Specification (Node)) then
+                  Sprint_Node (Iterator_Specification (Node));
+               else
+                  Sprint_Node (Loop_Parameter_Specification (Node));
+               end if;
             end if;
 
             Write_Char (' ');
 
+         when N_Iterator_Specification =>
+            Set_Debug_Sloc;
+            Write_Id (Defining_Identifier (Node));
+
+            if Present (Subtype_Indication (Node)) then
+               Write_Str_With_Col_Check (" : ");
+               Sprint_Node (Subtype_Indication (Node));
+            end if;
+
+            if Of_Present (Node) then
+               Write_Str_With_Col_Check (" of ");
+            else
+               Write_Str_With_Col_Check (" in ");
+            end if;
+
+            if Reverse_Present (Node) then
+               Write_Str_With_Col_Check ("reverse ");
+            end if;
+
+            Sprint_Node (Name (Node));
+
          when N_Itype_Reference =>
             Write_Indent_Str_Sloc ("reference ");
             Write_Id (Itype (Node));