OSDN Git Service

2011-12-02 Thomas Quinot <quinot@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / a-cohase.adb
index c5d5966..fadff19 100644 (file)
@@ -6,25 +6,23 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2008, 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- --
--- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- 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.  See the GNU General Public License --
--- for  more details.  You should have  received  a copy of the GNU General --
--- Public License  distributed with GNAT;  see file COPYING.  If not, write --
--- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
--- Boston, MA 02110-1301, USA.                                              --
+-- or FITNESS FOR A PARTICULAR PURPOSE.                                     --
 --                                                                          --
--- As a special exception,  if other files  instantiate  generics from this --
--- unit, or you link  this unit with other files  to produce an executable, --
--- this  unit  does not  by itself cause  the resulting  executable  to  be --
--- covered  by the  GNU  General  Public  License.  This exception does not --
--- however invalidate  any other reasons why  the executable file  might be --
--- covered by the  GNU Public License.                                      --
+-- 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/>.                                          --
 --                                                                          --
 -- This unit was originally developed by Matthew J Heaney.                  --
 ------------------------------------------------------------------------------
@@ -43,6 +41,17 @@ with System; use type System.Address;
 
 package body Ada.Containers.Hashed_Sets is
 
+   type Iterator is limited new
+     Set_Iterator_Interfaces.Forward_Iterator with record
+        Container : Set_Access;
+     end record;
+
+   overriding function First (Object : Iterator) return Cursor;
+
+   overriding function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor;
+
    -----------------------
    -- Local Subprograms --
    -----------------------
@@ -161,6 +170,16 @@ package body Ada.Containers.Hashed_Sets is
       Node.Element := Item;
    end Assign;
 
+   procedure Assign (Target : in out Set; Source : Set) is
+   begin
+      if Target'Address = Source'Address then
+         return;
+      end if;
+
+      Target.Clear;
+      Target.Union (Source);
+   end Assign;
+
    --------------
    -- Capacity --
    --------------
@@ -188,6 +207,34 @@ package body Ada.Containers.Hashed_Sets is
       return Find (Container, Item) /= No_Element;
    end Contains;
 
+   ----------
+   -- Copy --
+   ----------
+
+   function Copy
+     (Source   : Set;
+      Capacity : Count_Type := 0) return Set
+   is
+      C : Count_Type;
+
+   begin
+      if Capacity = 0 then
+         C := Source.Length;
+
+      elsif Capacity >= Source.Length then
+         C := Capacity;
+
+      else
+         raise Capacity_Error
+           with "Requested capacity is less than Source length";
+      end if;
+
+      return Target : Set do
+         Target.Reserve_Capacity (C);
+         Target.Assign (Source);
+      end return;
+   end Copy;
+
    ---------------
    -- Copy_Node --
    ---------------
@@ -232,7 +279,7 @@ package body Ada.Containers.Hashed_Sets is
 
       if Container.HT.Busy > 0 then
          raise Program_Error with
-           "attempt to tamper with elements (set is busy)";
+           "attempt to tamper with cursors (set is busy)";
       end if;
 
       pragma Assert (Vet (Position), "bad cursor in Delete");
@@ -265,7 +312,7 @@ package body Ada.Containers.Hashed_Sets is
 
       if Target.HT.Busy > 0 then
          raise Program_Error with
-           "attempt to tamper with elements (set is busy)";
+           "attempt to tamper with cursors (set is busy)";
       end if;
 
       if Source.HT.Length < Target.HT.Length then
@@ -565,6 +612,11 @@ package body Ada.Containers.Hashed_Sets is
       return Cursor'(Container'Unrestricted_Access, Node);
    end First;
 
+   function First (Object : Iterator) return Cursor is
+   begin
+      return Object.Container.First;
+   end First;
+
    ----------
    -- Free --
    ----------
@@ -616,7 +668,7 @@ package body Ada.Containers.Hashed_Sets is
       if not Inserted then
          if Container.HT.Lock > 0 then
             raise Program_Error with
-              "attempt to tamper with cursors (set is locked)";
+              "attempt to tamper with elements (set is locked)";
          end if;
 
          Position.Node.Element := New_Item;
@@ -715,7 +767,7 @@ package body Ada.Containers.Hashed_Sets is
 
       if Target.HT.Busy > 0 then
          raise Program_Error with
-           "attempt to tamper with elements (set is busy)";
+           "attempt to tamper with cursors (set is busy)";
       end if;
 
       Tgt_Node := HT_Ops.First (Target.HT);
@@ -884,6 +936,13 @@ package body Ada.Containers.Hashed_Sets is
       B := B - 1;
    end Iterate;
 
+   function Iterate
+     (Container : Set) return Set_Iterator_Interfaces.Forward_Iterator'Class
+   is
+   begin
+      return Iterator'(Container => Container'Unrestricted_Access);
+   end Iterate;
+
    ------------
    -- Length --
    ------------
@@ -937,6 +996,23 @@ package body Ada.Containers.Hashed_Sets is
       Position := Next (Position);
    end Next;
 
+   function Next
+     (Object   : Iterator;
+      Position : Cursor) return Cursor
+   is
+   begin
+      if Position.Container = null then
+         return No_Element;
+      end if;
+
+      if Position.Container /= Object.Container then
+         raise Program_Error with
+           "Position cursor of Next designates wrong set";
+      end if;
+
+      return Next (Position);
+   end Next;
+
    -------------
    -- Overlap --
    -------------
@@ -1061,7 +1137,7 @@ package body Ada.Containers.Hashed_Sets is
 
       if Container.HT.Lock > 0 then
          raise Program_Error with
-           "attempt to tamper with cursors (set is locked)";
+           "attempt to tamper with elements (set is locked)";
       end if;
 
       Node.Element := New_Item;
@@ -1125,7 +1201,7 @@ package body Ada.Containers.Hashed_Sets is
 
       if Target.HT.Busy > 0 then
          raise Program_Error with
-           "attempt to tamper with elements (set is busy)";
+           "attempt to tamper with cursors (set is busy)";
       end if;
 
       declare
@@ -1394,7 +1470,7 @@ package body Ada.Containers.Hashed_Sets is
 
       if Target.HT.Busy > 0 then
          raise Program_Error with
-           "attempt to tamper with elements (set is busy)";
+           "attempt to tamper with cursors (set is busy)";
       end if;
 
       declare
@@ -1659,7 +1735,7 @@ package body Ada.Containers.Hashed_Sets is
 
       begin
          if Node = null then
-            raise Constraint_Error with "key not in map";
+            raise Constraint_Error with "key not in map";  -- ??? "set"
          end if;
 
          return Node.Element;