style.adb (Missing_Overriding): Warning does not apply in language versions prior to Ada 2005.

2014-02-19  Ed Schonberg  <schonberg@adacore.com>

	* style.adb (Missing_Overriding): Warning does not apply in
	language versions prior to Ada 2005.
	* snames.ads-tmpl: Add Name_Iterable and Attribute_Iterable.
	* sem_attr.adb: Add Attribute_Iterable where needed.
	* exp_attr.adb: ditto.
	* exp_ch5.adb (Expand_Formal_Container_Loop): New procedure to
	handle loops and quantified expressions over types that have an
	iterable aspect.  Called from Expand_Iterator_Loop.
	* sem_ch5.adb (Analyze_Iterator_Specification): Recognize types
	with Iterable aspect.
	* sem_ch13.adb (Validate_Iterable_Aspect): Verify that the
	subprograms specified in the Iterable aspect have the proper
	signature involving container and cursor.
	(Check_Aspect_At_Freeze_Point): Analyze value of iterable aspect.
	* sem_ch13.ads (Validate_Iterable_Aspect): New subprogram.
	* sem_util.ads, sem_util.adb (Get_Iterable_Type_Primitive):
	New procedure to retrieve one of the primitives First, Last,
	or Has_Element, from the value of the iterable aspect of a
	formal container.
	(Is_Container_Element): Predicate to recognize expressions
	that denote an element of one of the predefined containers,
	for possible optimization.  This subprogram is not currently
	used, pending ARG discussions on the legality of the proposed
	optimization. Worth preserving for eventual use.
	(Is_Iterator): Recognize formal container types.
	* aspects.ads, aspects.adb: Add Aspect_Iterable where needed.

From-SVN: r207881

gcc/ada/ChangeLog

@@ -1,3 +1,32 @@
+2014-02-19  Ed Schonberg  <schonberg@adacore.com>
+
+	* style.adb (Missing_Overriding): Warning does not apply in
+	language versions prior to Ada 2005.
+	* snames.ads-tmpl: Add Name_Iterable and Attribute_Iterable.
+	* sem_attr.adb: Add Attribute_Iterable where needed.
+	* exp_attr.adb: ditto.
+	* exp_ch5.adb (Expand_Formal_Container_Loop): New procedure to
+	handle loops and quantified expressions over types that have an
+	iterable aspect.  Called from Expand_Iterator_Loop.
+	* sem_ch5.adb (Analyze_Iterator_Specification): Recognize types
+	with Iterable aspect.
+	* sem_ch13.adb (Validate_Iterable_Aspect): Verify that the
+	subprograms specified in the Iterable aspect have the proper
+	signature involving container and cursor.
+	(Check_Aspect_At_Freeze_Point): Analyze value of iterable aspect.
+	* sem_ch13.ads (Validate_Iterable_Aspect): New subprogram.
+	* sem_util.ads, sem_util.adb (Get_Iterable_Type_Primitive):
+	New procedure to retrieve one of the primitives First, Last,
+	or Has_Element, from the value of the iterable aspect of a
+	formal container.
+	(Is_Container_Element): Predicate to recognize expressions
+	that denote an element of one of the predefined containers,
+	for possible optimization.  This subprogram is not currently
+	used, pending ARG discussions on the legality of the proposed
+	optimization. Worth preserving for eventual use.
+	(Is_Iterator): Recognize formal container types.
+	* aspects.ads, aspects.adb: Add Aspect_Iterable where needed.
+
 2014-02-19  Robert Dewar  <dewar@adacore.com>
 
 	* exp_attr.adb (Expand_Min_Max_Attribute): New procedure

gcc/ada/aspects.adb

@@ -514,6 +514,7 @@ package body Aspects is
     Aspect_Interrupt_Handler            => Aspect_Interrupt_Handler,
     Aspect_Interrupt_Priority           => Aspect_Priority,
     Aspect_Invariant                    => Aspect_Invariant,
