[multiple changes]

2011-08-29  Robert Dewar  <dewar@adacore.com>

	* sem_ch6.adb, exp_ch3.adb, s-stposu.adb, a-undesu.ads,
	a-undesu.adb: Minor reformatting.

2011-08-29  Ed Schonberg  <schonberg@adacore.com>

	* exp_disp.adb (Check_Premature_Freezing): When building a dispatch
	table, accept an unfrozen untagged component if it is an actual for a
	formal incomplete type.
	* a-convec.ads, a-convec.adb: Instantiate Ada.Iterator_Interfaces to
	provide new iterator forms over vectors.
	Introduce type Iterator in package body to implement operations of
	Reversible_Iterator interface.
	* a-iteint.ads: Make package pure so it is usable with new container
	packages, that are categorized Remote_Types.

From-SVN: r178211

gcc/ada/ChangeLog

 2011-08-29  Robert Dewar  <dewar@adacore.com>
 
+	* sem_ch6.adb, exp_ch3.adb, s-stposu.adb, a-undesu.ads,
+	a-undesu.adb: Minor reformatting.
+
+2011-08-29  Ed Schonberg  <schonberg@adacore.com>
+
+	* exp_disp.adb (Check_Premature_Freezing): When building a dispatch
+	table, accept an unfrozen untagged component if it is an actual for a
+	formal incomplete type.
+	* a-convec.ads, a-convec.adb: Instantiate Ada.Iterator_Interfaces to
+	provide new iterator forms over vectors.
+	Introduce type Iterator in package body to implement operations of
+	Reversible_Iterator interface.
+	* a-iteint.ads: Make package pure so it is usable with new container
+	packages, that are categorized Remote_Types.
+
+2011-08-29  Robert Dewar  <dewar@adacore.com>
+
 	* a-exexpr-gcc.adb, a-synbar.adb, sem_ch13.adb: Minor reformatting.
 
 2011-08-29  Bob Duff  <duff@adacore.com>

gcc/ada/a-convec.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2010, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2011, 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- --
@@ -37,6 +37,19 @@ package body Ada.Containers.Vectors is
    procedure Free is
      new Ada.Unchecked_Deallocation (Elements_Type, Elements_Access);
 
+   type Iterator is new
+     Vector_Iterator_Interfaces.Reversible_Iterator with record
+      Container : Vector_Access;
+      Index     : Index_Type;
+   end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+   overriding function Last  (Object : Iterator) return Cursor;
+   overriding function Next  (Object : Iterator; Position : Cursor)
+     return Cursor;
+   overriding function Previous (Object : Iterator; Position : Cursor)
+     return Cursor;
+
    ---------
    -- "&" --
    ---------
@@ -786,6 +799,12 @@ package body Ada.Containers.Vectors is
       return (Container'Unchecked_Access, Index_Type'First);
    end First;
 
