[multiple changes]

2015-10-20  Bob Duff  <duff@adacore.com>

	* a-coinve.ads, a-coinve.adb: Do the same efficiency
	improvements that were already done in the definite case
	(Ada.Containers.Vectors, i.e. a-convec). This includes the
	ability to suppress checks, the fast path for Append, inlining
	as appropriate, and special-casing of "for ... of" loops. Reuse
	the tampering machinery that is now in Ada.Containers. Simplify
	many operations.
	* a-convec.ads, a-convec.adb: Change the code to be more similar
	to a-coinve.
	* a-finali.ads, a-finali.adb: Expose the "null"-ness of the
	operations. This may enable optimizations in the future, and
	seems cleaner anyway.

2015-10-20  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch13.adb (Is_Operational_Item): Attributes related to
	Ada 2012 iterators are operational items, and can be specified
	on partial views.

From-SVN: r229033

gcc/ada/ChangeLog

+2015-10-20  Bob Duff  <duff@adacore.com>
+
+	* a-coinve.ads, a-coinve.adb: Do the same efficiency
+	improvements that were already done in the definite case
+	(Ada.Containers.Vectors, i.e. a-convec). This includes the
+	ability to suppress checks, the fast path for Append, inlining
+	as appropriate, and special-casing of "for ... of" loops. Reuse
+	the tampering machinery that is now in Ada.Containers. Simplify
+	many operations.
+	* a-convec.ads, a-convec.adb: Change the code to be more similar
+	to a-coinve.
+	* a-finali.ads, a-finali.adb: Expose the "null"-ness of the
+	operations. This may enable optimizations in the future, and
+	seems cleaner anyway.
+
+2015-10-20  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch13.adb (Is_Operational_Item): Attributes related to
+	Ada 2012 iterators are operational items, and can be specified
+	on partial views.
+
 2015-10-20  Hristian Kirtchev  <kirtchev@adacore.com>
 
 	* sem_prag.adb (Check_Usage): Update the calls to Usage_Error.

gcc/ada/a-coinve.ads

@@ -343,6 +343,7 @@ package Ada.Containers.Indefinite_Vectors is
 
 private
 
+   pragma Inline (Append);
    pragma Inline (First_Index);
    pragma Inline (Last_Index);
    pragma Inline (Element);
@@ -351,35 +352,37 @@ private
    pragma Inline (Query_Element);
    pragma Inline (Update_Element);
    pragma Inline (Replace_Element);
+   pragma Inline (Is_Empty);
    pragma Inline (Contains);
    pragma Inline (Next);
    pragma Inline (Previous);
 
+   package Implementation is new Generic_Implementation;
+   use Implementation;
+
    type Element_Access is access Element_Type;
 
    type Elements_Array is array (Index_Type range <>) of Element_Access;
    function "=" (L, R : Elements_Array) return Boolean is abstract;
 
-   type Elements_Type (Last : Index_Type) is limited record
+   type Elements_Type (Last : Extended_Index) is limited record
       EA : Elements_Array (Index_Type'First .. Last);
    end record;
 
-   type Elements_Access is access Elements_Type;
+   type Elements_Access is access all Elements_Type;
+
+   use Finalization;
+   use Streams;
 
-   type Vector is new Ada.Finalization.Controlled with record
-      Elements : Elements_Access;
+   type Vector is new Controlled with record
+      Elements : Elements_Access := null;
       Last     : Extended_Index := No_Index;
-      Busy     : Natural := 0;
-      Lock     : Natural := 0;
+      TC       : aliased Tamper_Counts;
    end record;
 
    overriding procedure Adjust (Container : in out Vector);
-
    overriding procedure Finalize (Container : in out Vector);
 
-   use Ada.Finalization;
-   use Ada.Streams;
-
    procedure Write
      (Stream    : not null access Root_Stream_Type'Class;
       Container : Vector);
@@ -412,16 +415,8 @@ private
 
    for Cursor'Write use Write;
 
-   type Reference_Control_Type is
-      new Controlled with record
-         Container : Vector_Access;
-      end record;
-
-   overriding procedure Adjust (Control : in out Reference_Control_Type);
-   pragma Inline (Adjust);
-
-   overriding procedure Finalize (Control : in out Reference_Control_Type);
-   pragma Inline (Finalize);
+   subtype Reference_Control_Type is Implementation.Reference_Control_Type;
+   --  It is necessary to rename this here, so that the compiler can find it
 
    type Constant_Reference_Type
      (Element : not null access constant Element_Type) is
@@ -467,16 +462,33 @@ private
 
    for Reference_Type'Read use Read;
 
-   Empty_Vector : constant Vector := (Controlled with null, No_Index, 0, 0);
+   --  Three operations are used to optimize in the expansion of "for ... of"
+   --  loops: the Next(Cursor) procedure in the visible part, and the following
+   --  Pseudo_Reference and Get_Element_Access functions. See Exp_Ch5 for
+   --  details.
+
+   function Pseudo_Reference
+     (Container : aliased Vector'Class) return Reference_Control_Type;
+   pragma Inline (Pseudo_Reference);
+   --  Creates an object of type Reference_Control_Type pointing to the
+   --  container, and increments the Lock. Finalization of this object will
+   --  decrement the Lock.
+
+   function Get_Element_Access
+     (Position : Cursor) return not null Element_Access;
+   --  Returns a pointer to the element designated by Position.
 
    No_Element : constant Cursor := Cursor'(null, Index_Type'First);
 
+   Empty_Vector : constant Vector := (Controlled with others => <>);
+
    type Iterator is new Limited_Controlled and
      Vector_Iterator_Interfaces.Reversible_Iterator with
    record
       Container : Vector_Access;
       Index     : Index_Type'Base;
-   end record;
+   end record
+     with Disable_Controlled => not T_Check;
 
    overriding procedure Finalize (Object : in out Iterator);
 

gcc/ada/a-convec.adb

@@ -450,9 +450,9 @@ package body Ada.Containers.Vectors is
          return;
       end if;
 
-      --  There are some elements aren't being deleted (the requested count was
-      --  less than the available count), so we must slide them down to
-      --  Index. We first calculate the index values of the respective array
+      --  There are some elements that aren't being deleted (the requested
+      --  count was less than the available count), so we must slide them down
+      --  to Index. We first calculate the index values of the respective array
       --  slices, using the wider of Index_Type'Base and Count_Type'Base as the
       --  type for intermediate calculations. For the elements that slide down,
       --  index value New_Last is the last index value of their new home, and