+    Aspect_Iterable                     => Aspect_Iterable,
     Aspect_Iterator_Element             => Aspect_Iterator_Element,
     Aspect_Link_Name                    => Aspect_Link_Name,
     Aspect_Linker_Section               => Aspect_Linker_Section,

gcc/ada/aspects.ads

@@ -102,6 +102,7 @@ package Aspects is
       Aspect_Interrupt_Priority,
       Aspect_Invariant,                     -- GNAT
       Aspect_Iterator_Element,
+      Aspect_Iterable,                      -- GNAT
       Aspect_Link_Name,
       Aspect_Linker_Section,                -- GNAT
       Aspect_Machine_Radix,
@@ -325,6 +326,7 @@ package Aspects is
       Aspect_Input                   => Name,
       Aspect_Interrupt_Priority      => Expression,
       Aspect_Invariant               => Expression,
+      Aspect_Iterable                => Expression,
       Aspect_Iterator_Element        => Name,
       Aspect_Link_Name               => Expression,
       Aspect_Linker_Section          => Expression,
@@ -423,6 +425,7 @@ package Aspects is
       Aspect_Interrupt_Priority           => Name_Interrupt_Priority,
       Aspect_Invariant                    => Name_Invariant,
       Aspect_Iterator_Element             => Name_Iterator_Element,
+      Aspect_Iterable                     => Name_Iterable,
       Aspect_Link_Name                    => Name_Link_Name,
       Aspect_Linker_Section               => Name_Linker_Section,
       Aspect_Lock_Free                    => Name_Lock_Free,
@@ -628,6 +631,7 @@ package Aspects is
       Aspect_Interrupt_Handler            => Always_Delay,
       Aspect_Interrupt_Priority           => Always_Delay,
       Aspect_Invariant                    => Always_Delay,
+      Aspect_Iterable                     => Always_Delay,
       Aspect_Iterator_Element             => Always_Delay,
       Aspect_Link_Name                    => Always_Delay,
       Aspect_Linker_Section               => Always_Delay,

gcc/ada/exp_attr.adb

@@ -1351,6 +1351,7 @@ package body Exp_Attr is
       when Attribute_Constant_Indexing    |
            Attribute_Default_Iterator     |
            Attribute_Implicit_Dereference |
+           Attribute_Iterable             |
            Attribute_Iterator_Element     |
            Attribute_Variable_Indexing    =>
          null;

gcc/ada/exp_ch5.adb

@@ -103,6 +103,8 @@ 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_Formal_Container_Loop (Typ : Entity_Id; N : Node_Id);
+
    procedure Expand_Iterator_Loop (N : Node_Id);
    --  Expand loop over arrays and containers that uses the form "for X of C"
    --  with an optional subtype mark, or "for Y in C".
@@ -2651,6 +2653,85 @@ package body Exp_Ch5 is
       Adjust_Condition (Condition (N));
    end Expand_N_Exit_Statement;
 