+   function First (Object : Iterator) return Cursor is
+      C : constant Cursor := (Object.Container, Index_Type'First);
+   begin
+      return C;
+   end First;
+
    -------------------
    -- First_Element --
    -------------------
@@ -937,11 +956,7 @@ package body Ada.Containers.Vectors is
 
    function Has_Element (Position : Cursor) return Boolean is
    begin
-      if Position.Container = null then
-         return False;
-      end if;
-
-      return Position.Index <= Position.Container.Last;
+      return Position /= No_Element;
    end Has_Element;
 
    ------------
@@ -2018,6 +2033,23 @@ package body Ada.Containers.Vectors is
       B := B - 1;
    end Iterate;
 
+   function Iterate (Container : Vector)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'class
+   is
+      It : constant Iterator := (Container'Unchecked_Access, Index_Type'First);
+   begin
+      return It;
+   end Iterate;
+
+   function Iterate (Container : Vector; Start : Cursor)
+      return Vector_Iterator_Interfaces.Forward_Iterator'class
+   is
+      It : constant Iterator :=
+             (Container'Unchecked_Access, Start.Index);
+   begin
+      return It;
+   end Iterate;
+
    ----------
    -- Last --
    ----------
@@ -2031,6 +2063,12 @@ package body Ada.Containers.Vectors is
       return (Container'Unchecked_Access, Container.Last);
    end Last;
 
+   function Last (Object : Iterator) return Cursor is
+      C : constant Cursor := (Object.Container, Object.Container.Last);
+   begin
+      return C;
+   end Last;
+
    ------------------
    -- Last_Element --
    ------------------
@@ -2138,6 +2176,17 @@ package body Ada.Containers.Vectors is
       return No_Element;
    end Next;
 
+   function Next (Object : Iterator; Position : Cursor) return Cursor
+   is
+   begin
+      if Position.Index = Object.Container.Last then
+         return  No_Element;
+
+      else
+         return (Object.Container, Position.Index + 1);
+      end if;
+   end Next;
+
    ----------
    -- Next --
    ----------
@@ -2206,6 +2255,16 @@ package body Ada.Containers.Vectors is
       return No_Element;
    end Previous;
 
+   function Previous (Object : Iterator; Position : Cursor) return Cursor
+   is
+   begin
+      if Position.Index > Index_Type'First then
+         return (Object.Container, Position.Index - 1);
+      else
+         return No_Element;
+      end if;
+   end Previous;
+
    -------------------
    -- Query_Element --
    -------------------
@@ -2287,6 +2346,83 @@ package body Ada.Containers.Vectors is
       raise Program_Error with "attempt to stream vector cursor";
    end Read;
 
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Read;
+
+   ---------------
+   -- Reference --
+   ---------------
+
+   function Constant_Reference
+     (Container : Vector; Position : Cursor)    --  SHOULD BE ALIASED
+   return Constant_Reference_Type is
+   begin
+      pragma Unreferenced (Container);
+
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      if Position.Index > Position.Container.Last then
+         raise Constraint_Error with "Position cursor is out of range";
+      end if;
+
+      return
+       (Element =>
+          Position.Container.Elements.EA (Position.Index)'Access);
+   end Constant_Reference;
+
+   function Constant_Reference
+     (Container : Vector; Position : Index_Type)
+   return Constant_Reference_Type is
+   begin
+      if (Position) > Container.Last then
+         raise Constraint_Error with "Index is out of range";
+      end if;
+
+      return (Element => Container.Elements.EA (Position)'Access);
+   end Constant_Reference;
+
+   function Reference (Container : Vector; Position : Cursor)
+   return Reference_Type is
+   begin
+      pragma Unreferenced (Container);
+
+      if Position.Container = null then
+         raise Constraint_Error with "Position cursor has no element";
+      end if;
+
+      if Position.Index > Position.Container.Last then
+         raise Constraint_Error with "Position cursor is out of range";
+      end if;
+
+      return
+        (Element => Position.Container.Elements.EA (Position.Index)'Access);
+   end Reference;
+
+   function Reference (Container : Vector; Position : Index_Type)
+   return Reference_Type is
+   begin
+      if Position > Container.Last then
+         raise Constraint_Error with "Index is out of range";
+      end if;
+
+      return (Element => Container.Elements.EA (Position)'Access);
+   end Reference;
+
    ---------------------
    -- Replace_Element --
    ---------------------
@@ -3117,4 +3253,20 @@ package body Ada.Containers.Vectors is
       raise Program_Error with "attempt to stream vector cursor";
    end Write;
 
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type)
+   is
+   begin
+      raise Program_Error with "attempt to stream reference";
+   end Write;
+
 end Ada.Containers.Vectors;

gcc/ada/a-convec.ads

@@ -32,8 +32,8 @@
 ------------------------------------------------------------------------------
 
 private with Ada.Finalization;
-private with Ada.Streams;
-
+with Ada.Streams;
+with Ada.Iterator_Interfaces;
 generic
    type Index_Type is range <>;
    type Element_Type is private;
@@ -43,6 +43,7 @@ generic
 package Ada.Containers.Vectors is
    pragma Preelaborate;
    pragma Remote_Types;
+   use Ada.Streams;
 
    subtype Extended_Index is Index_Type'Base
      range Index_Type'First - 1 ..
@@ -50,15 +51,35 @@ package Ada.Containers.Vectors is
 
    No_Index : constant Extended_Index := Extended_Index'First;
 
-   type Vector is tagged private;
+   type Vector is tagged private
+   with
+      Constant_Indexing => Constant_Reference,
+      Variable_Indexing => Reference,
+      Default_Iterator  => Iterate,
+      Iterator_Element  => Element_Type;
    pragma Preelaborable_Initialization (Vector);
 
    type Cursor is private;
    pragma Preelaborable_Initialization (Cursor);
+   No_Element : constant Cursor;
 
-   Empty_Vector : constant Vector;
+   function Has_Element (Position : Cursor) return Boolean;
 
-   No_Element : constant Cursor;
+   procedure Read
+     (Stream   : not null access Root_Stream_Type'Class;
+      Position : out Cursor);
+
+   for Cursor'Read use Read;
+
+   procedure Write
+     (Stream   : not null access Root_Stream_Type'Class;
+      Position : Cursor);
+   for Cursor'Write use Write;
+
+   package Vector_Iterator_Interfaces is new
+      Ada.Iterator_Interfaces (Cursor, Has_Element);
+
+   Empty_Vector : constant Vector;
 
    overriding function "=" (Left, Right : Vector) return Boolean;
 
@@ -133,8 +154,55 @@ package Ada.Containers.Vectors is
       Position  : Cursor;
       Process   : not null access procedure (Element : in out Element_Type));
 
-   procedure Move (Target : in out Vector; Source : in out Vector);
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is
+   private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Constant_Reference_Type);
+
+   for Constant_Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Constant_Reference_Type);
+
+   for Constant_Reference_Type'Read use Read;
+
+   type Reference_Type (Element : not null access Element_Type) is private
+   with
+      Implicit_Dereference => Element;
+
+   procedure Write
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : Reference_Type);
+
+   for Reference_Type'Write use Write;
+
+   procedure Read
+     (Stream : not null access Root_Stream_Type'Class;
+      Item   : out Reference_Type);
+
+   for Reference_Type'Read use Read;
+
+   function Constant_Reference
+     (Container : Vector; Position : Cursor)    --  SHOULD BE ALIASED
+   return Constant_Reference_Type;
 
+   function Constant_Reference
+     (Container : Vector; Position : Index_Type)
+   return Constant_Reference_Type;
+
+   function Reference (Container : Vector; Position : Cursor)
+   return Reference_Type;
+
+   function Reference (Container : Vector; Position : Index_Type)
+   return Reference_Type;
+
+   procedure Move (Target : in out Vector; Source : in out Vector);
    procedure Insert
      (Container : in out Vector;
       Before    : Extended_Index;
@@ -278,8 +346,6 @@ package Ada.Containers.Vectors is
      (Container : Vector;
       Item      : Element_Type) return Boolean;
 
-   function Has_Element (Position : Cursor) return Boolean;
-
    procedure Iterate
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor));
@@ -288,6 +354,12 @@ package Ada.Containers.Vectors is
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor));
 