@@ -583,9 +583,9 @@ package body Ada.Containers.Vectors is
    begin
       if Checks and then Index > Container.Last then
          raise Constraint_Error with "Index is out of range";
-      else
-         return Container.Elements.EA (Index);
       end if;
+
+      return Container.Elements.EA (Index);
    end Element;
 
    function Element (Position : Cursor) return Element_Type is
@@ -692,9 +692,9 @@ package body Ada.Containers.Vectors is
    begin
       if Is_Empty (Container) then
          return No_Element;
-      else
-         return (Container'Unrestricted_Access, Index_Type'First);
       end if;
+
+      return (Container'Unrestricted_Access, Index_Type'First);
    end First;
 
    function First (Object : Iterator) return Cursor is
@@ -1030,7 +1030,6 @@ package body Ada.Containers.Vectors is
             --  handled above).
 
             if Index_Type'Last - No_Index >= Count_Type_Last then
-
                --  We have determined that range of Index_Type has at least as
                --  many values as in Count_Type, so Count_Type'Last is the
                --  maximum number of items that are allowed.
@@ -1655,7 +1654,6 @@ package body Ada.Containers.Vectors is
       --  acceptable, then we compute the new last index from that.
 
       if Index_Type'Base'Last >= Count_Type_Last then
-
          --  We have to handle the case when there might be more values in the
          --  range of Index_Type than in the range of Count_Type.
 
@@ -1690,7 +1688,6 @@ package body Ada.Containers.Vectors is
             --  handled above).
 
             if Index_Type'Last - No_Index >= Count_Type_Last then
-
                --  We have determined that range of Index_Type has at least as
                --  many values as in Count_Type, so Count_Type'Last is the
                --  maximum number of items that are allowed.
@@ -1965,7 +1962,7 @@ package body Ada.Containers.Vectors is
          Index := Before.Index;
       end if;
 
-      Insert_Space (Container, Index, Count => Count);
+      Insert_Space (Container, Index, Count);
 
       Position := (Container'Unrestricted_Access, Index);
    end Insert_Space;
@@ -2022,7 +2019,7 @@ package body Ada.Containers.Vectors is
    function Iterate
      (Container : Vector;
       Start     : Cursor)
-      return Vector_Iterator_Interfaces.Reversible_Iterator'class
+      return Vector_Iterator_Interfaces.Reversible_Iterator'Class
    is
       V : constant Vector_Access := Container'Unrestricted_Access;
    begin
@@ -2911,6 +2908,7 @@ package body Ada.Containers.Vectors is
    ---------------------
    -- Reverse_Iterate --
    ---------------------
+
    procedure Reverse_Iterate
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor))
@@ -3119,7 +3117,7 @@ package body Ada.Containers.Vectors is
 
       Elements := new Elements_Type (Last);
 