+   ----------------------------------
+   -- Expand_Formal_Container_Loop --
+   ----------------------------------
+
+   procedure Expand_Formal_Container_Loop (Typ : Entity_Id; N : Node_Id) is
+      Isc       : constant Node_Id    := Iteration_Scheme (N);
+      I_Spec    : constant Node_Id    := Iterator_Specification (Isc);
+      Cursor    : constant Entity_Id  := Defining_Identifier (I_Spec);
+      Container : constant Node_Id    := Entity (Name (I_Spec));
+      Stats     : constant List_Id    := Statements (N);
+      Loc       : constant Source_Ptr := Sloc (N);
+
+      First_Op : constant Entity_Id :=
+                   Get_Iterable_Type_Primitive (Typ, Name_First);
+      Next_Op  : constant Entity_Id :=
+                   Get_Iterable_Type_Primitive (Typ, Name_Next);
+      Has_Element_Op : constant Entity_Id :=
+                   Get_Iterable_Type_Primitive (Typ, Name_Has_Element);
+
+      Advance  : Node_Id;
+      Init     : Node_Id;
+      New_Loop : Node_Id;
+
+   begin
+      --  The expansion resembles the one for Ada containers, but the
+      --  primitives mention the the domain of iteration explicitly, and
+      --  First applied to the container yields a cursor directly.
+
+      --    Cursor : Cursor_type := First (Container);
+      --    while Has_Element (Cursor, Container) loop
+      --          <original loop statements>
+      --       Cursor := Next (Container, Cursor);
+      --    end loop;
+
+      Init :=
+         Make_Object_Declaration (Loc,
+           Defining_Identifier => Cursor,
+           Object_Definition => New_Occurrence_Of (Etype (First_Op),  Loc),
+             Expression =>
+               Make_Function_Call (Loc,
+                 Name => New_Occurrence_Of (First_Op, Loc),
+                   Parameter_Associations =>
+                     New_List (New_Occurrence_Of (Container, Loc))));
+
+      Set_Ekind (Cursor, E_Variable);
+
+      Insert_Action (N, Init);
+
+      Advance :=
+        Make_Assignment_Statement (Loc,
+          Name => New_Occurrence_Of (Cursor, Loc),
+          Expression =>
+            Make_Function_Call (Loc,
+              Name => New_Occurrence_Of (Next_Op, Loc),
+                Parameter_Associations =>
+                  New_List
+                    (New_Occurrence_Of (Container, Loc),
+                     New_Occurrence_Of (Cursor, Loc))));
+
+      Append_To (Stats, Advance);
+
+      New_Loop :=
+        Make_Loop_Statement (Loc,
+          Iteration_Scheme =>
+            Make_Iteration_Scheme (Loc,
+              Condition =>
+                Make_Function_Call (Loc,
+                  Name                   =>
+                    New_Occurrence_Of (Has_Element_Op, Loc),
+                  Parameter_Associations =>
+                    New_List
+                     (New_Reference_To (Container, Loc),
+                      New_Reference_To (Cursor, Loc)))),
+          Statements => Stats,
+          End_Label  => Empty);
+      Rewrite (N, New_Loop);
+      Analyze (New_Loop);
+   end Expand_Formal_Container_Loop;
+
    -----------------------------
    -- Expand_N_Goto_Statement --
    -----------------------------
@@ -2966,6 +3047,10 @@ package body Exp_Ch5 is
       if Is_Array_Type (Container_Typ) then
          Expand_Iterator_Loop_Over_Array (N);
          return;
+
+      elsif Has_Aspect (Container_Typ, Aspect_Iterable) then
+         Expand_Formal_Container_Loop (Container_Typ, N);
+         return;
       end if;
 
       --  Processing for containers

gcc/ada/sem_attr.adb

@@ -2491,6 +2491,7 @@ package body Sem_Attr is
            Attribute_Default_Iterator     |
            Attribute_Implicit_Dereference |
            Attribute_Iterator_Element     |
+           Attribute_Iterable             |
            Attribute_Variable_Indexing    =>
          Error_Msg_N ("illegal attribute", N);
 
@@ -7472,6 +7473,7 @@ package body Sem_Attr is
               Attribute_Default_Iterator     |
               Attribute_Implicit_Dereference |
               Attribute_Iterator_Element     |
+              Attribute_Iterable             |
               Attribute_Variable_Indexing    => null;
 
          --  Internal attributes used to deal with Ada 2012 delayed aspects.

gcc/ada/sem_ch13.adb

@@ -1110,6 +1110,9 @@ package body Sem_Ch13 is
                     Aspect_Iterator_Element  =>
                   Analyze (Expression (ASN));
 
+               when Aspect_Iterable =>
+                  Validate_Iterable_Aspect (E, ASN);
+
                when others =>
                   null;
                end case;
