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

	* a-cbhama.adb, a-cbhama.ads, a-cborma.adb, a-cborma.ads, a-cobove.adb,
	a-cobove.ads, a-coorma.adb, a-coorma.ads: Add iterator machinery to
	container packages.



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

1 files changed, 164 insertions, 3 deletions

diff --git a/gcc/ada/a-cobove.adb b/gcc/ada/a-cobove.adb
index eaef697d36c..e4b46f26012 100644
--- a/gcc/ada/a-cobove.adb
+++ b/gcc/ada/a-cobove.adb
@@ -32,6 +32,23 @@ with System; use type System.Address;
 
 package body Ada.Containers.Bounded_Vectors is
 
+   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;
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -701,6 +718,15 @@ package body Ada.Containers.Bounded_Vectors is
       return (Container'Unrestricted_Access, Index_Type'First);
    end First;
 
+   function First (Object : Iterator) return Cursor is
+   begin
+      if Is_Empty (Object.Container.all) then
+         return No_Element;
+      end if;
+
+      return  Cursor'(Object.Container, Index_Type'First);
+   end First;
+
    -------------------
    -- First_Element --
    -------------------
@@ -1589,6 +1615,20 @@ package body Ada.Containers.Bounded_Vectors is
       B := B - 1;
    end Iterate;
 
+   function Iterate (Container : Vector)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'Class
+   is
+   begin
+      return Iterator'(Container'Unrestricted_Access, Index_Type'First);
+   end Iterate;
+
+   function Iterate (Container : Vector; Start : Cursor)
+      return Vector_Iterator_Interfaces.Reversible_Iterator'class
+   is
+   begin
+      return Iterator'(Container'Unrestricted_Access, Start.Index);
+   end Iterate;
+
    ----------
    -- Last --
    ----------
@@ -1602,6 +1642,15 @@ package body Ada.Containers.Bounded_Vectors is
       return (Container'Unrestricted_Access, Container.Last);
    end Last;
 
+   function Last (Object : Iterator) return Cursor is
+   begin
+      if Is_Empty (Object.Container.all) then
+         return No_Element;
+      end if;
+
+      return Cursor'(Object.Container, Object.Container.Last);
+   end Last;
+
    ------------------
    -- Last_Element --
    ------------------
@@ -1713,9 +1762,14 @@ package body Ada.Containers.Bounded_Vectors is
       return No_Element;
    end Next;
 
-   ----------
-   -- 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;
 
    procedure Next (Position : in out Cursor) is
    begin
@@ -1781,6 +1835,15 @@ package body Ada.Containers.Bounded_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 --
    -------------------
@@ -1860,6 +1923,88 @@ package body Ada.Containers.Bounded_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
+            (To_Array_Index (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 (To_Array_Index (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
+             (To_Array_Index (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 (To_Array_Index (Position))'Unrestricted_Access);
+   end Reference;
+
    ---------------------
    -- Replace_Element --
    ---------------------
@@ -2436,4 +2581,20 @@ package body Ada.Containers.Bounded_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.Bounded_Vectors;