-      return Vector'(Controlled with Elements, Last, others => <>);
+      return Vector'(Controlled with Elements, Last, TC => <>);
    end To_Vector;
 
    function To_Vector
@@ -3211,7 +3209,7 @@ package body Ada.Containers.Vectors is
 
       Elements := new Elements_Type'(Last, EA => (others => New_Item));
 
-      return Vector'(Controlled with Elements, Last, others => <>);
+      return (Controlled with Elements, Last, TC => <>);
    end To_Vector;
 
    --------------------

gcc/ada/a-finali.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, 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- --
@@ -29,48 +29,8 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
-package body Ada.Finalization is
+--  This package does not require a body. We provide a dummy file containing a
+--  No_Body pragma so that previous versions of the body (which did exist) will
+--  not interfere.
 
-   ------------
-   -- Adjust --
-   ------------
-
-   procedure Adjust (Object : in out Controlled) is
-      pragma Warnings (Off, Object);
-   begin
-      null;
-   end Adjust;
-
-   --------------
-   -- Finalize --
-   --------------
-
-   procedure Finalize (Object : in out Controlled) is
-      pragma Warnings (Off, Object);
-   begin
-      null;
-   end Finalize;
-
-   procedure Finalize (Object : in out Limited_Controlled) is
-      pragma Warnings (Off, Object);
-   begin
-      null;
-   end Finalize;
-
-   ----------------
-   -- Initialize --
-   ----------------
-
-   procedure Initialize (Object : in out Controlled) is
-      pragma Warnings (Off, Object);
-   begin
-      null;
-   end Initialize;
-
-   procedure Initialize (Object : in out Limited_Controlled) is
-      pragma Warnings (Off, Object);
-   begin
-      null;
-   end Initialize;
-
-end Ada.Finalization;
+pragma No_Body;

gcc/ada/a-finali.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT. The copyright notice above, and the license provisions that follow --
@@ -43,15 +43,15 @@ package Ada.Finalization is
    type Controlled is abstract tagged private;
    pragma Preelaborable_Initialization (Controlled);
 
-   procedure Initialize (Object : in out Controlled);
-   procedure Adjust     (Object : in out Controlled);
-   procedure Finalize   (Object : in out Controlled);
+   procedure Initialize (Object : in out Controlled) is null;
+   procedure Adjust     (Object : in out Controlled) is null;
+   procedure Finalize   (Object : in out Controlled) is null;
 
    type Limited_Controlled is abstract tagged limited private;
    pragma Preelaborable_Initialization (Limited_Controlled);
 
-   procedure Initialize (Object : in out Limited_Controlled);
-   procedure Finalize   (Object : in out Limited_Controlled);
+   procedure Initialize (Object : in out Limited_Controlled) is null;
+   procedure Finalize   (Object : in out Limited_Controlled) is null;
 
 private
    package SFR renames System.Finalization_Root;

gcc/ada/sem_ch13.adb

@@ -2036,8 +2036,8 @@ package body Sem_Ch13 is
                      Analyze_And_Resolve (Expr, Standard_Integer);
 
                      --  Interrupt_Priority aspect not allowed for main
-                     --  subprograms. ARM D.1 does not forbid this explicitly,
-                     --  but ARM J.15.11 (6/3) does not permit pragma
+                     --  subprograms. RM D.1 does not forbid this explicitly,
+                     --  but RM J.15.11(6/3) does not permit pragma
                      --  Interrupt_Priority for subprograms.
 
                      if A_Id = Aspect_Interrupt_Priority then
@@ -2060,7 +2060,7 @@ package body Sem_Ch13 is
                                       (Specification (N)))
                        or else not Is_Compilation_Unit (Defining_Entity (N))
                      then
-                        --  See ARM D.1 (14/3) and D.16 (12/3)
+                        --  See RM D.1(14/3) and D.16(12/3)
 
                         Error_Msg_N
                           ("aspect applied to subprogram other than the "
@@ -11419,9 +11419,20 @@ package body Sem_Ch13 is
          declare
             Id : constant Attribute_Id := Get_Attribute_Id (Chars (N));
          begin
-            return    Id = Attribute_Input
+
+            --  List of operational items is given in RM 13.1(8.mm/1).
+            --  It is clearly incomplete, as it does not include iterator
+            --  aspects, among others.
+
+            return    Id = Attribute_Constant_Indexing
+              or else Id = Attribute_Default_Iterator
+              or else Id = Attribute_Implicit_Dereference
+              or else Id = Attribute_Input
+              or else Id = Attribute_Iterator_Element
+              or else Id = Attribute_Iterable
               or else Id = Attribute_Output
               or else Id = Attribute_Read
+              or else Id = Attribute_Variable_Indexing
               or else Id = Attribute_Write
               or else Id = Attribute_External_Tag;
          end;