@@ -1571,6 +1574,7 @@ package body Sem_Ch13 is
                     Aspect_Dispatching_Domain   |
                     Aspect_External_Tag         |
                     Aspect_Input                |
+                    Aspect_Iterable             |
                     Aspect_Iterator_Element     |
                     Aspect_Machine_Radix        |
                     Aspect_Object_Size          |
@@ -4281,6 +4285,29 @@ package body Sem_Ch13 is
             end if;
          end Interrupt_Priority;
 
+         --------------
+         -- Iterable --
+         --------------
+
+         when Attribute_Iterable =>
+            Analyze (Expr);
+            if Nkind (Expr) /= N_Aggregate then
+               Error_Msg_N ("aspect Iterable must be an aggregate", Expr);
+            end if;
+
+            declare
+               Assoc : Node_Id;
+
+            begin
+               Assoc := First (Component_Associations (Expr));
+               while Present (Assoc) loop
+                  if not Is_Entity_Name (Expression (Assoc)) then
+                     Error_Msg_N ("value must be a function", Assoc);
+                  end if;
+                  Next (Assoc);
+               end loop;
+            end;
+
          ----------------------
          -- Iterator_Element --
          ----------------------
@@ -8012,6 +8039,20 @@ package body Sem_Ch13 is
             Analyze (Expression (ASN));
             return;
 
+         --  Ditto for Iterable, legality checks in Validate_Iterable_Aspect.
+
+         when Aspect_Iterable =>
+            declare
+               Assoc : Node_Id;
+            begin
+               Assoc := First (Component_Associations (Expression (ASN)));
+               while Present (Assoc) loop
+                  Analyze (Expression (Assoc));
+                  Next (Assoc);
+               end loop;
+            end;
+            return;
+
          --  Invariant/Predicate take boolean expressions
 
          when Aspect_Dynamic_Predicate |
@@ -11223,6 +11264,153 @@ package body Sem_Ch13 is
       end loop;
    end Validate_Independence;
 