+   function Iterate (Container : Vector)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'class;
+
+   function Iterate (Container : Vector; Start : Cursor)
+      return Vector_Iterator_Interfaces.Forward_Iterator'class;
+
    generic
       with function "<" (Left, Right : Element_Type) return Boolean is <>;
    package Generic_Sorting is
@@ -315,7 +387,7 @@ private
    pragma Inline (Next);
    pragma Inline (Previous);
 
-   type Elements_Array is array (Index_Type range <>) of Element_Type;
+   type Elements_Array is array (Index_Type range <>) of aliased Element_Type;
    function "=" (L, R : Elements_Array) return Boolean is abstract;
 
    type Elements_Type (Last : Index_Type) is limited record
@@ -333,11 +405,13 @@ private
       Lock     : Natural := 0;
    end record;
 
-   overriding procedure Adjust (Container : in out Vector);
-
-   overriding procedure Finalize (Container : in out Vector);
+   type Vector_Access is access constant Vector;
+   for Vector_Access'Storage_Size use 0;
 
-   use Ada.Streams;
+   type Cursor is record
+      Container   : Vector_Access;
+      Index       : Index_Type := Index_Type'First;
+   end record;
 
    procedure Write
      (Stream    : not null access Root_Stream_Type'Class;
@@ -351,28 +425,17 @@ private
 
    for Vector'Read use Read;
 
-   type Vector_Access is access constant Vector;
-   for Vector_Access'Storage_Size use 0;
-
-   type Cursor is record
-      Container : Vector_Access;
-      Index     : Index_Type := Index_Type'First;
-   end record;
-
-   procedure Write
-     (Stream   : not null access Root_Stream_Type'Class;
-      Position : Cursor);
+   type Constant_Reference_Type
+      (Element : not null access constant Element_Type) is null record;
 
-   for Cursor'Write use Write;
+   type Reference_Type
+      (Element : not null access Element_Type) is null record;
 
-   procedure Read
-     (Stream   : not null access Root_Stream_Type'Class;
-      Position : out Cursor);
+   overriding procedure Adjust (Container : in out Vector);
 
-   for Cursor'Read use Read;
+   overriding procedure Finalize (Container : in out Vector);
 
+   No_Element   : constant Cursor := Cursor'(null, Index_Type'First);
    Empty_Vector : constant Vector := (Controlled with null, No_Index, 0, 0);
 