+   ------------------------------
+   -- Validate_Iterable_Aspect --
+   ------------------------------
+
+   procedure Validate_Iterable_Aspect (Typ : Entity_Id; ASN : Node_Id) is
+      Scop           : constant Entity_Id := Scope (Typ);
+      Assoc          : Node_Id;
+      Expr           : Node_Id;
+
+      Prim           : Node_Id;
+      Cursor         : Entity_Id;
+
+      First_Id       : Entity_Id;
+      Next_Id        : Entity_Id;
+      Has_Element_Id : Entity_Id;
+      Element_Id     : Entity_Id;
+
+      procedure Check_Signature (Op : Entity_Id; Num_Formals : Positive);
+      --  Verify that primitive has two parameters of the proper types.
+
+      procedure Check_Signature (Op : Entity_Id; Num_Formals : Positive) is
+         F1, F2 : Entity_Id;
+
+      begin
+         if Scope (Op) /= Current_Scope then
+            Error_Msg_N ("iterable primitive must be declared in scope", Prim);
+         end if;
+
+         F1 := First_Formal (Op);
+         if No (F1)
+           or else Etype (F1) /= Typ
+         then
+            Error_Msg_N ("first parameter must be container type", Op);
+         end if;
+
+         if Num_Formals = 1 then
+            if Present (Next_Formal (F1)) then
+               Error_Msg_N ("First must have a single parameter", Op);
+            end if;
+
+         else
+            F2 := Next_Formal (F1);
+            if No (F2)
+              or else Etype (F2) /= Cursor
+            then
+               Error_Msg_N ("second parameter must be cursor", Op);
+            end if;
+
+            if Present (Next_Formal (F2)) then
+               Error_Msg_N ("too many parameters in iterable primitive", Op);
+            end if;
+         end if;
+      end Check_Signature;
+
+   begin
+      --  There must be a cursor type declared in the same package.
+
+      declare
+         E : Entity_Id;
+
+      begin
+         Cursor := Empty;
+         E := First_Entity (Scop);
+         while Present (E) loop
+            if Chars (E) = Name_Cursor
+               and then Is_Type (E)
+            then
+               Cursor := E;
+               exit;
+            end if;
+
+            Next_Entity (E);
+         end loop;
+
+         if No (Cursor) then
+            Error_Msg_N ("Iterable aspect requires a cursor type", ASN);
+            return;
+         end if;
+      end;
+
+      First_Id       := Empty;
+      Next_Id        := Empty;
+      Has_Element_Id := Empty;
+
+      --  Each expression must resolve to a function with the proper signature
+
+      Assoc := First (Component_Associations (Expression (ASN)));
+      while Present (Assoc) loop
+         Expr := Expression (Assoc);
+         Analyze (Expr);
+
+         if not Is_Entity_Name (Expr)
+           or else Ekind (Entity (Expr)) /= E_Function
+         then
+            Error_Msg_N ("this should be a function name", Expr);
+         end if;
+
+         Prim := First (Choices (Assoc));
+         if Nkind (Prim) /= N_Identifier
+           or else Present (Next (Prim))
+         then
+            Error_Msg_N ("illegal name in association", Prim);
+
+         elsif Chars (Prim) = Name_First then
+            First_Id := Entity (Expr);
+            Check_Signature (First_Id, 1);
+            if Etype (First_Id) /= Cursor then
+               Error_Msg_NE ("First must return Cursor", Expr, First_Id);
+            end if;
+
+         elsif Chars (Prim) = Name_Next then
+            Next_Id := Entity (Expr);
+            Check_Signature (Next_Id, 2);
+            if Etype (Next_Id) /= Cursor then
+               Error_Msg_NE ("Next must return Cursor", Expr, First_Id);
+            end if;
+
+         elsif Chars (Prim) = Name_Has_Element then
+            Has_Element_Id := Entity (Expr);
+            if Etype (Has_Element_Id) /= Standard_Boolean then
+               Error_Msg_NE
+                ("Has_Element must return Boolean", Expr, First_Id);
+            end if;
+
+         elsif Chars (Prim) = Name_Element then
+            Element_Id := Entity (Expr);
+            Check_Signature (Element_Id, 2);
+
+         else
+            Error_Msg_N ("invalid name for iterable function", Prim);
+         end if;
+
+         Next (Assoc);
+      end loop;
+
+      if No (First_Id) then
+         Error_Msg_N ("Iterable aspect must have a First primitive", ASN);
+
+      elsif No (Next_Id) then
+         Error_Msg_N ("Iterable aspect must have a Next primitive", ASN);
+
+      elsif No (Has_Element_Id) then
+         Error_Msg_N
+           ("Iterable aspect must have a Has_Element  primitive", ASN);
+      end if;
+   end Validate_Iterable_Aspect;
+
    -----------------------------------
    -- Validate_Unchecked_Conversion --
    -----------------------------------

gcc/ada/sem_ch13.ads

@@ -325,4 +325,10 @@ package Sem_Ch13 is
    procedure Inherit_Aspects_At_Freeze_Point (Typ : Entity_Id);
    --  Given an entity Typ that denotes a derived type or a subtype, this
    --  routine performs the inheritance of aspects at the freeze point.
+
+   procedure Validate_Iterable_Aspect (Typ : Entity_Id; ASN : Node_Id);
+   --  For SPARK 2014 formal containers. The expression has the form of an
+   --  aggregate, and each entry must denote a function with the proper
+   --  syntax for First, Next, and Has_Element. Optionally an Element primitive
+   --  may also be defined.
 end Sem_Ch13;

gcc/ada/sem_ch5.adb

@@ -1890,10 +1890,16 @@ package body Sem_Ch5 is
             --  iterator, typically the result of a call to Iterate. Give a
             --  useful error message when the name is a container by itself.
 
+            --  The type may be a formal container type, which has to have
+            --  an Iterable aspect detailing the required primitives.
+
             if Is_Entity_Name (Original_Node (Name (N)))
               and then not Is_Iterator (Typ)
             then
-               if not Has_Aspect (Typ, Aspect_Iterator_Element) then
+               if Has_Aspect (Typ, Aspect_Iterable) then
+                  null;
+
+               elsif not Has_Aspect (Typ, Aspect_Iterator_Element) then
                   Error_Msg_NE
                     ("cannot iterate over&", Name (N), Typ);
                else
@@ -1901,9 +1907,13 @@ package body Sem_Ch5 is
                     ("name must be an iterator, not a container", Name (N));
                end if;
 
-               Error_Msg_NE
-                 ("\to iterate directly over the elements of a container, " &
-                   "write `of &`", Name (N), Original_Node (Name (N)));
+               if Has_Aspect (Typ, Aspect_Iterable) then
+                  null;
+               else
+                  Error_Msg_NE
+                    ("\to iterate directly over the elements of a container, "
+                      & "write `of &`", Name (N), Original_Node (Name (N)));
+               end if;
             end if;
 
             --  The result type of Iterate function is the classwide type of

gcc/ada/sem_util.adb

@@ -6619,6 +6619,34 @@ package body Sem_Util is
       end if;
    end Get_Index_Bounds;
 
+   ---------------------------------
+   -- Get_Iterable_Type_Primitive --
+   ---------------------------------
+
+   function Get_Iterable_Type_Primitive
+     (Typ : Entity_Id;
+      Nam : Name_Id) return Entity_Id
+   is
+      Funcs : constant Node_Id := Find_Value_Of_Aspect (Typ, Aspect_Iterable);
+      Assoc : Node_Id;
+   begin
+      if No (Funcs) then
+         return Empty;
+
+      else
+         Assoc := First (Component_Associations (Funcs));
+         while Present (Assoc) loop
+            if Chars (First (Choices (Assoc))) = Nam then
+               return Entity (Expression (Assoc));
+            end if;
+
+            Assoc := Next (Assoc);
+         end loop;
+
+         return Empty;
+      end if;
+   end Get_Iterable_Type_Primitive;
+
    ----------------------------------
    -- Get_Library_Unit_Name_string --
    ----------------------------------
@@ -9301,6 +9329,183 @@ package body Sem_Util is
                or else Is_Task_Interface (T));
    end Is_Concurrent_Interface;
 