-   No_Element : constant Cursor := Cursor'(null, Index_Type'First);
-
 end Ada.Containers.Vectors;

gcc/ada/a-iteint.ads

@@ -6,32 +6,45 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
+--          Copyright (C) 2004-2011, Free Software Foundation, Inc.         --
+--                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
--- GNAT.  In accordance with the copyright of that document, you can freely --
--- copy and modify this specification,  provided that if you redistribute a --
--- modified version,  any changes that you have made are clearly indicated. --
+-- GNAT. The copyright notice above, and the license provisions that follow --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
 --                                                                          --
 ------------------------------------------------------------------------------
 
 generic
-   type Cursor is private;
-   No_Element : Cursor;
-   pragma Unreferenced (No_Element);
-
+   type Cursor;
+   with function Has_Element (Position : Cursor) return Boolean;
 package Ada.Iterator_Interfaces is
-   type Forward_Iterator is limited interface;
+   pragma Pure;
 
+   type Forward_Iterator is limited interface;
    function First (Object : Forward_Iterator) return Cursor is abstract;
-
    function Next
-     (Object : Forward_Iterator;
+     (Object   : Forward_Iterator;
       Position : Cursor) return Cursor is abstract;
-
    type Reversible_Iterator is limited interface and Forward_Iterator;
 
    function Last (Object : Reversible_Iterator) return Cursor is abstract;
-
    function Previous
-     (Object : Reversible_Iterator;
+     (Object   : Reversible_Iterator;
       Position : Cursor) return Cursor is abstract;
 end Ada.Iterator_Interfaces;

gcc/ada/a-undesu.adb

@@ -8,15 +8,27 @@
 --                                                                          --
 --            Copyright (C) 2011, Free Software Foundation, Inc.            --
 --                                                                          --
--- This specification is derived from the Ada Reference Manual for use with --
--- GNAT.  In accordance with the copyright of that document, you can freely --
--- copy and modify this specification,  provided that if you redistribute a --
--- modified version,  any changes that you have made are clearly indicated. --
+-- 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- --
+-- ware  Foundation;  either version 3,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
+--                                                                          --
+-- As a special exception under Section 7 of GPL version 3, you are granted --
+-- additional permissions described in the GCC Runtime Library Exception,   --
+-- version 3.1, as published by the Free Software Foundation.               --
+--                                                                          --
+-- You should have received a copy of the GNU General Public License and    --
+-- a copy of the GCC Runtime Library Exception along with this program;     --
+-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
+-- <http://www.gnu.org/licenses/>.                                          --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  ??? What is the header version here, see a-uncdea.adb. No GPL?
-
 with System.Storage_Pools.Subpools,
      System.Storage_Pools.Subpools.Finalization;
 

gcc/ada/a-undesu.ads

@@ -6,8 +6,6 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---            Copyright (C) 2011, Free Software Foundation, Inc.            --
---                                                                          --
 -- This specification is derived from the Ada Reference Manual for use with --
 -- GNAT.  In accordance with the copyright of that document, you can freely --
 -- copy and modify this specification,  provided that if you redistribute a --
@@ -15,8 +13,6 @@
 --                                                                          --
 ------------------------------------------------------------------------------
 
---  ??? What is the header version here, see a-uncdea.ads. No GPL?
-
 with System.Storage_Pools.Subpools;
 
 procedure Ada.Unchecked_Deallocate_Subpool

gcc/ada/exp_ch3.adb

@@ -5483,7 +5483,7 @@ package body Exp_Ch3 is
                end if;
 
             --  ??? Now that masters acts as heterogeneous lists, it might be
-            --  worthed to revisit the global master approach.
+            --  worthwhile to revisit the global master approach.
 
             elsif Ekind (Comp_Typ) = E_Anonymous_Access_Type
               and then Needs_Finalization (Directly_Designated_Type (Comp_Typ))

gcc/ada/exp_disp.adb

@@ -3698,6 +3698,46 @@ package body Exp_Disp is
          Typ         : Entity_Id)
       is
          Comp : Entity_Id;
+         function Is_Actual_For_Formal_Incomplete_Type (T : Entity_Id)
+            return Boolean;
+         --  In Ada2012, if a nested generic has an incomplete formal type, the
+         --  actual may be (and usually is) a private type whose completion
+         --  appears later. It is safe to build the dispatch table in this
+         --  case, gigi will have full views available.
+
+         ------------------------------------------
+         -- Is_Actual_For_Formal_Incomplete_Type --
+         ------------------------------------------
+
+         function Is_Actual_For_Formal_Incomplete_Type (T : Entity_Id)
+            return Boolean
+         is
+            Gen_Par : Entity_Id;
+            F       : Node_Id;
+         begin
+            if not Is_Generic_Instance (Current_Scope)
+              or else not Used_As_Generic_Actual (T)
+            then
+               return False;
+
+            else
+               Gen_Par := Generic_Parent (Parent (Current_Scope));
+            end if;
+
+            F :=
+              First
+                (Generic_Formal_Declarations
+                     (Unit_Declaration_Node (Gen_Par)));
+            while Present (F) loop
+               if Ekind (Defining_Identifier (F)) = E_Incomplete_Type then
+                  return True;
+               end if;
+
+               Next (F);
+            end loop;
+
+            return False;
+         end Is_Actual_For_Formal_Incomplete_Type;
 
       begin
          if Present (N)
@@ -3720,6 +3760,8 @@ package body Exp_Disp is
             if not Is_Tagged_Type (Typ)
               and then Present (Comp)
               and then not Is_Frozen (Comp)
+              and then
+               not Is_Actual_For_Formal_Incomplete_Type (Comp)
             then
                Error_Msg_Sloc := Sloc (Subp);
                Error_Msg_Node_2 := Subp;

gcc/ada/s-stposu.adb

@@ -8,10 +8,6 @@
 --                                                                          --
 --            Copyright (C) 2011, 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 --
--- apply solely to the  contents of the part following the private keyword. --
---                                                                          --
 -- 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- --
 -- ware  Foundation;  either version 3,  or (at your option) any later ver- --
@@ -259,6 +255,7 @@ package body System.Storage_Pools.Subpools is
          --  object. This operation effectively hides the list header.
 
          Addr := N_Addr + Header_And_Padding;
+
       else
          Addr := N_Addr;
       end if;
@@ -346,6 +343,7 @@ package body System.Storage_Pools.Subpools is
          --  hidden list header.
 
          N_Size := Storage_Size + Header_And_Padding;
+
       else
          N_Addr := Addr;
          N_Size := Storage_Size;

gcc/ada/sem_ch6.adb

@@ -2348,7 +2348,7 @@ package body Sem_Ch6 is
          --  the proper back-annotations.
 
          if not Is_Frozen (Spec_Id)
-           and then (Expander_Active or else ASIS_Mode)
+           and then (Expander_Active or ASIS_Mode)
          then
             --  Force the generation of its freezing node to ensure proper
             --  management of access types in the backend.