+   ---------------------------
+   --  Is_Container_Element --
+   ---------------------------
+
+   function Is_Container_Element (Exp : Node_Id) return Boolean is
+      Loc      : constant Source_Ptr := Sloc (Exp);
+      Pref     : constant Node_Id   := Prefix (Exp);
+      Call     : Node_Id;
+      --  Call to an indexing aspect
+
+      Cont_Typ : Entity_Id;
+      --  The type of the container being accessed
+
+      Elem_Typ : Entity_Id;
+      --  Its element type
+
+      Indexing : Entity_Id;
+      Is_Const : Boolean;
+      --  Indicates that constant indexing is used, and the element is thus
+      --  a constant
+
+      Ref_Typ  : Entity_Id;
+      --  The reference type returned by the indexing operation.
+
+   begin
+      --  If C is a container, in a context that imposes the element type of
+      --  that container, the indexing notation C (X) is rewritten as:
+      --               Indexing (C, X).Discr.all
+      --  where Indexing is one of the indexing aspects of the container.
+      --  If the context does not require a reference, the construct can be
+      --  rewritten as Element (C, X).
+      --  First, verify that the construct has the proper form.
+
+      if not Expander_Active then
+         return False;
+
+      elsif Nkind (Pref) /= N_Selected_Component then
+         return False;
+
+      elsif Nkind (Prefix (Pref)) /= N_Function_Call then
+         return False;
+
+      else
+         Call     := Prefix (Pref);
+         Ref_Typ  := Etype (Call);
+      end if;
+
+      if not Has_Implicit_Dereference (Ref_Typ)
+        or else No (First (Parameter_Associations (Call)))
+        or else not Is_Entity_Name (Name (Call))
+      then
+         return False;
+      end if;
+
+      --  Retrieve type of container object, and its iterator aspects.
+
+      Cont_Typ := Etype (First (Parameter_Associations (Call)));
+      Indexing :=
+         Find_Value_Of_Aspect (Cont_Typ, Aspect_Constant_Indexing);
+      Is_Const := False;
+      if No (Indexing) then
+
+         --  Container should have at least one indexing operation.
+
+         return False;
+
+      elsif Entity (Name (Call)) /= Entity (Indexing) then
+
+         --  This may be a variable indexing operation
+
+         Indexing :=
+           Find_Value_Of_Aspect (Cont_Typ, Aspect_Variable_Indexing);
+         if No (Indexing)
+           or else Entity (Name (Call)) /= Entity (Indexing)
+         then
+            return False;
+         end if;
+
+      else
+         Is_Const := True;
+      end if;
+
+      Elem_Typ := Find_Value_Of_Aspect (Cont_Typ, Aspect_Iterator_Element);
+      if No (Elem_Typ)
+        or else Entity (Elem_Typ) /= Etype (Exp)
+      then
+         return False;
+      end if;
+
+      --  Check that the expression is not the target of an assignment, in
+      --  which case the rewriting is not possible.
+
+      if not Is_Const then
+         declare
+            Par : Node_Id;
+
+         begin
+            Par := Exp;
+            while Present (Par)
+            loop
+               if Nkind (Parent (Par)) = N_Assignment_Statement
+                 and then Par = Name (Parent (Par))
+               then
+                  return False;
+
+               --  A renaming produces a reference, and the transformation
+               --  does not apply.
+
+               elsif Nkind (Parent (Par)) = N_Object_Renaming_Declaration then
+                  return False;
+
+               elsif Nkind_In
+                 (Nkind (Parent (Par)),
+                     N_Function_Call,
+                     N_Procedure_Call_Statement,
+                     N_Entry_Call_Statement)
+               then
+                  --  Check that the element is not part of an actual for an
+                  --  in-out parameter.
+
+                  declare
+                     F : Entity_Id;
+                     A : Node_Id;
+
+                  begin
+                     F := First_Formal (Entity (Name (Parent (Par))));
+                     A := First (Parameter_Associations (Parent (Par)));
+                     while Present (F) loop
+                        if A = Par
+                          and then Ekind (F) /= E_In_Parameter
+                        then
+                           return False;
+                        end if;
+
+                        Next_Formal (F);
+                        Next (A);
+                     end loop;
+                  end;
+
+                  --  in_parameter in a call:  element is not modified.
+
+                  exit;
+               end if;
+
+               Par := Parent (Par);
+            end loop;
+         end;
+      end if;
+
+      --  The expression has the proper form and the context requires the
+      --  element type. Retrieve the Element function of the container, and
+      --  rewrite the construct as a call to it.
+
+      declare
+         Op : Elmt_Id;
+
+      begin
+         Op := First_Elmt (Primitive_Operations (Cont_Typ));
+         while Present (Op) loop
+            exit when Chars (Node (Op)) = Name_Element;
+            Next_Elmt (Op);
+         end loop;
+
+         if No (Op) then
+            return False;
+
+         else
+            Rewrite (Exp,
+              Make_Function_Call (Loc,
+                Name => New_Occurrence_Of (Node (Op), Loc),
+                Parameter_Associations => Parameter_Associations (Call)));
+            Analyze_And_Resolve (Exp, Entity (Elem_Typ));
+            return True;
+         end if;
+      end;
+   end Is_Container_Element;
+
    -----------------------
    -- Is_Constant_Bound --
    -----------------------
@@ -10039,6 +10244,9 @@ package body Sem_Util is
       elsif not Is_Tagged_Type (Typ) or else not Is_Derived_Type (Typ) then
          return False;
 
+      elsif Present (Find_Value_Of_Aspect (Typ, Aspect_Iterable)) then
+         return True;
+
       else
          Collect_Interfaces (Typ, Ifaces_List);
 

gcc/ada/sem_util.ads

@@ -818,6 +818,12 @@ package Sem_Util is
    --  The third argument supplies a source location for constructed nodes
    --  returned by this function.
 
+   function Get_Iterable_Type_Primitive
+     (Typ : Entity_Id;
+      Nam : Name_Id) return Entity_Id;
+   --  Retrieve one of the primitives First, Next, Has_Element, Element from
+   --  the value of the Iterable aspect of a formal type.
+
    procedure Get_Library_Unit_Name_String (Decl_Node : Node_Id);
    --  Retrieve the fully expanded name of the library unit declared by
    --  Decl_Node into the name buffer.
@@ -1102,6 +1108,17 @@ package Sem_Util is
    --  enumeration literal, or an expression composed of constant-bound
    --  subexpressions which are evaluated by means of standard operators.
 
+   function Is_Container_Element (Exp : Node_Id) return Boolean;
+   --  This routine recognizes expressions that denote an element of one of
+   --  the predefined containers, when the source only contains an indexing
+   --  operation and an implicit dereference is inserted by the compiler. In
+   --  the absence of this optimization, the indexing creates a temporary
+   --  controlled cursor that sets the tampering bit of the container, and
+   --  restricts the use of the convenient notation C (X) to contexts that
+   --  do not check the tampering bit (e.g.  C.Include (X,  C (Y)).
+   --  Exp is an explicit dereference. The transformation applies when it
+   --  has the form  F (X).Discr.all.
+
    function Is_Controlling_Limited_Procedure
      (Proc_Nam : Entity_Id) return Boolean;
    --  Ada 2005 (AI-345): Determine whether Proc_Nam is a primitive procedure

gcc/ada/snames.ads-tmpl

@@ -872,6 +872,7 @@ package Snames is
    Name_Integer_Value                  : constant Name_Id := N + $; -- GNAT
    Name_Invalid_Value                  : constant Name_Id := N + $; -- GNAT
    Name_Iterator_Element               : constant Name_Id := N + $; -- GNAT
+   Name_Iterable                       : constant Name_Id := N + $; -- GNAT
    Name_Large                          : constant Name_Id := N + $; -- Ada 83
    Name_Last                           : constant Name_Id := N + $;
    Name_Last_Bit                       : constant Name_Id := N + $;
@@ -1496,6 +1497,7 @@ package Snames is
       Attribute_Integer_Value,
       Attribute_Invalid_Value,
       Attribute_Iterator_Element,
+      Attribute_Iterable,
       Attribute_Large,
       Attribute_Last,
       Attribute_Last_Bit,

gcc/ada/style.adb

@@ -29,6 +29,7 @@ with Csets;    use Csets;
 with Einfo;    use Einfo;
 with Errout;   use Errout;
 with Namet;    use Namet;
+with Opt;      use Opt;
 with Sinfo;    use Sinfo;
 with Sinput;   use Sinput;
 with Stand;    use Stand;
@@ -260,10 +261,12 @@ package body Style is
    begin
 
       --  Perform the check on source subprograms and on subprogram instances,
-      --  because these can be primitives of untagged types.
+      --  because these can be primitives of untagged types. Note that such
+      --  indicators were introduced in Ada 2005.
 
       if Style_Check_Missing_Overriding
         and then (Comes_From_Source (N) or else Is_Generic_Instance (E))
+        and then Ada_Version >= Ada_2005
       then
          if Nkind (N) = N_Subprogram_Body then
             Error_Msg_NE -- CODEFIX