a-crbtgo.ads, [...]: Compiles against the spec for ordered maps described in…

a-crbtgo.ads, [...]: Compiles against the spec for ordered maps described in sections A.18.6 of the...

2005-11-14  Matthew Heaney  <heaney@adacore.com>

	* a-crbtgo.ads, a-crbtgo.adb, a-coorse.ads, a-coorse.adb, a-convec.ads, 
	a-convec.adb, a-coinve.ads, a-coinve.adb, a-cohama.ads, a-cohama.adb, 
	a-ciorse.ads, a-ciorse.adb, a-cihama.ads, a-cihama.adb, a-cidlli.ads, 
	a-cidlli.adb, a-cdlili.ads, a-cdlili.adb, a-coormu.adb, a-ciormu.adb, 
	a-cihase.adb, a-cihase.ads, a-cohase.adb, a-cohase.ads, a-ciorma.ads, 
	a-coorma.ads, a-ciormu.ads, a-coormu.ads, a-ciorma.adb, a-coorma.adb: 
	Compiles against the spec for ordered maps described in sections
	A.18.6 of the most recent (August 2005) AI-302 draft.

From-SVN: r106962

gcc/ada/a-cdlili.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -34,6 +34,7 @@
 ------------------------------------------------------------------------------
 
 with System;  use type System.Address;
+
 with Ada.Unchecked_Deallocation;
 
 package body Ada.Containers.Doubly_Linked_Lists is
@@ -129,7 +130,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
    procedure Append
      (Container : in out List;
       New_Item  : Element_Type;
-      Count     : Count_Type := 1) is
+      Count     : Count_Type := 1)
+   is
    begin
       Insert (Container, No_Element, New_Item, Count);
    end Append;
@@ -185,7 +187,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
    function Contains
      (Container : List;
-      Item      : Element_Type) return Boolean is
+      Item      : Element_Type) return Boolean
+   is
    begin
       return Find (Container, Item) /= No_Element;
    end Contains;
@@ -202,8 +205,6 @@ package body Ada.Containers.Doubly_Linked_Lists is
       X : Node_Access;
 
    begin
-      pragma Assert (Vet (Position), "bad cursor in Delete");
-
       if Position.Node = null then
          raise Constraint_Error;
       end if;
@@ -212,13 +213,16 @@ package body Ada.Containers.Doubly_Linked_Lists is
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Delete");
+
       if Position.Node = Container.First then
          Delete_First (Container, Count);
-         Position := First (Container);
+         Position := No_Element; --  Post-York behavior
          return;
       end if;
 
       if Count = 0 then
+         Position := No_Element;  --  Post-York behavior
          return;
       end if;
 
@@ -247,6 +251,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
          Free (X);
       end loop;
+
+      Position := No_Element;  --  Post-York behavior
    end Delete;
 
    ------------------
@@ -329,12 +335,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
    function Element (Position : Cursor) return Element_Type is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Element");
-
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Element");
+
       return Position.Node.Element;
    end Element;
 
@@ -354,11 +360,11 @@ package body Ada.Containers.Doubly_Linked_Lists is
          Node := Container.First;
 
       else
-         pragma Assert (Vet (Position), "bad cursor in Find");
-
          if Position.Container /= Container'Unrestricted_Access then
             raise Program_Error;
          end if;
+
+         pragma Assert (Vet (Position), "bad cursor in Find");
       end if;
 
       while Node /= null loop
@@ -604,12 +610,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
       New_Node : Node_Access;
 
    begin
-      pragma Assert (Vet (Before), "bad cursor in Insert");
+      if Before.Container /= null then
+         if Before.Container /= Container'Unrestricted_Access then
+            raise Program_Error;
+         end if;
 
-      if Before.Container /= null
-        and then Before.Container /= Container'Unrestricted_Access
-      then
-         raise Program_Error;
+         pragma Assert (Vet (Before), "bad cursor in Insert");
       end if;
 
       if Count = 0 then
@@ -656,12 +662,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
       New_Node : Node_Access;
 
    begin
-      pragma Assert (Vet (Before), "bad cursor in Insert");
+      if Before.Container /= null then
+         if Before.Container /= Container'Unrestricted_Access then
+            raise Program_Error;
+         end if;
 
-      if Before.Container /= null
-        and then Before.Container /= Container'Unrestricted_Access
-      then
-         raise Program_Error;
+         pragma Assert (Vet (Before), "bad cursor in Insert");
       end if;
 
       if Count = 0 then
@@ -937,12 +943,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
       Process  : not null access procedure (Element : in Element_Type))
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Query_Element");
-
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Query_Element");
+
       declare
          C : List renames Position.Container.all'Unrestricted_Access.all;
          B : Natural renames C.Busy;
@@ -1018,97 +1024,46 @@ package body Ada.Containers.Doubly_Linked_Lists is
       end loop;
    end Read;
 
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Read;
+
    ---------------------
    -- Replace_Element --
    ---------------------
 
    procedure Replace_Element
-     (Position : Cursor;
-      By       : Element_Type)
+     (Container : in out List;
+      Position  : Cursor;
+      New_Item  : Element_Type)
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
-
       if Position.Container = null then
          raise Constraint_Error;
       end if;
 
-      if Position.Container.Lock > 0 then
+      if Position.Container /= Container'Unchecked_Access then
          raise Program_Error;
       end if;
 
-      Position.Node.Element := By;
-   end Replace_Element;
-
-   ------------------
-   -- Reverse_Find --
-   ------------------
-
-   function Reverse_Find
-     (Container : List;
-      Item      : Element_Type;
-      Position  : Cursor := No_Element) return Cursor
-   is
-      Node : Node_Access := Position.Node;
-
-   begin
-      if Node = null then
-         Node := Container.Last;
-
-      else
-         pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
-
-         if Position.Container /= Container'Unrestricted_Access then
-            raise Program_Error;
-         end if;
+      if Container.Lock > 0 then
+         raise Program_Error;
       end if;
 
-      while Node /= null loop
-         if Node.Element = Item then
-            return Cursor'(Container'Unchecked_Access, Node);
-         end if;
-
-         Node := Node.Prev;
-      end loop;
-
-      return No_Element;
-   end Reverse_Find;
-
-   ---------------------
-   -- Reverse_Iterate --
-   ---------------------
-
-   procedure Reverse_Iterate
-     (Container : List;
-      Process   : not null access procedure (Position : Cursor))
-   is
-      C : List renames Container'Unrestricted_Access.all;
-      B : Natural renames C.Busy;
-
-      Node : Node_Access := Container.Last;
-
-   begin
-      B := B + 1;
-
-      begin
-         while Node /= null loop
-            Process (Cursor'(Container'Unchecked_Access, Node));
-            Node := Node.Prev;
-         end loop;
-      exception
-         when others =>
-            B := B - 1;
-            raise;
-      end;
+      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
 
-      B := B - 1;
-   end Reverse_Iterate;
+      Position.Node.Element := New_Item;
+   end Replace_Element;
 
-   ------------------
-   -- Reverse_List --
-   ------------------
+   ----------------------
+   -- Reverse_Elements --
+   ----------------------
 
-   procedure Reverse_List (Container : in out List) is
+   procedure Reverse_Elements (Container : in out List) is
       I : Node_Access := Container.First;
       J : Node_Access := Container.Last;
 
@@ -1152,7 +1107,7 @@ package body Ada.Containers.Doubly_Linked_Lists is
          end if;
       end Swap;
 
-   --  Start of processing for Reverse_List
+   --  Start of processing for Reverse_Elements
 
    begin
       if Container.Length <= 1 then
@@ -1188,7 +1143,72 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
       pragma Assert (Container.First.Prev = null);
       pragma Assert (Container.Last.Next = null);
-   end Reverse_List;
+   end Reverse_Elements;
+
+   ------------------
+   -- Reverse_Find --
+   ------------------
+
+   function Reverse_Find
+     (Container : List;
+      Item      : Element_Type;
+      Position  : Cursor := No_Element) return Cursor
+   is
+      Node : Node_Access := Position.Node;
+
+   begin
+      if Node = null then
+         Node := Container.Last;
+
+      else
+         if Position.Container /= Container'Unrestricted_Access then
+            raise Program_Error;
+         end if;
+
+         pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
+      end if;
+
+      while Node /= null loop
+         if Node.Element = Item then
+            return Cursor'(Container'Unchecked_Access, Node);
+         end if;
+
+         Node := Node.Prev;
+      end loop;
+
+      return No_Element;
+   end Reverse_Find;
+
+   ---------------------
+   -- Reverse_Iterate --
+   ---------------------
+
+   procedure Reverse_Iterate
+     (Container : List;
+      Process   : not null access procedure (Position : Cursor))
+   is
+      C : List renames Container'Unrestricted_Access.all;
+      B : Natural renames C.Busy;
+
+      Node : Node_Access := Container.Last;
+
+   begin
+      B := B + 1;
+
+      begin
+         while Node /= null loop
+            Process (Cursor'(Container'Unchecked_Access, Node));
+            Node := Node.Prev;
+         end loop;
+
+      exception
+         when others =>
+            B := B - 1;
+            raise;
+      end;
+
+      B := B - 1;
+   end Reverse_Iterate;
 
    ------------
    -- Splice --
@@ -1200,12 +1220,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
       Source : in out List)
    is
    begin
-      pragma Assert (Vet (Before), "bad cursor in Splice");
+      if Before.Container /= null then
+         if Before.Container /= Target'Unrestricted_Access then
+            raise Program_Error;
+         end if;
 
-      if Before.Container /= null
-        and then Before.Container /= Target'Unrestricted_Access
-      then
-         raise Program_Error;
+         pragma Assert (Vet (Before), "bad cursor in Splice");
       end if;
 
       if Target'Address = Source'Address
@@ -1274,13 +1294,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
       Position : Cursor)
    is
    begin
-      pragma Assert (Vet (Before), "bad Before cursor in Splice");
-      pragma Assert (Vet (Position), "bad Position cursor in Splice");
+      if Before.Container /= null then
+         if Before.Container /= Target'Unchecked_Access then
+            raise Program_Error;
+         end if;
 
-      if Before.Container /= null
-        and then Before.Container /= Target'Unchecked_Access
-      then
-         raise Program_Error;
+         pragma Assert (Vet (Before), "bad Before cursor in Splice");
       end if;
 
       if Position.Node = null then
@@ -1291,6 +1310,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (Position), "bad Position cursor in Splice");
+
       if Position.Node = Before.Node
         or else Position.Node.Next = Before.Node
       then
@@ -1378,13 +1399,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
          return;
       end if;
 
-      pragma Assert (Vet (Before), "bad Before cursor in Splice");
-      pragma Assert (Vet (Position), "bad Position cursor in Splice");
+      if Before.Container /= null then
+         if Before.Container /= Target'Unrestricted_Access then
+            raise Program_Error;
+         end if;
 
-      if Before.Container /= null
-        and then Before.Container /= Target'Unrestricted_Access
-      then
-         raise Program_Error;
+         pragma Assert (Vet (Before), "bad Before cursor in Splice");
       end if;
 
       if Position.Node = null then
@@ -1395,6 +1415,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (Position), "bad Position cursor in Splice");
+
       if Target.Length = Count_Type'Last then
          raise Constraint_Error;
       end if;
@@ -1474,18 +1496,20 @@ package body Ada.Containers.Doubly_Linked_Lists is
    -- Swap --
    ----------
 
-   procedure Swap (I, J : Cursor) is
+   procedure Swap
+     (Container : in out List;
+      I, J      : Cursor)
+   is
    begin
-      pragma Assert (Vet (I), "bad I cursor in Swap");
-      pragma Assert (Vet (J), "bad J cursor in Swap");
-
       if I.Node = null
         or else J.Node = null
       then
          raise Constraint_Error;
       end if;
 
-      if I.Container /= J.Container then
+      if I.Container /= Container'Unchecked_Access
+        or else J.Container /= Container'Unchecked_Access
+      then
          raise Program_Error;
       end if;
 
@@ -1493,15 +1517,19 @@ package body Ada.Containers.Doubly_Linked_Lists is
          return;
       end if;
 
-      if I.Container.Lock > 0 then
+      if Container.Lock > 0 then
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (I), "bad I cursor in Swap");
+      pragma Assert (Vet (J), "bad J cursor in Swap");
+
       declare
          EI : Element_Type renames I.Node.Element;
          EJ : Element_Type renames J.Node.Element;
 
          EI_Copy : constant Element_Type := EI;
+
       begin
          EI := EJ;
          EJ := EI_Copy;
@@ -1514,11 +1542,9 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
    procedure Swap_Links
      (Container : in out List;
-      I, J      : Cursor) is
+      I, J      : Cursor)
+   is
    begin
-      pragma Assert (Vet (I), "bad I cursor in Swap_Links");
-      pragma Assert (Vet (J), "bad J cursor in Swap_Links");
-
       if I.Node = null
         or else J.Node = null
       then
@@ -1539,6 +1565,9 @@ package body Ada.Containers.Doubly_Linked_Lists is
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (I), "bad I cursor in Swap_Links");
+      pragma Assert (Vet (J), "bad J cursor in Swap_Links");
+
       declare
          I_Next : constant Cursor := Next (I);
 
@@ -1570,20 +1599,24 @@ package body Ada.Containers.Doubly_Linked_Lists is
    --------------------
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access procedure (Element : in out Element_Type))
+     (Container : in out List;
+      Position  : Cursor;
+      Process   : not null access procedure (Element : in out Element_Type))
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Update_Element");
-
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
+      if Position.Container /= Container'Unchecked_Access then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Position), "bad cursor in Update_Element");
+
       declare
-         C : List renames Position.Container.all'Unrestricted_Access.all;
-         B : Natural renames C.Busy;
-         L : Natural renames C.Lock;
+         B : Natural renames Container.Busy;
+         L : Natural renames Container.Lock;
 
       begin
          B := B + 1;
@@ -1761,4 +1794,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
       end loop;
    end Write;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Write;
+
 end Ada.Containers.Doubly_Linked_Lists;

gcc/ada/a-cdlili.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -63,49 +63,51 @@ package Ada.Containers.Doubly_Linked_Lists is
 
    function Element (Position : Cursor) return Element_Type;
 
+   procedure Replace_Element
+     (Container : in out List;
+      Position  : Cursor;
+      New_Item  : Element_Type);
+
    procedure Query_Element
      (Position : Cursor;
       Process  : not null access procedure (Element : Element_Type));
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access procedure (Element : in out Element_Type));
-
-   procedure Replace_Element
-     (Position : Cursor;
-      By       : Element_Type);
+     (Container : in out List;
+      Position  : Cursor;
+      Process   : not null access procedure (Element : in out Element_Type));
 
    procedure Move
      (Target : in out List;
       Source : in out List);
 
-   procedure Prepend
+   procedure Insert
      (Container : in out List;
+      Before    : Cursor;
       New_Item  : Element_Type;
       Count     : Count_Type := 1);
 
-   procedure Append
+   procedure Insert
      (Container : in out List;
+      Before    : Cursor;
       New_Item  : Element_Type;
+      Position  : out Cursor;
       Count     : Count_Type := 1);
 
    procedure Insert
      (Container : in out List;
       Before    : Cursor;
-      New_Item  : Element_Type;
+      Position  : out Cursor;
       Count     : Count_Type := 1);
 
-   procedure Insert
+   procedure Prepend
      (Container : in out List;
-      Before    : Cursor;
       New_Item  : Element_Type;
-      Position  : out Cursor;
       Count     : Count_Type := 1);
 
-   procedure Insert
+   procedure Append
      (Container : in out List;
-      Before    : Cursor;
-      Position  : out Cursor;
+      New_Item  : Element_Type;
       Count     : Count_Type := 1);
 
    procedure Delete
@@ -121,21 +123,11 @@ package Ada.Containers.Doubly_Linked_Lists is
      (Container : in out List;
       Count     : Count_Type := 1);
 
-   generic
-      with function "<" (Left, Right : Element_Type) return Boolean is <>;
-   package Generic_Sorting is
-
-      function Is_Sorted (Container : List) return Boolean;
-
-      procedure Sort (Container : in out List);
+   procedure Reverse_Elements (Container : in out List);
 
-      procedure Merge (Target, Source : in out List);
-
-   end Generic_Sorting;
-
-   procedure Reverse_List (Container : in out List);
-
-   procedure Swap (I, J : Cursor);
+   procedure Swap
+     (Container : in out List;
+      I, J      : Cursor);
 
    procedure Swap_Links
      (Container : in out List;
@@ -149,13 +141,13 @@ package Ada.Containers.Doubly_Linked_Lists is
    procedure Splice
      (Target   : in out List;
       Before   : Cursor;
-      Position : Cursor);
+      Source   : in out List;
+      Position : in out Cursor);
 
    procedure Splice
      (Target   : in out List;
       Before   : Cursor;
-      Source   : in out List;
-      Position : in out Cursor);
+      Position : Cursor);
 
    function First (Container : List) return Cursor;
 
@@ -165,9 +157,13 @@ package Ada.Containers.Doubly_Linked_Lists is
 
    function Last_Element (Container : List) return Element_Type;
 
-   function Contains
-     (Container : List;
-      Item      : Element_Type) return Boolean;
+   function Next (Position : Cursor) return Cursor;
+
+   procedure Next (Position : in out Cursor);
+
+   function Previous (Position : Cursor) return Cursor;
+
+   procedure Previous (Position : in out Cursor);
 
    function Find
      (Container : List;
@@ -179,13 +175,9 @@ package Ada.Containers.Doubly_Linked_Lists is
       Item      : Element_Type;
       Position  : Cursor := No_Element) return Cursor;
 
-   function Next (Position : Cursor) return Cursor;
-
-   function Previous (Position : Cursor) return Cursor;
-
-   procedure Next (Position : in out Cursor);
-
-   procedure Previous (Position : in out Cursor);
+   function Contains
+     (Container : List;
+      Item      : Element_Type) return Boolean;
 
    function Has_Element (Position : Cursor) return Boolean;
 
@@ -197,6 +189,18 @@ package Ada.Containers.Doubly_Linked_Lists is
      (Container : List;
       Process   : not null access procedure (Position : Cursor));
 
+   generic
+      with function "<" (Left, Right : Element_Type) return Boolean is <>;
+   package Generic_Sorting is
+
+      function Is_Sorted (Container : List) return Boolean;
+
+      procedure Sort (Container : in out List);
+
+      procedure Merge (Target, Source : in out List);
+
+   end Generic_Sorting;
+
 private
    type Node_Type;
    type Node_Access is access Node_Type;
@@ -248,6 +252,18 @@ private
          Node      : Node_Access;
       end record;
 
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor);
+
+   for Cursor'Write use Write;
+
    No_Element : constant Cursor := Cursor'(null, null);
 
 end Ada.Containers.Doubly_Linked_Lists;

gcc/ada/a-cidlli.adb

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -211,7 +211,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    function Contains
      (Container : List;
-      Item      : Element_Type) return Boolean is
+      Item      : Element_Type) return Boolean
+   is
    begin
       return Find (Container, Item) /= No_Element;
    end Contains;
@@ -228,23 +229,28 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       X : Node_Access;
 
    begin
-      pragma Assert (Vet (Position), "bad cursor in Delete");
-
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
+
       if Position.Container /= Container'Unrestricted_Access then
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Delete");
+
       if Position.Node = Container.First then
          Delete_First (Container, Count);
-         Position := First (Container);
+         Position := No_Element;  --  Post-York behavior
          return;
       end if;
 
       if Count = 0 then
+         Position := No_Element;  --  Post-York behavior
          return;
       end if;
 
@@ -273,6 +279,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
          Free (X);
       end loop;
+
+      Position := No_Element;  --  Post-York behavior
    end Delete;
 
    ------------------
@@ -355,12 +363,16 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    function Element (Position : Cursor) return Element_Type is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Element");
-
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Position), "bad cursor in Element");
+
       return Position.Node.Element.all;
    end Element;
 
@@ -380,11 +392,15 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
          Node := Container.First;
 
       else
-         pragma Assert (Vet (Position), "bad cursor in Find");
+         if Node.Element = null then
+            raise Program_Error;
+         end if;
 
          if Position.Container /= Container'Unrestricted_Access then
             raise Program_Error;
          end if;
+
+         pragma Assert (Vet (Position), "bad cursor in Find");
       end if;
 
       while Node /= null loop
@@ -635,12 +651,18 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       New_Node : Node_Access;
 
    begin
-      pragma Assert (Vet (Before), "bad cursor in Insert");
+      if Before.Container /= null then
+         if Before.Container /= Container'Unrestricted_Access then
+            raise Program_Error;
+         end if;
 
-      if Before.Container /= null
-        and then Before.Container /= Container'Unrestricted_Access
-      then
-         raise Program_Error;
+         if Before.Node = null
+           or else Before.Node.Element = null
+         then
+            raise Program_Error;
+         end if;
+
+         pragma Assert (Vet (Before), "bad cursor in Insert");
       end if;
 
       if Count = 0 then
@@ -942,12 +964,16 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       Process  : not null access procedure (Element : in Element_Type))
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Query_Element");
-
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Position), "bad cursor in Query_Element");
+
       declare
          C : List renames Position.Container.all'Unrestricted_Access.all;
          B : Natural renames C.Busy;
@@ -1024,102 +1050,56 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       end loop;
    end Read;
 
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Read;
+
    ---------------------
    -- Replace_Element --
    ---------------------
 
    procedure Replace_Element
-     (Position : Cursor;
-      By       : Element_Type)
+     (Container : in out List;
+      Position  : Cursor;
+      New_Item  : Element_Type)
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
-
       if Position.Container = null then
          raise Constraint_Error;
       end if;
 
-      if Position.Container.Lock > 0 then
+      if Position.Container /= Container'Unchecked_Access then
          raise Program_Error;
       end if;
 
-      declare
-         X : Element_Access := Position.Node.Element;
-      begin
-         Position.Node.Element := new Element_Type'(By);
-         Free (X);
-      end;
-   end Replace_Element;
-
-   ------------------
-   -- Reverse_Find --
-   ------------------
-
-   function Reverse_Find
-     (Container : List;
-      Item      : Element_Type;
-      Position  : Cursor := No_Element) return Cursor
-   is
-      Node : Node_Access := Position.Node;
-
-   begin
-      if Node = null then
-         Node := Container.Last;
-
-      else
-         pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
-
-         if Position.Container /= Container'Unrestricted_Access then
-            raise Program_Error;
-         end if;
+      if Position.Container.Lock > 0 then
+         raise Program_Error;
       end if;
 
-      while Node /= null loop
-         if Node.Element.all = Item then
-            return Cursor'(Container'Unchecked_Access, Node);
-         end if;
-
-         Node := Node.Prev;
-      end loop;
-
-      return No_Element;
-   end Reverse_Find;
-
-   ---------------------
-   -- Reverse_Iterate --
-   ---------------------
-
-   procedure Reverse_Iterate
-     (Container : List;
-      Process   : not null access procedure (Position : in Cursor))
-   is
-      C : List renames Container'Unrestricted_Access.all;
-      B : Natural renames C.Busy;
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
 
-      Node : Node_Access := Container.Last;
+      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
 
-   begin
-      B := B + 1;
+      declare
+         X : Element_Access := Position.Node.Element;
 
       begin
-         while Node /= null loop
-            Process (Cursor'(Container'Unchecked_Access, Node));
-            Node := Node.Prev;
-         end loop;
-      exception
-         when others =>
-            B := B - 1;
-            raise;
+         Position.Node.Element := new Element_Type'(New_Item);
+         Free (X);
       end;
+   end Replace_Element;
 
-      B := B - 1;
-   end Reverse_Iterate;
-
-   ------------------
-   -- Reverse_List --
-   ------------------
+   ----------------------
+   -- Reverse_Elements --
+   ----------------------
 
-   procedure Reverse_List (Container : in out List) is
+   procedure Reverse_Elements (Container : in out List) is
       I : Node_Access := Container.First;
       J : Node_Access := Container.Last;
 
@@ -1163,7 +1143,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
          end if;
       end Swap;
 
-   --  Start of processing for Reverse_List
+   --  Start of processing for Reverse_Elements
 
    begin
       if Container.Length <= 1 then
@@ -1199,7 +1179,75 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
       pragma Assert (Container.First.Prev = null);
       pragma Assert (Container.Last.Next = null);
-   end Reverse_List;
+   end Reverse_Elements;
+
+   ------------------
+   -- Reverse_Find --
+   ------------------
+
+   function Reverse_Find
+     (Container : List;
+      Item      : Element_Type;
+      Position  : Cursor := No_Element) return Cursor
+   is
+      Node : Node_Access := Position.Node;
+
+   begin
+      if Node = null then
+         Node := Container.Last;
+
+      else
+         if Node.Element = null then
+            raise Program_Error;
+         end if;
+
+         if Position.Container /= Container'Unrestricted_Access then
+            raise Program_Error;
+         end if;
+
+         pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
+      end if;
+
+      while Node /= null loop
+         if Node.Element.all = Item then
+            return Cursor'(Container'Unchecked_Access, Node);
+         end if;
+
+         Node := Node.Prev;
+      end loop;
+
+      return No_Element;
+   end Reverse_Find;
+
+   ---------------------
+   -- Reverse_Iterate --
+   ---------------------
+
+   procedure Reverse_Iterate
+     (Container : List;
+      Process   : not null access procedure (Position : in Cursor))
+   is
+      C : List renames Container'Unrestricted_Access.all;
+      B : Natural renames C.Busy;
+
+      Node : Node_Access := Container.Last;
+
+   begin
+      B := B + 1;
+
+      begin
+         while Node /= null loop
+            Process (Cursor'(Container'Unchecked_Access, Node));
+            Node := Node.Prev;
+         end loop;
+      exception
+         when others =>
+            B := B - 1;
+            raise;
+      end;
+
+      B := B - 1;
+   end Reverse_Iterate;
 
    ------------
    -- Splice --
@@ -1211,12 +1259,18 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       Source : in out List)
    is
    begin
-      pragma Assert (Vet (Before), "bad cursor in Splice");
+      if Before.Container /= null then
+         if Before.Container /= Target'Unrestricted_Access then
+            raise Program_Error;
+         end if;
 
-      if Before.Container /= null
-        and then Before.Container /= Target'Unrestricted_Access
-      then
-         raise Program_Error;
+         if Before.Node = null
+           or else Before.Node.Element = null
+         then
+            raise Program_Error;
+         end if;
+
+         pragma Assert (Vet (Before), "bad cursor in Splice");
       end if;
 
       if Target'Address = Source'Address
@@ -1284,23 +1338,34 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       Position : Cursor)
    is
    begin
-      pragma Assert (Vet (Before), "bad Before cursor in Splice");
-      pragma Assert (Vet (Position), "bad Position cursor in Splice");
+      if Before.Container /= null then
+         if Before.Container /= Target'Unchecked_Access then
+            raise Program_Error;
+         end if;
 
-      if Before.Container /= null
-        and then Before.Container /= Target'Unchecked_Access
-      then
-         raise Program_Error;
+         if Before.Node = null
+           or else Before.Node.Element = null
+         then
+            raise Program_Error;
+         end if;
+
+         pragma Assert (Vet (Before), "bad Before cursor in Splice");
       end if;
 
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
+
       if Position.Container /= Target'Unrestricted_Access then
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (Position), "bad Position cursor in Splice");
+
       if Position.Node = Before.Node
         or else Position.Node.Next = Before.Node
       then
@@ -1388,23 +1453,34 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
          return;
       end if;
 
-      pragma Assert (Vet (Before), "bad Before cursor in Splice");
-      pragma Assert (Vet (Position), "bad Position cursor in Splice");
+      if Before.Container /= null then
+         if Before.Container /= Target'Unrestricted_Access then
+            raise Program_Error;
+         end if;
 
-      if Before.Container /= null
-        and then Before.Container /= Target'Unrestricted_Access
-      then
-         raise Program_Error;
+         if Before.Node = null
+           or else Before.Node.Element = null
+         then
+            raise Program_Error;
+         end if;
+
+         pragma Assert (Vet (Before), "bad Before cursor in Splice");
       end if;
 
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
+
       if Position.Container /= Source'Unrestricted_Access then
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (Position), "bad Position cursor in Splice");
+
       if Target.Length = Count_Type'Last then
          raise Constraint_Error;
       end if;
@@ -1484,18 +1560,20 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
    -- Swap --
    ----------
 
-   procedure Swap (I, J : Cursor) is
+   procedure Swap
+     (Container : in out List;
+      I, J      : Cursor)
+   is
    begin
-      pragma Assert (Vet (I), "bad I cursor in Swap");
-      pragma Assert (Vet (J), "bad J cursor in Swap");
-
       if I.Node = null
         or else J.Node = null
       then
          raise Constraint_Error;
       end if;
 
-      if I.Container /= J.Container then
+      if I.Container /= Container'Unchecked_Access
+        or else J.Container /= Container'Unchecked_Access
+      then
          raise Program_Error;
       end if;
 
@@ -1503,12 +1581,16 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
          return;
       end if;
 
-      if I.Container.Lock > 0 then
+      if Container.Lock > 0 then
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (I), "bad I cursor in Swap");
+      pragma Assert (Vet (J), "bad J cursor in Swap");
+
       declare
          EI_Copy : constant Element_Access := I.Node.Element;
+
       begin
          I.Node.Element := J.Node.Element;
          J.Node.Element := EI_Copy;
@@ -1524,9 +1606,6 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       I, J      : Cursor)
    is
    begin
-      pragma Assert (Vet (I), "bad I cursor in Swap_Links");
-      pragma Assert (Vet (J), "bad J cursor in Swap_Links");
-
       if I.Node = null
         or else J.Node = null
       then
@@ -1547,6 +1626,9 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (I), "bad I cursor in Swap_Links");
+      pragma Assert (Vet (J), "bad J cursor in Swap_Links");
+
       declare
          I_Next : constant Cursor := Next (I);
 
@@ -1580,20 +1662,28 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
    --------------------
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access procedure (Element : in out Element_Type))
+     (Container : in out List;
+      Position  : Cursor;
+      Process   : not null access procedure (Element : in out Element_Type))
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Update_Element");
-
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      if Position.Container /= Container'Unchecked_Access then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Position), "bad cursor in Update_Element");
+
       declare
-         C : List renames Position.Container.all'Unrestricted_Access.all;
-         B : Natural renames C.Busy;
-         L : Natural renames C.Lock;
+         B : Natural renames Container.Busy;
+         L : Natural renames Container.Lock;
 
       begin
          B := B + 1;
@@ -1775,4 +1865,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       end loop;
    end Write;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Write;
+
 end Ada.Containers.Indefinite_Doubly_Linked_Lists;

gcc/ada/a-cidlli.ads

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -62,46 +62,47 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    procedure Clear (Container : in out List);
 
-   function Element (Position : Cursor)
-      return Element_Type;
+   function Element (Position : Cursor) return Element_Type;
+
+   procedure Replace_Element
+     (Container : in out List;
+      Position  : Cursor;
+      New_Item  : Element_Type);
 
    procedure Query_Element
      (Position : Cursor;
       Process  : not null access procedure (Element : Element_Type));
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access procedure (Element : in out Element_Type));
-
-   procedure Replace_Element
-     (Position : Cursor;
-      By       : Element_Type);
+     (Container : in out List;
+      Position  : Cursor;
+      Process   : not null access procedure (Element : in out Element_Type));
 
    procedure Move
      (Target : in out List;
       Source : in out List);
 
-   procedure Prepend
+   procedure Insert
      (Container : in out List;
+      Before    : Cursor;
       New_Item  : Element_Type;
       Count     : Count_Type := 1);
 
-   procedure Append
+   procedure Insert
      (Container : in out List;
+      Before    : Cursor;
       New_Item  : Element_Type;
+      Position  : out Cursor;
       Count     : Count_Type := 1);
 
-   procedure Insert
+   procedure Prepend
      (Container : in out List;
-      Before    : Cursor;
       New_Item  : Element_Type;
       Count     : Count_Type := 1);
 
-   procedure Insert
+   procedure Append
      (Container : in out List;
-      Before    : Cursor;
       New_Item  : Element_Type;
-      Position  : out Cursor;
       Count     : Count_Type := 1);
 
    procedure Delete
@@ -117,21 +118,9 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
      (Container : in out List;
       Count     : Count_Type := 1);
 
-   generic
-      with function "<" (Left, Right : Element_Type) return Boolean is <>;
-   package Generic_Sorting is
-
-      function Is_Sorted (Container : List) return Boolean;
-
-      procedure Sort (Container : in out List);
-
-      procedure Merge (Target, Source : in out List);
-
-   end Generic_Sorting;
+   procedure Reverse_Elements (Container : in out List);
 
-   procedure Reverse_List (Container : in out List);
-
-   procedure Swap (I, J : Cursor);
+   procedure Swap (Container : in out List; I, J : Cursor);
 
    procedure Swap_Links (Container : in out List; I, J : Cursor);
 
@@ -143,13 +132,13 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
    procedure Splice
      (Target   : in out List;
       Before   : Cursor;
-      Position : Cursor);
+      Source   : in out List;
+      Position : in out Cursor);
 
    procedure Splice
      (Target   : in out List;
       Before   : Cursor;
-      Source   : in out List;
-      Position : in out Cursor);
+      Position : Cursor);
 
    function First (Container : List) return Cursor;
 
@@ -159,9 +148,13 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    function Last_Element (Container : List) return Element_Type;
 
-   function Contains
-     (Container : List;
-      Item      : Element_Type) return Boolean;
+   function Next (Position : Cursor) return Cursor;
+
+   procedure Next (Position : in out Cursor);
+
+   function Previous (Position : Cursor) return Cursor;
+
+   procedure Previous (Position : in out Cursor);
 
    function Find
      (Container : List;
@@ -173,13 +166,9 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
       Item      : Element_Type;
       Position  : Cursor := No_Element) return Cursor;
 
-   function Next (Position : Cursor) return Cursor;
-
-   function Previous (Position : Cursor) return Cursor;
-
-   procedure Next (Position : in out Cursor);
-
-   procedure Previous (Position : in out Cursor);
+   function Contains
+     (Container : List;
+      Item      : Element_Type) return Boolean;
 
    function Has_Element (Position : Cursor) return Boolean;
 
@@ -191,6 +180,18 @@ package Ada.Containers.Indefinite_Doubly_Linked_Lists is
      (Container : List;
       Process   : not null access procedure (Position : Cursor));
 
+   generic
+      with function "<" (Left, Right : Element_Type) return Boolean is <>;
+   package Generic_Sorting is
+
+      function Is_Sorted (Container : List) return Boolean;
+
+      procedure Sort (Container : in out List);
+
+      procedure Merge (Target, Source : in out List);
+
+   end Generic_Sorting;
+
 private
    type Node_Type;
    type Node_Access is access Node_Type;
@@ -244,6 +245,18 @@ private
          Node      : Node_Access;
       end record;
 
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor);
+
+   for Cursor'Write use Write;
+
    No_Element : constant Cursor := Cursor'(null, null);
 
 end Ada.Containers.Indefinite_Doubly_Linked_Lists;

gcc/ada/a-cihama.adb

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -713,6 +713,14 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       Read_Nodes (Stream, Container.HT);
    end Read;
 
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Read;
+
    ---------------
    -- Read_Node --
    ---------------
@@ -787,7 +795,11 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
    -- Replace_Element --
    ---------------------
 
-   procedure Replace_Element (Position : Cursor; By : Element_Type) is
+   procedure Replace_Element
+     (Container : in out Map;
+      Position  : Cursor;
+      New_Item  : Element_Type)
+   is
    begin
       pragma Assert (Vet (Position), "bad cursor in Replace_Element");
 
@@ -795,6 +807,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
          raise Constraint_Error;
       end if;
 
+      if Position.Container /= Container'Unrestricted_Access then
+         raise Program_Error;
+      end if;
+
       if Position.Container.HT.Lock > 0 then
          raise Program_Error;
       end if;
@@ -803,7 +819,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
          X : Element_Access := Position.Node.Element;
 
       begin
-         Position.Node.Element := new Element_Type'(By);
+         Position.Node.Element := new Element_Type'(New_Item);
          Free_Element (X);
       end;
    end Replace_Element;
@@ -834,9 +850,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
    --------------------
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access procedure (Key     : Key_Type;
-                                            Element : in out Element_Type))
+     (Container : in out Map;
+      Position  : Cursor;
+      Process   : not null access procedure (Key     : Key_Type;
+                                             Element : in out Element_Type))
    is
    begin
       pragma Assert (Vet (Position), "bad cursor in Update_Element");
@@ -845,9 +862,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
          raise Constraint_Error;
       end if;
 
+      if Position.Container /= Container'Unrestricted_Access then
+         raise Program_Error;
+      end if;
+
       declare
-         M  : Map renames Position.Container.all;
-         HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
+         HT : Hash_Table_Type renames Container.HT;
 
          B : Natural renames HT.Busy;
          L : Natural renames HT.Lock;
@@ -859,7 +879,6 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
          declare
             K : Key_Type renames Position.Node.Key.all;
             E : Element_Type renames Position.Node.Element.all;
-
          begin
             Process (K, E);
          exception
@@ -951,6 +970,14 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       Write_Nodes (Stream, Container.HT);
    end Write;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Write;
+
    ----------------
    -- Write_Node --
    ----------------

gcc/ada/a-cihama.ads

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -57,6 +57,12 @@ package Ada.Containers.Indefinite_Hashed_Maps is
 
    function "=" (Left, Right : Map) return Boolean;
 
+   function Capacity (Container : Map) return Count_Type;
+
+   procedure Reserve_Capacity
+     (Container : in out Map;
+      Capacity  : Count_Type);
+
    function Length (Container : Map) return Count_Type;
 
    function Is_Empty (Container : Map) return Boolean;
@@ -67,20 +73,22 @@ package Ada.Containers.Indefinite_Hashed_Maps is
 
    function Element (Position : Cursor) return Element_Type;
 
+   procedure Replace_Element
+     (Container : in out Map;
+      Position  : Cursor;
+      New_Item  : Element_Type);
+
    procedure Query_Element
      (Position : Cursor;
       Process  : not null access procedure (Key     : Key_Type;
                                             Element : Element_Type));
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access procedure (Key     : Key_Type;
+     (Container : in out Map;
+      Position  : Cursor;
+      Process   : not null access procedure (Key     : Key_Type;
                                             Element : in out Element_Type));
 
-   procedure Replace_Element
-     (Position : Cursor;
-      By       : Element_Type);
-
    procedure Move (Target : in out Map; Source : in out Map);
 
    procedure Insert
@@ -105,29 +113,11 @@ package Ada.Containers.Indefinite_Hashed_Maps is
       Key       : Key_Type;
       New_Item  : Element_Type);
 
-   procedure Delete
-     (Container : in out Map;
-      Key       : Key_Type);
+   procedure Exclude (Container : in out Map; Key : Key_Type);
 
-   procedure Delete
-     (Container : in out Map;
-      Position  : in out Cursor);
+   procedure Delete (Container : in out Map; Key : Key_Type);
 
-   procedure Exclude
-     (Container : in out Map;
-      Key       : Key_Type);
-
-   function Contains
-     (Container : Map;
-      Key       : Key_Type) return Boolean;
-
-   function Find
-     (Container : Map;
-      Key       : Key_Type) return Cursor;
-
-   function Element
-     (Container : Map;
-      Key       : Key_Type) return Element_Type;
+   procedure Delete (Container : in out Map; Position : in out Cursor);
 
    function First (Container : Map) return Cursor;
 
@@ -135,29 +125,24 @@ package Ada.Containers.Indefinite_Hashed_Maps is
 
    procedure Next (Position : in out Cursor);
 
+   function Find (Container : Map; Key : Key_Type) return Cursor;
+
+   function Contains (Container : Map; Key : Key_Type) return Boolean;
+
+   function Element (Container : Map; Key : Key_Type) return Element_Type;
+
    function Has_Element (Position : Cursor) return Boolean;
 
-   function Equivalent_Keys (Left, Right : Cursor)
-     return Boolean;
+   function Equivalent_Keys (Left, Right : Cursor) return Boolean;
 
-   function Equivalent_Keys
-     (Left  : Cursor;
-      Right : Key_Type) return Boolean;
+   function Equivalent_Keys (Left : Cursor; Right : Key_Type) return Boolean;
 
-   function Equivalent_Keys
-     (Left  : Key_Type;
-      Right : Cursor) return Boolean;
+   function Equivalent_Keys (Left : Key_Type; Right : Cursor) return Boolean;
 
    procedure Iterate
      (Container : Map;
       Process   : not null access procedure (Position : Cursor));
 
-   function Capacity (Container : Map) return Count_Type;
-
-   procedure Reserve_Capacity
-     (Container : in out Map;
-      Capacity  : Count_Type);
-
 private
    pragma Inline ("=");
    pragma Inline (Length);
@@ -194,6 +179,7 @@ private
 
    use HT_Types;
    use Ada.Finalization;
+   use Ada.Streams;
 
    procedure Adjust (Container : in out Map);
 
@@ -208,12 +194,22 @@ private
          Node      : Node_Access;
       end record;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor);
+
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
    No_Element : constant Cursor :=
      (Container => null,
       Node      => null);
 
-   use Ada.Streams;
-
    procedure Write
      (Stream    : access Root_Stream_Type'Class;
       Container : Map);

gcc/ada/a-cihase.adb

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -73,6 +73,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
    function Hash_Node (Node : Node_Access) return Hash_Type;
    pragma Inline (Hash_Node);
 
+   procedure Insert
+     (HT       : in out Hash_Table_Type;
+      New_Item : Element_Type;
+      Node     : out Node_Access;
+      Inserted : out Boolean);
+
    function Is_In (HT  : Hash_Table_Type; Key : Node_Access) return Boolean;
    pragma Inline (Is_In);
 
@@ -326,13 +332,16 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          begin
             if not Is_In (Right.HT, L_Node) then
                declare
-                  Indx : constant Hash_Type :=
-                           Hash (L_Node.Element.all) mod Buckets'Length;
-
+                  Src    : Element_Type renames L_Node.Element.all;
+                  Indx   : constant Hash_Type := Hash (Src) mod Buckets'Length;
                   Bucket : Node_Access renames Buckets (Indx);
-
+                  Tgt    : Element_Access := new Element_Type'(Src);
                begin
-                  Bucket := new Node_Type'(L_Node.Element, Bucket);
+                  Bucket := new Node_Type'(Tgt, Bucket);
+               exception
+                  when others =>
+                     Free_Element (Tgt);
+                     raise;
                end;
 
                Length := Length + 1;
@@ -644,6 +653,32 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       Position  : out Cursor;
       Inserted  : out Boolean)
    is
+   begin
+      Insert (Container.HT, New_Item, Position.Node, Inserted);
+      Position.Container := Container'Unchecked_Access;
+   end Insert;
+
+   procedure Insert
+     (Container : in out Set;
+      New_Item  : Element_Type)
+   is
+      Position : Cursor;
+      Inserted : Boolean;
+
+   begin
+      Insert (Container, New_Item, Position, Inserted);
+
+      if not Inserted then
+         raise Constraint_Error;
+      end if;
+   end Insert;
+
+   procedure Insert
+     (HT       : in out Hash_Table_Type;
+      New_Item : Element_Type;
+      Node     : out Node_Access;
+      Inserted : out Boolean)
+   is
       function New_Node (Next : Node_Access) return Node_Access;
       pragma Inline (New_Node);
 
@@ -665,8 +700,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
             raise;
       end New_Node;
 
-      HT : Hash_Table_Type renames Container.HT;
-
    --  Start of processing for Insert
 
    begin
@@ -674,30 +707,13 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          HT_Ops.Reserve_Capacity (HT, 1);
       end if;
 
-      Local_Insert (HT, New_Item, Position.Node, Inserted);
+      Local_Insert (HT, New_Item, Node, Inserted);
 
       if Inserted
         and then HT.Length > HT_Ops.Capacity (HT)
       then
          HT_Ops.Reserve_Capacity (HT, HT.Length);
       end if;
-
-      Position.Container := Container'Unchecked_Access;
-   end Insert;
-
-   procedure Insert
-     (Container : in out Set;
-      New_Item  : Element_Type)
-   is
-      Position : Cursor;
-      Inserted : Boolean;
-
-   begin
-      Insert (Container, New_Item, Position, Inserted);
-
-      if not Inserted then
-         raise Constraint_Error;
-      end if;
    end Insert;
 
    ------------------
@@ -787,13 +803,20 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          begin
             if Is_In (Right.HT, L_Node) then
                declare
-                  Indx : constant Hash_Type :=
-                           Hash (L_Node.Element.all) mod Buckets'Length;
+                  Src : Element_Type renames L_Node.Element.all;
+
+                  Indx : constant Hash_Type := Hash (Src) mod Buckets'Length;
 
                   Bucket : Node_Access renames Buckets (Indx);
 
+                  Tgt : Element_Access := new Element_Type'(Src);
+
                begin
-                  Bucket := new Node_Type'(L_Node.Element, Bucket);
+                  Bucket := new Node_Type'(Tgt, Bucket);
+               exception
+                  when others =>
+                     Free_Element (Tgt);
+                     raise;
                end;
 
                Length := Length + 1;
@@ -1040,6 +1063,14 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       Read_Nodes (Stream, Container.HT);
    end Read;
 
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Read;
+
    ---------------
    -- Read_Node --
    ---------------
@@ -1502,6 +1533,20 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       return (Controlled with HT => (Buckets, Length, 0, 0));
    end Symmetric_Difference;
 
+   ------------
+   -- To_Set --
+   ------------
+
+   function To_Set (New_Item : Element_Type) return Set is
+      HT       : Hash_Table_Type;
+      Node     : Node_Access;
+      Inserted : Boolean;
+
+   begin
+      Insert (HT, New_Item, Node, Inserted);
+      return Set'(Controlled with HT);
+   end To_Set;
+
    -----------
    -- Union --
    -----------
@@ -1609,13 +1654,20 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          -------------
 
          procedure Process (L_Node : Node_Access) is
-            J : constant Hash_Type :=
-                  Hash (L_Node.Element.all) mod Buckets'Length;
+            Src : Element_Type renames L_Node.Element.all;
+
+            J : constant Hash_Type := Hash (Src) mod Buckets'Length;
 
             Bucket : Node_Access renames Buckets (J);
 
+            Tgt : Element_Access := new Element_Type'(Src);
+
          begin
-            Bucket := new Node_Type'(L_Node.Element, Bucket);
+            Bucket := new Node_Type'(Tgt, Bucket);
+         exception
+            when others =>
+               Free_Element (Tgt);
+               raise;
          end Process;
 
       --  Start of processing for Process
@@ -1751,6 +1803,14 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       Write_Nodes (Stream, Container.HT);
    end Write;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Write;
+
    ----------------
    -- Write_Node --
    ----------------

gcc/ada/a-cihase.ads

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -63,6 +63,8 @@ package Ada.Containers.Indefinite_Hashed_Sets is
 
    function Equivalent_Sets (Left, Right : Set) return Boolean;
 
+   function To_Set (New_Item : Element_Type) return Set;
+
    function Capacity (Container : Set) return Count_Type;
 
    procedure Reserve_Capacity
@@ -225,6 +227,7 @@ private
 
    use HT_Types;
    use Ada.Finalization;
+   use Ada.Streams;
 
    type Set_Access is access all Set;
    for Set_Access'Storage_Size use 0;
@@ -235,12 +238,22 @@ private
          Node      : Node_Access;
       end record;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor);
+
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
    No_Element : constant Cursor :=
                   (Container => null,
                    Node      => null);
 
-   use Ada.Streams;
-
    procedure Write
      (Stream    : access Root_Stream_Type'Class;
       Container : Set);

gcc/ada/a-ciorma.adb

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -135,16 +135,56 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
 
    function "<" (Left, Right : Cursor) return Boolean is
    begin
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
+      if Left.Node.Key = null
+        or else Right.Node.Key = null
+      then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in ""<""");
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in ""<""");
+
       return Left.Node.Key.all < Right.Node.Key.all;
    end "<";
 
    function "<" (Left : Cursor; Right : Key_Type) return Boolean is
    begin
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Left.Node.Key = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in ""<""");
+
       return Left.Node.Key.all < Right;
    end "<";
 
    function "<" (Left : Key_Type; Right : Cursor) return Boolean is
    begin
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Right.Node.Key = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in ""<""");
+
       return Left < Right.Node.Key.all;
    end "<";
 
@@ -163,16 +203,56 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
 
    function ">" (Left, Right : Cursor) return Boolean is
    begin
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
+      if Left.Node.Key = null
+        or else Right.Node.Key = null
+      then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in "">""");
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in "">""");
+
       return Right.Node.Key.all < Left.Node.Key.all;
    end ">";
 
    function ">" (Left : Cursor; Right : Key_Type) return Boolean is
    begin
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Left.Node.Key = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in "">""");
+
       return Right < Left.Node.Key.all;
    end ">";
 
    function ">" (Left : Key_Type; Right : Cursor) return Boolean is
    begin
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Right.Node.Key = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in "">""");
+
       return Right.Node.Key.all < Left;
    end ">";
 
@@ -194,12 +274,13 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
 
    function Ceiling (Container : Map; Key : Key_Type) return Cursor is
       Node : constant Node_Access := Key_Ops.Ceiling (Container.Tree, Key);
+
    begin
       if Node = null then
          return No_Element;
-      else
-         return Cursor'(Container'Unrestricted_Access, Node);
       end if;
+
+      return Cursor'(Container'Unrestricted_Access, Node);
    end Ceiling;
 
    -----------
@@ -268,11 +349,20 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
          raise Constraint_Error;
       end if;
 
-      if Position.Container /= Map_Access'(Container'Unrestricted_Access) then
+      if Position.Node.Key = null
+        or else Position.Node.Element = null
+      then
+         raise Program_Error;
+      end if;
+
+      if Position.Container /= Container'Unrestricted_Access then
          raise Program_Error;
       end if;
 
-      Delete_Node_Sans_Free (Container.Tree, Position.Node);
+      pragma Assert (Vet (Container.Tree, Position.Node),
+                     "bad cursor in Delete");
+
+      Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
       Free (Position.Node);
 
       Position.Container := null;
@@ -280,13 +370,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
 
    procedure Delete (Container : in out Map; Key : Key_Type) is
       X : Node_Access := Key_Ops.Find (Container.Tree, Key);
+
    begin
       if X = null then
          raise Constraint_Error;
-      else
-         Delete_Node_Sans_Free (Container.Tree, X);
-         Free (X);
       end if;
+
+      Delete_Node_Sans_Free (Container.Tree, X);
+      Free (X);
    end Delete;
 
    ------------------
@@ -295,6 +386,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
 
    procedure Delete_First (Container : in out Map) is
       X : Node_Access := Container.Tree.First;
+
    begin
       if X /= null then
          Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
@@ -308,6 +400,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
 
    procedure Delete_Last (Container : in out Map) is
       X : Node_Access := Container.Tree.Last;
+
    begin
       if X /= null then
          Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
@@ -321,15 +414,46 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
 
    function Element (Position : Cursor) return Element_Type is
    begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Element");
+
       return Position.Node.Element.all;
    end Element;
 
    function Element (Container : Map; Key : Key_Type) return Element_Type is
       Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
+
    begin
+      if Node = null then
+         raise Constraint_Error;
+      end if;
+
       return Node.Element.all;
    end Element;
 
+   ---------------------
+   -- Equivalent_Keys --
+   ---------------------
+
+   function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
+   begin
+      if Left < Right
+        or else Right < Left
+      then
+         return False;
+      else
+         return True;
+      end if;
+   end Equivalent_Keys;
+
    -------------
    -- Exclude --
    -------------
@@ -339,7 +463,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
 
    begin
       if X /= null then
-         Delete_Node_Sans_Free (Container.Tree, X);
+         Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
          Free (X);
       end if;
    end Exclude;
@@ -350,12 +474,13 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
 
    function Find (Container : Map; Key : Key_Type) return Cursor is
       Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
+
    begin
       if Node = null then
          return No_Element;
-      else
-         return Cursor'(Container'Unrestricted_Access, Node);
       end if;
+
+      return Cursor'(Container'Unrestricted_Access, Node);
    end Find;
 
    -----------
@@ -363,12 +488,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
    -----------
 
    function First (Container : Map) return Cursor is
+      T : Tree_Type renames Container.Tree;
+
    begin
-      if Container.Tree.First = null then
+      if T.First = null then
          return No_Element;
-      else
-         return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
       end if;
+
+      return Cursor'(Container'Unrestricted_Access, T.First);
    end First;
 
    -------------------
@@ -376,8 +503,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
    -------------------
 
    function First_Element (Container : Map) return Element_Type is
+      T : Tree_Type renames Container.Tree;
+
    begin
-      return Container.Tree.First.Element.all;
+      if T.First = null then
+         raise Constraint_Error;
+      end if;
+
+      return T.First.Element.all;
    end First_Element;
 
    ---------------
@@ -385,8 +518,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
    ---------------
 
    function First_Key (Container : Map) return Key_Type is
+      T : Tree_Type renames Container.Tree;
+
    begin
-      return Container.Tree.First.Key.all;
+      if T.First = null then
+         raise Constraint_Error;
+      end if;
+
+      return T.First.Key.all;
    end First_Key;
 
    -----------
@@ -395,12 +534,13 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
 
    function Floor (Container : Map; Key : Key_Type) return Cursor is
       Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key);
+
    begin
       if Node = null then
          return No_Element;
-      else
-         return Cursor'(Container'Unrestricted_Access, Node);
       end if;
+
+      return Cursor'(Container'Unrestricted_Access, Node);
    end Floor;
 
    ----------
@@ -410,11 +550,16 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
    procedure Free (X : in out Node_Access) is
       procedure Deallocate is
         new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+
    begin
       if X = null then
          return;
       end if;
 
+      X.Parent := X;
+      X.Left := X;
+      X.Right := X;
+
       begin
          Free_Key (X.Key);
       exception
@@ -664,6 +809,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
 
    function Key (Position : Cursor) return Key_Type is
    begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Position.Node.Key = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Key");
+
       return Position.Node.Key.all;
    end Key;
 
@@ -672,12 +828,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
    ----------
 
    function Last (Container : Map) return Cursor is
+      T : Tree_Type renames Container.Tree;
+
    begin
-      if Container.Tree.Last = null then
+      if T.Last = null then
          return No_Element;
-      else
-         return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
       end if;
+
+      return Cursor'(Container'Unrestricted_Access, T.Last);
    end Last;
 
    ------------------
@@ -685,8 +843,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
    ------------------
 
    function Last_Element (Container : Map) return Element_Type is
+      T : Tree_Type renames Container.Tree;
+
    begin
-      return Container.Tree.Last.Element.all;
+      if T.Last = null then
+         raise Constraint_Error;
+      end if;
+
+      return T.Last.Element.all;
    end Last_Element;
 
    --------------
@@ -694,8 +858,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
    --------------
 
    function Last_Key (Container : Map) return Key_Type is
+      T : Tree_Type renames Container.Tree;
+
    begin
-      return Container.Tree.Last.Key.all;
+      if T.Last = null then
+         raise Constraint_Error;
+      end if;
+
+      return T.Last.Key.all;
    end Last_Key;
 
    ----------
@@ -738,8 +908,16 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
          return No_Element;
       end if;
 
+      pragma Assert (Position.Node /= null);
+      pragma Assert (Position.Node.Key /= null);
+      pragma Assert (Position.Node.Element /= null);
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Next");
+
       declare
-         Node : constant Node_Access := Tree_Operations.Next (Position.Node);
+         Node : constant Node_Access :=
+                  Tree_Operations.Next (Position.Node);
+
       begin
          if Node = null then
             return No_Element;
@@ -773,9 +951,16 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
          return No_Element;
       end if;
 
+      pragma Assert (Position.Node /= null);
+      pragma Assert (Position.Node.Key /= null);
+      pragma Assert (Position.Node.Element /= null);
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Previous");
+
       declare
          Node : constant Node_Access :=
-           Tree_Operations.Previous (Position.Node);
+                  Tree_Operations.Previous (Position.Node);
+
       begin
          if Node = null then
             return No_Element;
@@ -799,29 +984,46 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
       Process  : not null access procedure (Key     : Key_Type;
                                             Element : Element_Type))
    is
-      K : Key_Type renames Position.Node.Key.all;
-      E : Element_Type renames Position.Node.Element.all;
+   begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
-      T : Tree_Type renames Position.Container.Tree;
+      if Position.Node.Key = null
+        or else Position.Node.Element = null
+      then
+         raise Program_Error;
+      end if;
 
-      B : Natural renames T.Busy;
-      L : Natural renames T.Lock;
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Query_Element");
 
-   begin
-      B := B + 1;
-      L := L + 1;
+      declare
+         T : Tree_Type renames Position.Container.Tree;
+
+         B : Natural renames T.Busy;
+         L : Natural renames T.Lock;
 
       begin
-         Process (K, E);
-      exception
-         when others =>
-            L := L - 1;
-            B := B - 1;
-            raise;
-      end;
+         B := B + 1;
+         L := L + 1;
 
-      L := L - 1;
-      B := B - 1;
+         declare
+            K : Key_Type renames Position.Node.Key.all;
+            E : Element_Type renames Position.Node.Element.all;
+
+         begin
+            Process (K, E);
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
+
+         L := L - 1;
+         B := B - 1;
+      end;
    end Query_Element;
 
    ----------
@@ -863,6 +1065,14 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
       Read (Stream, Container.Tree);
    end Read;
 
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Read;
+
    -------------
    -- Replace --
    -------------
@@ -908,15 +1118,40 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
    -- Replace_Element --
    ---------------------
 
-   procedure Replace_Element (Position : Cursor; By : Element_Type) is
-      X : Element_Access := Position.Node.Element;
+   procedure Replace_Element
+     (Container : in out Map;
+      Position  : Cursor;
+      New_Item  : Element_Type)
+   is
    begin
-      if Position.Container.Tree.Lock > 0 then
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Position.Node.Key = null
+        or else Position.Node.Element = null
+      then
+         raise Program_Error;
+      end if;
+
+      if Position.Container /= Container'Unrestricted_Access then
          raise Program_Error;
       end if;
 
-      Position.Node.Element := new Element_Type'(By);
-      Free_Element (X);
+      if Container.Tree.Lock > 0 then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Container.Tree, Position.Node),
+                     "bad cursor in Replace_Element");
+
+      declare
+         X : Element_Access := Position.Node.Element;
+
+      begin
+         Position.Node.Element := new Element_Type'(New_Item);
+         Free_Element (X);
+      end;
    end Replace_Element;
 
    ---------------------
@@ -1010,33 +1245,55 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
    --------------------
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access procedure (Key     : Key_Type;
-                                            Element : in out Element_Type))
+     (Container : in out Map;
+      Position  : Cursor;
+      Process   : not null access procedure (Key     : Key_Type;
+                                             Element : in out Element_Type))
    is
-      K : Key_Type renames Position.Node.Key.all;
-      E : Element_Type renames Position.Node.Element.all;
+   begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
-      T : Tree_Type renames Position.Container.Tree;
+      if Position.Node.Key = null
+        or else Position.Node.Element = null
+      then
+         raise Program_Error;
+      end if;
 
-      B : Natural renames T.Busy;
-      L : Natural renames T.Lock;
+      if Position.Container /= Container'Unrestricted_Access then
+         raise Program_Error;
+      end if;
 
-   begin
-      B := B + 1;
-      L := L + 1;
+      pragma Assert (Vet (Container.Tree, Position.Node),
+                     "bad cursor in Update_Element");
+
+      declare
+         T : Tree_Type renames Position.Container.Tree;
+
+         B : Natural renames T.Busy;
+         L : Natural renames T.Lock;
 
       begin
-         Process (K, E);
-      exception
-         when others =>
-            L := L - 1;
-            B := B - 1;
-            raise;
-      end;
+         B := B + 1;
+         L := L + 1;
 
-      L := L - 1;
-      B := B - 1;
+         declare
+            K : Key_Type renames Position.Node.Key.all;
+            E : Element_Type renames Position.Node.Element.all;
+
+         begin
+            Process (K, E);
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
+
+         L := L - 1;
+         B := B - 1;
+      end;
    end Update_Element;
 
    -----------
@@ -1074,4 +1331,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
       Write (Stream, Container.Tree);
    end Write;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Write;
+
 end Ada.Containers.Indefinite_Ordered_Maps;

gcc/ada/a-ciorma.ads

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -40,16 +40,16 @@ with Ada.Streams;
 
 generic
    type Key_Type (<>) is private;
-
    type Element_Type (<>) is private;
 
    with function "<" (Left, Right : Key_Type) return Boolean is <>;
-
    with function "=" (Left, Right : Element_Type) return Boolean is <>;
 
 package Ada.Containers.Indefinite_Ordered_Maps is
    pragma Preelaborate;
 
+   function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
+
    type Map is tagged private;
 
    type Cursor is private;
@@ -70,17 +70,21 @@ package Ada.Containers.Indefinite_Ordered_Maps is
 
    function Element (Position : Cursor) return Element_Type;
 
+   procedure Replace_Element
+     (Container : in out Map;
+      Position  : Cursor;
+      New_Item  : Element_Type);
+
    procedure Query_Element
      (Position : Cursor;
       Process  : not null access procedure (Key     : Key_Type;
                                             Element : Element_Type));
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access procedure (Key     : Key_Type;
-                                            Element : in out Element_Type));
-
-   procedure Replace_Element (Position : Cursor; By : Element_Type);
+     (Container : in out Map;
+      Position  : Cursor;
+      Process   : not null access procedure (Key     : Key_Type;
+                                             Element : in out Element_Type));
 
    procedure Move (Target : in out Map; Source : in out Map);
 
@@ -106,54 +110,28 @@ package Ada.Containers.Indefinite_Ordered_Maps is
       Key       : Key_Type;
       New_Item  : Element_Type);
 
-   procedure Delete
-     (Container : in out Map;
-      Key       : Key_Type);
+   procedure Exclude (Container : in out Map; Key : Key_Type);
 
-   procedure Delete
-     (Container : in out Map;
-      Position  : in out Cursor);
+   procedure Delete (Container : in out Map; Key : Key_Type);
+
+   procedure Delete (Container : in out Map; Position : in out Cursor);
 
    procedure Delete_First (Container : in out Map);
 
    procedure Delete_Last (Container : in out Map);
 
-   procedure Exclude
-     (Container : in out Map;
-      Key       : Key_Type);
-
-   function Contains
-     (Container : Map;
-      Key       : Key_Type) return Boolean;
-
-   function Find
-     (Container : Map;
-      Key       : Key_Type) return Cursor;
-
-   function Element
-     (Container : Map;
-      Key       : Key_Type) return Element_Type;
-
-   function Floor
-     (Container : Map;
-      Key       : Key_Type) return Cursor;
-
-   function Ceiling
-     (Container : Map;
-      Key       : Key_Type) return Cursor;
-
    function First (Container : Map) return Cursor;
 
-   function First_Key (Container : Map) return Key_Type;
-
    function First_Element (Container : Map) return Element_Type;
 
-   function Last (Container : Map) return Cursor;
+   function First_Key (Container : Map) return Key_Type;
 
-   function Last_Key (Container : Map) return Key_Type;
+   function Last (Container : Map) return Cursor;
 
    function Last_Element (Container : Map) return Element_Type;
 
+   function Last_Key (Container : Map) return Key_Type;
+
    function Next (Position : Cursor) return Cursor;
 
    procedure Next (Position : in out Cursor);
@@ -162,6 +140,16 @@ package Ada.Containers.Indefinite_Ordered_Maps is
 
    procedure Previous (Position : in out Cursor);
 
+   function Find (Container : Map; Key : Key_Type) return Cursor;
+
+   function Element (Container : Map; Key : Key_Type) return Element_Type;
+
+   function Floor (Container : Map; Key : Key_Type) return Cursor;
+
+   function Ceiling (Container : Map; Key : Key_Type) return Cursor;
+
+   function Contains (Container : Map; Key : Key_Type) return Boolean;
+
    function Has_Element (Position : Cursor) return Boolean;
 
    function "<" (Left, Right : Cursor) return Boolean;
@@ -216,8 +204,9 @@ private
    use Red_Black_Trees;
    use Tree_Types;
    use Ada.Finalization;
+   use Ada.Streams;
 
-   type Map_Access is access Map;
+   type Map_Access is access all Map;
    for Map_Access'Storage_Size use 0;
 
    type Cursor is record
@@ -225,9 +214,19 @@ private
       Node      : Node_Access;
    end record;
 
-   No_Element : constant Cursor := Cursor'(null, null);
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor);
 
-   use Ada.Streams;
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
+   No_Element : constant Cursor := Cursor'(null, null);
 
    procedure Write
      (Stream    : access Root_Stream_Type'Class;

gcc/ada/a-ciormu.adb

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -87,6 +87,11 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
 
    procedure Free (X : in out Node_Access);
 
+   procedure Insert_Sans_Hint
+     (Tree     : in out Tree_Type;
+      New_Item : Element_Type;
+      Node     : out Node_Access);
+
    procedure Insert_With_Hint
      (Dst_Tree : in out Tree_Type;
       Dst_Hint : Node_Access;
@@ -157,16 +162,56 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
 
    function "<" (Left, Right : Cursor) return Boolean is
    begin
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
+      if Left.Node.Element = null
+        or else Right.Node.Element = null
+      then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in ""<""");
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in ""<""");
+
       return Left.Node.Element.all < Right.Node.Element.all;
    end "<";
 
    function "<" (Left : Cursor; Right : Element_Type) return Boolean is
    begin
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Left.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in ""<""");
+
       return Left.Node.Element.all < Right;
    end "<";
 
    function "<" (Left : Element_Type; Right : Cursor) return Boolean is
    begin
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Right.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in ""<""");
+
       return Left < Right.Node.Element.all;
    end "<";
 
@@ -183,20 +228,60 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
    -- ">" --
    ---------
 
-   function ">" (Left : Cursor; Right : Element_Type) return Boolean is
-   begin
-      return Right < Left.Node.Element.all;
-   end ">";
-
    function ">" (Left, Right : Cursor) return Boolean is
    begin
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
+      if Left.Node.Element = null
+        or else Right.Node.Element = null
+      then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in "">""");
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in "">""");
+
       --  L > R same as R < L
 
       return Right.Node.Element.all < Left.Node.Element.all;
    end ">";
 
+   function ">" (Left : Cursor; Right : Element_Type) return Boolean is
+   begin
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Left.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in "">""");
+
+      return Right < Left.Node.Element.all;
+   end ">";
+
    function ">" (Left : Element_Type; Right : Cursor) return Boolean is
    begin
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Right.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in "">""");
+
       return Right.Node.Element.all < Left;
    end ">";
 
@@ -313,6 +398,9 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (Container.Tree, Position.Node),
+                     "bad cursor in Delete");
+
       Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
       Free (Position.Node);
 
@@ -375,9 +463,35 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
 
    function Element (Position : Cursor) return Element_Type is
    begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Element");
+
       return Position.Node.Element.all;
    end Element;
 
+   -------------------------
+   -- Equivalent_Elements --
+   -------------------------
+
+   function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
+   begin
+      if Left < Right
+        or else Right < Left
+      then
+         return False;
+      else
+         return True;
+      end if;
+   end Equivalent_Elements;
+
    ---------------------
    -- Equivalent_Sets --
    ---------------------
@@ -420,6 +534,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
       Node : Node_Access := Element_Keys.Ceiling (Tree, Item);
       Done : constant Node_Access := Element_Keys.Upper_Bound (Tree, Item);
       X    : Node_Access;
+
    begin
       while Node /= Done loop
          X := Node;
@@ -464,6 +579,14 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
 
    function First_Element (Container : Set) return Element_Type is
    begin
+      if Container.Tree.First = null then
+         raise Constraint_Error;
+      end if;
+
+      if Container.Tree.First.Element = null then
+         raise Program_Error;
+      end if;
+
       return Container.Tree.First.Element.all;
    end First_Element;
 
@@ -490,11 +613,16 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
    procedure Free (X : in out Node_Access) is
       procedure Deallocate is
         new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+
    begin
       if X = null then
          return;
       end if;
 
+      X.Parent := X;
+      X.Left := X;
+      X.Right := X;
+
       begin
          Free_Element (X.Element);
       exception
@@ -538,34 +666,6 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
            Is_Less_Key_Node    => Is_Less_Key_Node,
            Is_Greater_Key_Node => Is_Greater_Key_Node);
 
-      ---------
-      -- "<" --
-      ---------
-
-      function "<" (Left : Key_Type; Right : Cursor) return Boolean is
-      begin
-         return Left < Right.Node.Element.all;
-      end "<";
-
-      function "<" (Left : Cursor; Right : Key_Type) return Boolean is
-      begin
-         return Right > Left.Node.Element.all;
-      end "<";
-
-      ---------
-      -- ">" --
-      ---------
-
-      function ">" (Left : Key_Type; Right : Cursor) return Boolean is
-      begin
-         return Left > Right.Node.Element.all;
-      end ">";
-
-      function ">" (Left : Cursor; Right : Key_Type) return Boolean is
-      begin
-         return Right < Left.Node.Element.all;
-      end ">";
-
       -------------
       -- Ceiling --
       -------------
@@ -621,11 +721,32 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
       -------------
 
       function Element (Container : Set; Key : Key_Type) return Element_Type is
-         Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
+         Node : constant Node_Access :=
+                  Key_Keys.Find (Container.Tree, Key);
+
       begin
+         if Node = null then
+            raise Constraint_Error;
+         end if;
+
          return Node.Element.all;
       end Element;
 
+      ---------------------
+      -- Equivalent_Keys --
+      ---------------------
+
+      function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
+      begin
+         if Left < Right
+           or else Right < Left
+         then
+            return False;
+         else
+            return True;
+         end if;
+      end Equivalent_Keys;
+
       -------------
       -- Exclude --
       -------------
@@ -681,9 +802,10 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
 
       function Is_Greater_Key_Node
         (Left  : Key_Type;
-         Right : Node_Access) return Boolean is
+         Right : Node_Access) return Boolean
+      is
       begin
-         return Left > Right.Element.all;
+         return Key (Right.Element.all) < Left;
       end Is_Greater_Key_Node;
 
       ----------------------
@@ -692,9 +814,10 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
 
       function Is_Less_Key_Node
         (Left  : Key_Type;
-         Right : Node_Access) return Boolean is
+         Right : Node_Access) return Boolean
+      is
       begin
-         return Left < Right.Element.all;
+         return Left < Key (Right.Element.all);
       end Is_Less_Key_Node;
 
       -------------
@@ -746,6 +869,17 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
 
       function Key (Position : Cursor) return Key_Type is
       begin
+         if Position.Node = null then
+            raise Constraint_Error;
+         end if;
+
+         if Position.Node.Element = null then
+            raise Program_Error;
+         end if;
+
+         pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                        "bad cursor in Key");
+
          return Key (Position.Node.Element.all);
       end Key;
 
@@ -812,13 +946,20 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
             raise Constraint_Error;
          end if;
 
+         if Position.Node.Element = null then
+            raise Program_Error;
+         end if;
+
          if Position.Container /= Container'Unrestricted_Access then
             raise Program_Error;
          end if;
 
+         pragma Assert (Vet (Container.Tree, Position.Node),
+                        "bad cursor in Update_Element_Preserving_Key");
+
          declare
             E : Element_Type renames Position.Node.Element.all;
-            K : Key_Type renames Key (E);
+            K : constant Key_Type := Key (E);
 
             B : Natural renames Tree.Busy;
             L : Natural renames Tree.Lock;
@@ -839,11 +980,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
             L := L - 1;
             B := B - 1;
 
-            if K < E
-              or else K > E
-            then
-               null;
-            else
+            if Equivalent_Keys (Left => K, Right => Key (E)) then
                return;
             end if;
          end;
@@ -884,6 +1021,24 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
       New_Item  : Element_Type;
       Position  : out Cursor)
    is
+   begin
+      Insert_Sans_Hint
+        (Container.Tree,
+         New_Item,
+         Position.Node);
+
+      Position.Container := Container'Unrestricted_Access;
+   end Insert;
+
+   ----------------------
+   -- Insert_Sans_Hint --
+   ----------------------
+
+   procedure Insert_Sans_Hint
+     (Tree     : in out Tree_Type;
+      New_Item : Element_Type;
+      Node     : out Node_Access)
+   is
       function New_Node return Node_Access;
       pragma Inline (New_Node);
 
@@ -904,7 +1059,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
          return new Node_Type'(Parent  => null,
                                Left    => null,
                                Right   => null,
-                               Color   => Red,
+                               Color   => Red_Black_Trees.Red,
                                Element => X);
 
       exception
@@ -913,16 +1068,14 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
             raise;
       end New_Node;
 
-   --  Start of processing for Insert
+   --  Start of processing for Insert_Sans_Hint
 
    begin
       Unconditional_Insert_Sans_Hint
-        (Container.Tree,
+        (Tree,
          New_Item,
-         Position.Node);
-
-      Position.Container := Container'Unrestricted_Access;
-   end Insert;
+         Node);
+   end Insert_Sans_Hint;
 
    ----------------------
    -- Insert_With_Hint --
@@ -1156,6 +1309,10 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
 
    function Last_Element (Container : Set) return Element_Type is
    begin
+      if Container.Tree.Last = null then
+         raise Constraint_Error;
+      end if;
+
       return Container.Tree.Last.Element.all;
    end Last_Element;
 
@@ -1199,6 +1356,9 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
          return No_Element;
       end if;
 
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Next");
+
       declare
          Node : constant Node_Access :=
                   Tree_Operations.Next (Position.Node);
@@ -1245,6 +1405,9 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
          return No_Element;
       end if;
 
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Previous");
+
       declare
          Node : constant Node_Access :=
                   Tree_Operations.Previous (Position.Node);
@@ -1271,29 +1434,40 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
      (Position : Cursor;
       Process  : not null access procedure (Element : Element_Type))
    is
-      E : Element_Type renames Position.Node.Element.all;
+   begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
-      S : Set renames Position.Container.all;
-      T : Tree_Type renames S.Tree'Unrestricted_Access.all;
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
 
-      B : Natural renames T.Busy;
-      L : Natural renames T.Lock;
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Query_Element");
 
-   begin
-      B := B + 1;
-      L := L + 1;
+      declare
+         T : Tree_Type renames Position.Container.Tree;
+
+         B : Natural renames T.Busy;
+         L : Natural renames T.Lock;
 
       begin
-         Process (E);
-      exception
-         when others =>
-            L := L - 1;
-            B := B - 1;
-            raise;
-      end;
+         B := B + 1;
+         L := L + 1;
 
-      L := L - 1;
-      B := B - 1;
+         begin
+            Process (Position.Node.Element.all);
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
+
+         L := L - 1;
+         B := B - 1;
+      end;
    end Query_Element;
 
    ----------
@@ -1334,6 +1508,14 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
       Read (Stream, Container.Tree);
    end Read;
 
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Read;
+
    ---------------------
    -- Replace_Element --
    ---------------------
@@ -1382,6 +1564,11 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
          function New_Node return Node_Access is
          begin
             Node.Element := new Element_Type'(Item);  -- OK if fails
+            Node.Color := Red_Black_Trees.Red;
+            Node.Parent := null;
+            Node.Left := null;
+            Node.Right := null;
+
             return Node;
          end New_Node;
 
@@ -1403,22 +1590,27 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
    end Replace_Element;
 
    procedure Replace_Element
-    (Container : Set;
+    (Container : in out Set;
      Position  : Cursor;
-     By        : Element_Type)
+     New_Item  : Element_Type)
    is
-      Tree : Tree_Type renames Position.Container.Tree'Unrestricted_Access.all;
-
    begin
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
+
       if Position.Container /= Container'Unrestricted_Access then
          raise Program_Error;
       end if;
 
-      Replace_Element (Tree, Position.Node, By);
+      pragma Assert (Vet (Container.Tree, Position.Node),
+                     "bad cursor in Replace_Element");
+
+      Replace_Element (Container.Tree, Position.Node, New_Item);
    end Replace_Element;
 
    ---------------------
@@ -1563,6 +1755,19 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
       return Set'(Controlled with Tree);
    end Symmetric_Difference;
 
+   ------------
+   -- To_Set --
+   ------------
+
+   function To_Set (New_Item : Element_Type) return Set is
+      Tree     : Tree_Type;
+      Node     : Node_Access;
+
+   begin
+      Insert_Sans_Hint (Tree, New_Item, Node);
+      return Set'(Controlled with Tree);
+   end To_Set;
+
    -----------
    -- Union --
    -----------
@@ -1613,4 +1818,12 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
       Write (Stream, Container.Tree);
    end Write;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Write;
+
 end Ada.Containers.Indefinite_Ordered_Multisets;

gcc/ada/a-ciormu.ads

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -47,6 +47,8 @@ generic
 package Ada.Containers.Indefinite_Ordered_Multisets is
    pragma Preelaborate;
 
+   function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
+
    type Set is tagged private;
 
    type Cursor is private;
@@ -59,6 +61,8 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
 
    function Equivalent_Sets (Left, Right : Set) return Boolean;
 
+   function To_Set (New_Item : Element_Type) return Set;
+
    function Length (Container : Set) return Count_Type;
 
    function Is_Empty (Container : Set) return Boolean;
@@ -67,15 +71,15 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
 
    function Element (Position : Cursor) return Element_Type;
 
+   procedure Replace_Element
+     (Container : in out Set;
+      Position  : Cursor;
+      New_Item  : Element_Type);
+
    procedure Query_Element
      (Position : Cursor;
       Process  : not null access procedure (Element : Element_Type));
 
-   procedure Replace_Element
-     (Container : Set;
-      Position  : Cursor;
-      By        : Element_Type);
-
    procedure Move (Target : in out Set; Source : in out Set);
 
    procedure Insert
@@ -85,6 +89,14 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
 
    procedure Insert (Container : in out Set; New_Item : Element_Type);
 
+--  TODO: include Replace too???
+--
+--     procedure Replace
+--       (Container : in out Set;
+--        New_Item  : Element_Type);
+
+   procedure Exclude (Container : in out Set; Item : Element_Type);
+
    procedure Delete (Container : in out Set; Item : Element_Type);
 
    procedure Delete (Container : in out Set; Position : in out Cursor);
@@ -93,10 +105,7 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
 
    procedure Delete_Last (Container : in out Set);
 
-   procedure Exclude (Container : in out Set; Item : Element_Type);
-
-   procedure Union (Target : in out Set;
-                    Source : Set);
+   procedure Union (Target : in out Set; Source : Set);
 
    function Union (Left, Right : Set) return Set;
 
@@ -124,14 +133,6 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
 
    function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
 
-   function Contains (Container : Set; Item : Element_Type) return Boolean;
-
-   function Find (Container : Set; Item : Element_Type) return Cursor;
-
-   function Floor (Container : Set; Item : Element_Type) return Cursor;
-
-   function Ceiling (Container : Set; Item : Element_Type) return Cursor;
-
    function First (Container : Set) return Cursor;
 
    function First_Element (Container : Set) return Element_Type;
@@ -148,6 +149,14 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
 
    procedure Previous (Position : in out Cursor);
 
+   function Find (Container : Set; Item : Element_Type) return Cursor;
+
+   function Floor (Container : Set; Item : Element_Type) return Cursor;
+
+   function Ceiling (Container : Set; Item : Element_Type) return Cursor;
+
+   function Contains (Container : Set; Item : Element_Type) return Boolean;
+
    function Has_Element (Position : Cursor) return Boolean;
 
    function "<" (Left, Right : Cursor) return Boolean;
@@ -181,42 +190,31 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
       Process   : not null access procedure (Position : Cursor));
 
    generic
-
-      type Key_Type (<>) is limited private;
+      type Key_Type (<>) is private;
 
       with function Key (Element : Element_Type) return Key_Type;
 
-      with function "<" (Left : Key_Type; Right : Element_Type)
-          return Boolean is <>;
-
-      with function ">" (Left : Key_Type; Right : Element_Type)
-          return Boolean is <>;
+      with function "<" (Left, Right : Key_Type) return Boolean is <>;
 
    package Generic_Keys is
 
-      function Contains (Container : Set; Key : Key_Type) return Boolean;
-
-      function Find (Container : Set; Key : Key_Type) return Cursor;
-
-      function Floor (Container : Set; Key : Key_Type) return Cursor;
-
-      function Ceiling (Container : Set; Key : Key_Type) return Cursor;
+      function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
 
       function Key (Position : Cursor) return Key_Type;
 
       function Element (Container : Set; Key : Key_Type) return Element_Type;
 
-      procedure Delete (Container : in out Set; Key : Key_Type);
-
       procedure Exclude (Container : in out Set; Key : Key_Type);
 
-      function "<" (Left : Cursor; Right : Key_Type) return Boolean;
+      procedure Delete (Container : in out Set; Key : Key_Type);
 
-      function ">" (Left : Cursor; Right : Key_Type) return Boolean;
+      function Find (Container : Set; Key : Key_Type) return Cursor;
 
-      function "<" (Left : Key_Type; Right : Cursor) return Boolean;
+      function Floor (Container : Set; Key : Key_Type) return Cursor;
 
-      function ">" (Left : Key_Type; Right : Cursor) return Boolean;
+      function Ceiling (Container : Set; Key : Key_Type) return Cursor;
+
+      function Contains (Container : Set; Key : Key_Type) return Boolean;
 
       procedure Update_Element_Preserving_Key
         (Container : in out Set;
@@ -266,6 +264,7 @@ private
    use Red_Black_Trees;
    use Tree_Types;
    use Ada.Finalization;
+   use Ada.Streams;
 
    type Set_Access is access all Set;
    for Set_Access'Storage_Size use 0;
@@ -275,9 +274,19 @@ private
       Node      : Node_Access;
    end record;
 
-   No_Element : constant Cursor := Cursor'(null, null);
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor);
 
-   use Ada.Streams;
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
+   No_Element : constant Cursor := Cursor'(null, null);
 
    procedure Write (Stream : access Root_Stream_Type'Class; Container : Set);
 

gcc/ada/a-ciorse.adb

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -59,6 +59,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
    procedure Free (X : in out Node_Access);
 
+   procedure Insert_Sans_Hint
+     (Tree     : in out Tree_Type;
+      New_Item : Element_Type;
+      Node     : out Node_Access;
+      Inserted : out Boolean);
+
    procedure Insert_With_Hint
      (Dst_Tree : in out Tree_Type;
       Dst_Hint : Node_Access;
@@ -144,16 +150,56 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
    function "<" (Left, Right : Cursor) return Boolean is
    begin
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
+      if Left.Node.Element = null
+        or else Right.Node.Element = null
+      then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in ""<""");
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in ""<""");
+
       return Left.Node.Element.all < Right.Node.Element.all;
    end "<";
 
    function "<" (Left : Cursor; Right : Element_Type) return Boolean is
    begin
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Left.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in ""<""");
+
       return Left.Node.Element.all < Right;
    end "<";
 
    function "<" (Left : Element_Type; Right : Cursor) return Boolean is
    begin
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Right.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in ""<""");
+
       return Left < Right.Node.Element.all;
    end "<";
 
@@ -190,6 +236,24 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
    function ">" (Left, Right : Cursor) return Boolean is
    begin
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
+      if Left.Node.Element = null
+        or else Right.Node.Element = null
+      then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in "">""");
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in "">""");
+
       --  L > R same as R < L
 
       return Right.Node.Element.all < Left.Node.Element.all;
@@ -197,11 +261,33 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
    function ">" (Left : Cursor; Right : Element_Type) return Boolean is
    begin
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Left.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in "">""");
+
       return Right < Left.Node.Element.all;
    end ">";
 
    function ">" (Left : Element_Type; Right : Cursor) return Boolean is
    begin
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Right.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in "">""");
+
       return Right.Node.Element.all < Left;
    end ">";
 
@@ -296,6 +382,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (Container.Tree, Position.Node),
+                     "bad cursor in Delete");
+
       Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
       Free (Position.Node);
       Position.Container := null;
@@ -310,7 +399,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          raise Constraint_Error;
       end if;
 
-      Delete_Node_Sans_Free (Container.Tree, X);
+      Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
       Free (X);
    end Delete;
 
@@ -366,6 +455,17 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
    function Element (Position : Cursor) return Element_Type is
    begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Element");
+
       return Position.Node.Element.all;
    end Element;
 
@@ -467,6 +567,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
    function First_Element (Container : Set) return Element_Type is
    begin
+      if Container.Tree.First = null then
+         raise Constraint_Error;
+      end if;
+
       return Container.Tree.First.Element.all;
    end First_Element;
 
@@ -491,7 +595,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    ----------
 
    procedure Free (X : in out Node_Access) is
-
       procedure Deallocate is
         new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
 
@@ -500,6 +603,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          return;
       end if;
 
+      X.Parent := X;
+      X.Left := X;
+      X.Right := X;
+
       begin
          Free_Element (X.Element);
       exception
@@ -593,6 +700,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
                   Key_Keys.Find (Container.Tree, Key);
 
       begin
+         if Node = null then
+            raise Constraint_Error;
+         end if;
+
          return Node.Element.all;
       end Element;
 
@@ -685,6 +796,17 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
       function Key (Position : Cursor) return Key_Type is
       begin
+         if Position.Node = null then
+            raise Constraint_Error;
+         end if;
+
+         if Position.Node.Element = null then
+            raise Program_Error;
+         end if;
+
+         pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                        "bad cursor in Key");
+
          return Key (Position.Node.Element.all);
       end Key;
 
@@ -724,10 +846,17 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
             raise Constraint_Error;
          end if;
 
+         if Position.Node.Element = null then
+            raise Program_Error;
+         end if;
+
          if Position.Container /= Container'Unrestricted_Access then
             raise Program_Error;
          end if;
 
+         pragma Assert (Vet (Container.Tree, Position.Node),
+                        "bad cursor in Update_Element_Preserving_Key");
+
          declare
             E : Element_Type renames Position.Node.Element.all;
             K : constant Key_Type := Key (E);
@@ -811,13 +940,44 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       Position  : out Cursor;
       Inserted  : out Boolean)
    is
+   begin
+      Insert_Sans_Hint
+        (Container.Tree,
+         New_Item,
+         Position.Node,
+         Inserted);
+
+      Position.Container := Container'Unrestricted_Access;
+   end Insert;
+
+   procedure Insert (Container : in out Set; New_Item  : Element_Type) is
+      Position : Cursor;
+      Inserted : Boolean;
+   begin
+      Insert (Container, New_Item, Position, Inserted);
+
+      if not Inserted then
+         raise Constraint_Error;
+      end if;
+   end Insert;
+
+   ----------------------
+   -- Insert_Sans_Hint --
+   ----------------------
+
+   procedure Insert_Sans_Hint
+     (Tree     : in out Tree_Type;
+      New_Item : Element_Type;
+      Node     : out Node_Access;
+      Inserted : out Boolean)
+   is
       function New_Node return Node_Access;
       pragma Inline (New_Node);
 
       procedure Insert_Post is
         new Element_Keys.Generic_Insert_Post (New_Node);
 
-      procedure Insert_Sans_Hint is
+      procedure Conditional_Insert_Sans_Hint is
         new Element_Keys.Generic_Conditional_Insert (Insert_Post);
 
       --------------
@@ -826,11 +986,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
       function New_Node return Node_Access is
          Element : Element_Access := new Element_Type'(New_Item);
+
       begin
          return new Node_Type'(Parent  => null,
                                Left    => null,
                                Right   => null,
-                               Color   => Red,
+                               Color   => Red_Black_Trees.Red,
                                Element => Element);
       exception
          when others =>
@@ -838,28 +999,15 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
             raise;
       end New_Node;
 
-   --  Start of processing for Insert
+   --  Start of processing for Insert_Sans_Hint
 
    begin
-      Insert_Sans_Hint
-        (Container.Tree,
+      Conditional_Insert_Sans_Hint
+        (Tree,
          New_Item,
-         Position.Node,
+         Node,
          Inserted);
-
-      Position.Container := Container'Unrestricted_Access;
-   end Insert;
-
-   procedure Insert (Container : in out Set; New_Item  : Element_Type) is
-      Position : Cursor;
-      Inserted : Boolean;
-   begin
-      Insert (Container, New_Item, Position, Inserted);
-
-      if not Inserted then
-         raise Constraint_Error;
-      end if;
-   end Insert;
+   end Insert_Sans_Hint;
 
    ----------------------
    -- Insert_With_Hint --
@@ -1047,6 +1195,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
    function Last_Element (Container : Set) return Element_Type is
    begin
+      if Container.Tree.Last = null then
+         raise Constraint_Error;
+      end if;
+
       return Container.Tree.Last.Element.all;
    end Last_Element;
 
@@ -1095,6 +1247,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          return No_Element;
       end if;
 
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Next");
+
       declare
          Node : constant Node_Access :=
                   Tree_Operations.Next (Position.Node);
@@ -1141,6 +1296,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          return No_Element;
       end if;
 
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Previous");
+
       declare
          Node : constant Node_Access :=
                   Tree_Operations.Previous (Position.Node);
@@ -1162,29 +1320,40 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
      (Position  : Cursor;
       Process   : not null access procedure (Element : Element_Type))
    is
-      E : Element_Type renames Position.Node.Element.all;
+   begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
-      S : Set renames Position.Container.all;
-      T : Tree_Type renames S.Tree'Unrestricted_Access.all;
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
 
-      B : Natural renames T.Busy;
-      L : Natural renames T.Lock;
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Query_Element");
 
-   begin
-      B := B + 1;
-      L := L + 1;
+      declare
+         T : Tree_Type renames Position.Container.Tree;
+
+         B : Natural renames T.Busy;
+         L : Natural renames T.Lock;
 
       begin
-         Process (E);
-      exception
-         when others =>
-            L := L - 1;
-            B := B - 1;
-            raise;
-      end;
+         B := B + 1;
+         L := L + 1;
 
-      L := L - 1;
-      B := B - 1;
+         begin
+            Process (Position.Node.Element.all);
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
+
+         L := L - 1;
+         B := B - 1;
+      end;
    end Query_Element;
 
    ----------
@@ -1227,6 +1396,14 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       Read (Stream, Container.Tree);
    end Read;
 
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Read;
+
    -------------
    -- Replace --
    -------------
@@ -1242,6 +1419,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          raise Constraint_Error;
       end if;
 
+      if Container.Tree.Lock > 0 then
+         raise Program_Error;
+      end if;
+
       X := Node.Element;
       Node.Element := new Element_Type'(New_Item);
       Free_Element (X);
@@ -1295,6 +1476,11 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          function New_Node return Node_Access is
          begin
             Node.Element := new Element_Type'(Item);  -- OK if fails
+            Node.Color := Red;
+            Node.Parent := null;
+            Node.Right := null;
+            Node.Left := null;
+
             return Node;
          end New_Node;
 
@@ -1340,6 +1526,11 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
          function New_Node return Node_Access is
          begin
+            Node.Color := Red;
+            Node.Parent := null;
+            Node.Right := null;
+            Node.Left := null;
+
             return Node;
          end New_Node;
 
@@ -1372,10 +1563,17 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          raise Constraint_Error;
       end if;
 
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
+
       if Position.Container /= Container'Unrestricted_Access then
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (Container.Tree, Position.Node),
+                     "bad cursor in Replace_Element");
+
       Replace_Element (Container.Tree, Position.Node, New_Item);
    end Replace_Element;
 
@@ -1482,6 +1680,20 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       return Set'(Controlled with Tree);
    end Symmetric_Difference;
 
+   ------------
+   -- To_Set --
+   ------------
+
+   function To_Set (New_Item : Element_Type) return Set is
+      Tree     : Tree_Type;
+      Node     : Node_Access;
+      Inserted : Boolean;
+
+   begin
+      Insert_Sans_Hint (Tree, New_Item, Node, Inserted);
+      return Set'(Controlled with Tree);
+   end To_Set;
+
    -----------
    -- Union --
    -----------
@@ -1532,4 +1744,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       Write (Stream, Container.Tree);
    end Write;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Write;
+
 end Ada.Containers.Indefinite_Ordered_Sets;

gcc/ada/a-ciorse.ads

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -61,6 +61,8 @@ package Ada.Containers.Indefinite_Ordered_Sets is
 
    function Equivalent_Sets (Left, Right : Set) return Boolean;
 
+   function To_Set (New_Item : Element_Type) return Set;
+
    function Length (Container : Set) return Count_Type;
 
    function Is_Empty (Container : Set) return Boolean;
@@ -266,6 +268,7 @@ private
    use Red_Black_Trees;
    use Tree_Types;
    use Ada.Finalization;
+   use Ada.Streams;
 
    type Set_Access is access all Set;
    for Set_Access'Storage_Size use 0;
@@ -275,9 +278,19 @@ private
       Node      : Node_Access;
    end record;
 
-   No_Element : constant Cursor := Cursor'(null, null);
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor);
 
-   use Ada.Streams;
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
+   No_Element : constant Cursor := Cursor'(null, null);
 
    procedure Write
      (Stream    : access Root_Stream_Type'Class;

gcc/ada/a-cohama.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -624,6 +624,7 @@ package body Ada.Containers.Hashed_Maps is
       declare
          HT   : Hash_Table_Type renames Position.Container.HT;
          Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
+
       begin
          if Node = null then
             return No_Element;
@@ -695,6 +696,14 @@ package body Ada.Containers.Hashed_Maps is
       Read_Nodes (Stream, Container.HT);
    end Read;
 
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Read;
+
    ---------------
    -- Read_Node --
    ---------------
@@ -743,7 +752,11 @@ package body Ada.Containers.Hashed_Maps is
    -- Replace_Element --
    ---------------------
 
-   procedure Replace_Element (Position : Cursor; By : Element_Type) is
+   procedure Replace_Element
+     (Container : in out Map;
+      Position  : Cursor;
+      New_Item  : Element_Type)
+   is
    begin
       pragma Assert (Vet (Position), "bad cursor in Replace_Element");
 
@@ -751,11 +764,15 @@ package body Ada.Containers.Hashed_Maps is
          raise Constraint_Error;
       end if;
 
+      if Position.Container /= Container'Unrestricted_Access then
+         raise Program_Error;
+      end if;
+
       if Position.Container.HT.Lock > 0 then
          raise Program_Error;
       end if;
 
-      Position.Node.Element := By;
+      Position.Node.Element := New_Item;
    end Replace_Element;
 
    ----------------------
@@ -784,9 +801,10 @@ package body Ada.Containers.Hashed_Maps is
    --------------------
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access procedure (Key     : Key_Type;
-                                            Element : in out Element_Type))
+     (Container : in out Map;
+      Position  : Cursor;
+      Process   : not null access procedure (Key     : Key_Type;
+                                             Element : in out Element_Type))
    is
    begin
       pragma Assert (Vet (Position), "bad cursor in Update_Element");
@@ -795,12 +813,14 @@ package body Ada.Containers.Hashed_Maps is
          raise Constraint_Error;
       end if;
 
-      declare
-         M  : Map renames Position.Container.all;
-         HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
+      if Position.Container /= Container'Unrestricted_Access then
+         raise Program_Error;
+      end if;
 
-         B : Natural renames HT.Busy;
-         L : Natural renames HT.Lock;
+      declare
+         HT : Hash_Table_Type renames Container.HT;
+         B  : Natural renames HT.Busy;
+         L  : Natural renames HT.Lock;
 
       begin
          B := B + 1;
@@ -809,7 +829,6 @@ package body Ada.Containers.Hashed_Maps is
          declare
             K : Key_Type renames Position.Node.Key;
             E : Element_Type renames Position.Node.Element;
-
          begin
             Process (K, E);
          exception
@@ -891,6 +910,14 @@ package body Ada.Containers.Hashed_Maps is
       Write_Nodes (Stream, Container.HT);
    end Write;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Write;
+
    ----------------
    -- Write_Node --
    ----------------

gcc/ada/a-cohama.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -39,13 +39,10 @@ with Ada.Finalization;
 
 generic
    type Key_Type is private;
-
    type Element_Type is private;
 
    with function Hash (Key : Key_Type) return Hash_Type;
-
    with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
-
    with function "=" (Left, Right : Element_Type) return Boolean is <>;
 
 package Ada.Containers.Hashed_Maps is
@@ -61,6 +58,11 @@ package Ada.Containers.Hashed_Maps is
 
    function "=" (Left, Right : Map) return Boolean;
 
+   function Capacity (Container : Map) return Count_Type;
+
+   procedure Reserve_Capacity (Container : in out Map;
+                               Capacity  : Count_Type);
+
    function Length (Container : Map) return Count_Type;
 
    function Is_Empty (Container : Map) return Boolean;
@@ -71,18 +73,22 @@ package Ada.Containers.Hashed_Maps is
 
    function Element (Position : Cursor) return Element_Type;
 
+   procedure Replace_Element
+     (Container : in out Map;
+      Position  : Cursor;
+      New_Item  : Element_Type);
+
    procedure Query_Element
      (Position : Cursor;
       Process  : not null access
                    procedure (Key : Key_Type; Element : Element_Type));
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access
+     (Container : in out Map;
+      Position  : Cursor;
+      Process   : not null access
                    procedure (Key : Key_Type; Element : in out Element_Type));
 
-   procedure Replace_Element (Position : Cursor; By : Element_Type);
-
    procedure Move (Target : in out Map; Source : in out Map);
 
    procedure Insert
@@ -113,17 +119,11 @@ package Ada.Containers.Hashed_Maps is
       Key       : Key_Type;
       New_Item  : Element_Type);
 
-   procedure Delete (Container : in out Map; Key : Key_Type);
-
-   procedure Delete (Container : in out Map; Position : in out Cursor);
-
    procedure Exclude (Container : in out Map; Key : Key_Type);
 
-   function Contains (Container : Map; Key : Key_Type) return Boolean;
-
-   function Find (Container : Map; Key : Key_Type) return Cursor;
+   procedure Delete (Container : in out Map; Key : Key_Type);
 
-   function Element (Container : Map; Key : Key_Type) return Element_Type;
+   procedure Delete (Container : in out Map; Position : in out Cursor);
 
    function First (Container : Map) return Cursor;
 
@@ -131,6 +131,12 @@ package Ada.Containers.Hashed_Maps is
 
    procedure Next (Position : in out Cursor);
 
+   function Find (Container : Map; Key : Key_Type) return Cursor;
+
+   function Contains (Container : Map; Key : Key_Type) return Boolean;
+
+   function Element (Container : Map; Key : Key_Type) return Element_Type;
+
    function Has_Element (Position : Cursor) return Boolean;
 
    function Equivalent_Keys (Left, Right : Cursor) return Boolean;
@@ -143,11 +149,6 @@ package Ada.Containers.Hashed_Maps is
      (Container : Map;
       Process   : not null access procedure (Position : Cursor));
 
-   function Capacity (Container : Map) return Count_Type;
-
-   procedure Reserve_Capacity (Container : in out Map;
-                               Capacity  : Count_Type);
-
 private
    pragma Inline ("=");
    pragma Inline (Length);
@@ -211,6 +212,18 @@ private
          Node      : Node_Access;
       end record;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor);
+
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
    No_Element : constant Cursor := (Container => null, Node => null);
 
 end Ada.Containers.Hashed_Maps;

gcc/ada/a-cohase.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -72,6 +72,12 @@ package body Ada.Containers.Hashed_Sets is
    function Hash_Node (Node : Node_Access) return Hash_Type;
    pragma Inline (Hash_Node);
 
+   procedure Insert
+     (HT       : in out Hash_Table_Type;
+      New_Item : Element_Type;
+      Node     : out Node_Access;
+      Inserted : out Boolean);
+
    function Is_In
      (HT  : Hash_Table_Type;
       Key : Node_Access) return Boolean;
@@ -595,6 +601,32 @@ package body Ada.Containers.Hashed_Sets is
       Position  : out Cursor;
       Inserted  : out Boolean)
    is
+   begin
+      Insert (Container.HT, New_Item, Position.Node, Inserted);
+      Position.Container := Container'Unchecked_Access;
+   end Insert;
+
+   procedure Insert
+     (Container : in out Set;
+      New_Item  : Element_Type)
+   is
+      Position : Cursor;
+      Inserted : Boolean;
+
+   begin
+      Insert (Container, New_Item, Position, Inserted);
+
+      if not Inserted then
+         raise Constraint_Error;
+      end if;
+   end Insert;
+
+   procedure Insert
+     (HT       : in out Hash_Table_Type;
+      New_Item : Element_Type;
+      Node     : out Node_Access;
+      Inserted : out Boolean)
+   is
       function New_Node (Next : Node_Access) return Node_Access;
       pragma Inline (New_Node);
 
@@ -606,13 +638,10 @@ package body Ada.Containers.Hashed_Sets is
       --------------
 
       function New_Node (Next : Node_Access) return Node_Access is
-         Node : constant Node_Access := new Node_Type'(New_Item, Next);
       begin
-         return Node;
+         return new Node_Type'(New_Item, Next);
       end New_Node;
 
-      HT : Hash_Table_Type renames Container.HT;
-
    --  Start of processing for Insert
 
    begin
@@ -620,30 +649,13 @@ package body Ada.Containers.Hashed_Sets is
          HT_Ops.Reserve_Capacity (HT, 1);
       end if;
 
-      Local_Insert (HT, New_Item, Position.Node, Inserted);
+      Local_Insert (HT, New_Item, Node, Inserted);
 
       if Inserted
         and then HT.Length > HT_Ops.Capacity (HT)
       then
          HT_Ops.Reserve_Capacity (HT, HT.Length);
       end if;
-
-      Position.Container := Container'Unchecked_Access;
-   end Insert;
-
-   procedure Insert
-     (Container : in out Set;
-      New_Item  : Element_Type)
-   is
-      Position : Cursor;
-      Inserted : Boolean;
-
-   begin
-      Insert (Container, New_Item, Position, Inserted);
-
-      if not Inserted then
-         raise Constraint_Error;
-      end if;
    end Insert;
 
    ------------------
@@ -970,6 +982,14 @@ package body Ada.Containers.Hashed_Sets is
       Read_Nodes (Stream, Container.HT);
    end Read;
 
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Read;
+
    ---------------
    -- Read_Node --
    ---------------
@@ -1366,6 +1386,20 @@ package body Ada.Containers.Hashed_Sets is
       return (Controlled with HT => (Buckets, Length, 0, 0));
    end Symmetric_Difference;
 
+   ------------
+   -- To_Set --
+   ------------
+
+   function To_Set (New_Item : Element_Type) return Set is
+      HT       : Hash_Table_Type;
+      Node     : Node_Access;
+      Inserted : Boolean;
+
+   begin
+      Insert (HT, New_Item, Node, Inserted);
+      return Set'(Controlled with HT);
+   end To_Set;
+
    -----------
    -- Union --
    -----------
@@ -1595,6 +1629,14 @@ package body Ada.Containers.Hashed_Sets is
       Write_Nodes (Stream, Container.HT);
    end Write;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Write;
+
    ----------------
    -- Write_Node --
    ----------------

gcc/ada/a-cohase.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -62,6 +62,8 @@ package Ada.Containers.Hashed_Sets is
 
    function Equivalent_Sets (Left, Right : Set) return Boolean;
 
+   function To_Set (New_Item : Element_Type) return Set;
+
    function Capacity (Container : Set) return Count_Type;
 
    procedure Reserve_Capacity
@@ -222,6 +224,7 @@ private
 
    use HT_Types;
    use Ada.Finalization;
+   use Ada.Streams;
 
    type Set_Access is access all Set;
    for Set_Access'Storage_Size use 0;
@@ -232,9 +235,19 @@ private
          Node      : Node_Access;
       end record;
 
-   No_Element : constant Cursor := (Container => null, Node => null);
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor);
 
-   use Ada.Streams;
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
+   No_Element : constant Cursor := (Container => null, Node => null);
 
    procedure Write
      (Stream    : access Root_Stream_Type'Class;

gcc/ada/a-coinve.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -475,44 +475,6 @@ package body Ada.Containers.Indefinite_Vectors is
          Count);
    end Append;
 
-   ------------
-   -- Assign --
-   ------------
-
-   procedure Assign
-     (Target : in out Vector;
-      Source : Vector)
-   is
-      N : constant Count_Type := Length (Source);
-
-   begin
-      if Target'Address = Source'Address then
-         return;
-      end if;
-
-      Clear (Target);
-
-      if N = 0 then
-         return;
-      end if;
-
-      if N > Capacity (Target) then
-         Reserve_Capacity (Target, Capacity => N);
-      end if;
-
-      for J in Index_Type'First .. Source.Last loop
-         declare
-            EA : constant Element_Access := Source.Elements (J);
-         begin
-            if EA /= null then
-               Target.Elements (J) := new Element_Type'(EA.all);
-            end if;
-         end;
-
-         Target.Last := J;
-      end loop;
-   end Assign;
-
    --------------
    -- Capacity --
    --------------
@@ -553,7 +515,8 @@ package body Ada.Containers.Indefinite_Vectors is
 
    function Contains
      (Container : Vector;
-      Item      : Element_Type) return Boolean is
+      Item      : Element_Type) return Boolean
+   is
    begin
       return Find_Index (Container, Item) /= No_Index;
    end Contains;
@@ -649,8 +612,7 @@ package body Ada.Containers.Indefinite_Vectors is
          raise Constraint_Error;
       end if;
 
-      if Position.Container /=
-           Vector_Access'(Container'Unchecked_Access)
+      if Position.Container /= Container'Unchecked_Access
         or else Position.Index > Container.Last
       then
          raise Program_Error;
@@ -658,11 +620,7 @@ package body Ada.Containers.Indefinite_Vectors is
 
       Delete (Container, Position.Index, Count);
 
-      if Position.Index <= Container.Last then
-         Position := (Container'Unchecked_Access, Position.Index);
-      else
-         Position := No_Element;
-      end if;
+      Position := No_Element;  -- See comment in a-convec.adb
    end Delete;
 
    ------------------
@@ -738,7 +696,16 @@ package body Ada.Containers.Indefinite_Vectors is
          raise Constraint_Error;
       end if;
 
-      return Container.Elements (Index).all;
+      declare
+         EA : constant Element_Access := Container.Elements (Index);
+
+      begin
+         if EA = null then
+            raise Constraint_Error;
+         end if;
+
+         return EA.all;
+      end;
    end Element;
 
    function Element (Position : Cursor) return Element_Type is
@@ -773,13 +740,12 @@ package body Ada.Containers.Indefinite_Vectors is
    function Find
      (Container : Vector;
       Item      : Element_Type;
-      Position  : Cursor := No_Element) return Cursor is
-
+      Position  : Cursor := No_Element) return Cursor
+   is
    begin
       if Position.Container /= null
-        and then (Position.Container /=
-                    Vector_Access'(Container'Unchecked_Access)
-                  or else Position.Index > Container.Last)
+        and then (Position.Container /= Container'Unchecked_Access
+                    or else Position.Index > Container.Last)
       then
          raise Program_Error;
       end if;
@@ -802,7 +768,8 @@ package body Ada.Containers.Indefinite_Vectors is
    function Find_Index
      (Container : Vector;
       Item      : Element_Type;
-      Index     : Index_Type := Index_Type'First) return Extended_Index is
+      Index     : Index_Type := Index_Type'First) return Extended_Index
+   is
    begin
       for Indx in Index .. Container.Last loop
          if Container.Elements (Indx) /= null
@@ -1287,7 +1254,7 @@ package body Ada.Containers.Indefinite_Vectors is
 
    begin
       if Before.Container /= null
-        and then Before.Container /= Vector_Access'(Container'Unchecked_Access)
+        and then Before.Container /= Container'Unchecked_Access
       then
          raise Program_Error;
       end if;
@@ -1843,6 +1810,10 @@ package body Ada.Containers.Indefinite_Vectors is
          raise Constraint_Error;
       end if;
 
+      if V.Elements (Index) = null then
+         raise Constraint_Error;
+      end if;
+
       B := B + 1;
       L := L + 1;
 
@@ -1907,14 +1878,22 @@ package body Ada.Containers.Indefinite_Vectors is
       end loop;
    end Read;
 
+   procedure Read
+     (Stream   : access Root_Stream_Type'Class;
+      Position : out Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Read;
+
    ---------------------
    -- Replace_Element --
    ---------------------
 
    procedure Replace_Element
-     (Container : Vector;
+     (Container : in out Vector;
       Index     : Index_Type;
-      By        : Element_Type)
+      New_Item  : Element_Type)
    is
    begin
       if Index > Container.Last then
@@ -1928,18 +1907,26 @@ package body Ada.Containers.Indefinite_Vectors is
       declare
          X : Element_Access := Container.Elements (Index);
       begin
-         Container.Elements (Index) := new Element_Type'(By);
+         Container.Elements (Index) := new Element_Type'(New_Item);
          Free (X);
       end;
    end Replace_Element;
 
-   procedure Replace_Element (Position : Cursor; By : Element_Type) is
+   procedure Replace_Element
+     (Container : in out Vector;
+      Position  : Cursor;
+      New_Item  : Element_Type)
+   is
    begin
       if Position.Container = null then
          raise Constraint_Error;
       end if;
 
-      Replace_Element (Position.Container.all, Position.Index, By);
+      if Position.Container /= Container'Unrestricted_Access then
+         raise Program_Error;
+      end if;
+
+      Replace_Element (Container, Position.Index, New_Item);
    end Replace_Element;
 
    ----------------------
@@ -2083,6 +2070,41 @@ package body Ada.Containers.Indefinite_Vectors is
       end;
    end Reserve_Capacity;
 
+   ----------------------
+   -- Reverse_Elements --
+   ----------------------
+
+   procedure Reverse_Elements (Container : in out Vector) is
+   begin
+      if Container.Length <= 1 then
+         return;
+      end if;
+
+      if Container.Lock > 0 then
+         raise Program_Error;
+      end if;
+
+      declare
+         I : Index_Type := Index_Type'First;
+         J : Index_Type := Container.Last;
+         E : Elements_Type renames Container.Elements.all;
+
+      begin
+         while I < J loop
+            declare
+               EI : constant Element_Access := E (I);
+
+            begin
+               E (I) := E (J);
+               E (J) := EI;
+            end;
+
+            I := I + 1;
+            J := J - 1;
+         end loop;
+      end;
+   end Reverse_Elements;
+
    ------------------
    -- Reverse_Find --
    ------------------
@@ -2096,8 +2118,7 @@ package body Ada.Containers.Indefinite_Vectors is
 
    begin
       if Position.Container /= null
-        and then Position.Container /=
-                   Vector_Access'(Container'Unchecked_Access)
+        and then Position.Container /= Container'Unchecked_Access
       then
          raise Program_Error;
       end if;
@@ -2230,7 +2251,7 @@ package body Ada.Containers.Indefinite_Vectors is
    ----------
 
    procedure Swap
-     (Container : Vector;
+     (Container : in out Vector;
       I, J      : Index_Type)
    is
    begin
@@ -2260,7 +2281,9 @@ package body Ada.Containers.Indefinite_Vectors is
       end;
    end Swap;
 
-   procedure Swap (I, J : Cursor)
+   procedure Swap
+     (Container : in out Vector;
+      I, J      : Cursor)
    is
    begin
       if I.Container = null
@@ -2269,11 +2292,13 @@ package body Ada.Containers.Indefinite_Vectors is
          raise Constraint_Error;
       end if;
 
-      if I.Container /= J.Container then
+      if I.Container /= Container'Unrestricted_Access
+        or else J.Container /= Container'Unrestricted_Access
+      then
          raise Program_Error;
       end if;
 
-      Swap (I.Container.all, I.Index, J.Index);
+      Swap (Container, I.Index, J.Index);
    end Swap;
 
    ---------------
@@ -2387,24 +2412,27 @@ package body Ada.Containers.Indefinite_Vectors is
    --------------------
 
    procedure Update_Element
-     (Container : Vector;
+     (Container : in out Vector;
       Index     : Index_Type;
       Process   : not null access procedure (Element : in out Element_Type))
    is
-      V : Vector renames Container'Unrestricted_Access.all;
-      B : Natural renames V.Busy;
-      L : Natural renames V.Lock;
+      B : Natural renames Container.Busy;
+      L : Natural renames Container.Lock;
 
    begin
       if Index > Container.Last then
          raise Constraint_Error;
       end if;
 
+      if Container.Elements (Index) = null then
+         raise Constraint_Error;
+      end if;
+
       B := B + 1;
       L := L + 1;
 
       begin
-         Process (V.Elements (Index).all);
+         Process (Container.Elements (Index).all);
       exception
          when others =>
             L := L - 1;
@@ -2417,15 +2445,20 @@ package body Ada.Containers.Indefinite_Vectors is
    end Update_Element;
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access procedure (Element : in out Element_Type))
+     (Container : in out Vector;
+      Position  : Cursor;
+      Process   : not null access procedure (Element : in out Element_Type))
    is
    begin
       if Position.Container = null then
          raise Constraint_Error;
       end if;
 
-      Update_Element (Position.Container.all, Position.Index, Process);
+      if Position.Container /= Container'Unrestricted_Access then
+         raise Program_Error;
+      end if;
+
+      Update_Element (Container, Position.Index, Process);
    end Update_Element;
 
    -----------
@@ -2466,4 +2499,12 @@ package body Ada.Containers.Indefinite_Vectors is
       end;
    end Write;
 
+   procedure Write
+     (Stream   : access Root_Stream_Type'Class;
+      Position : Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Write;
+
 end Ada.Containers.Indefinite_Vectors;

gcc/ada/a-coinve.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -38,7 +38,6 @@ with Ada.Streams;
 
 generic
    type Index_Type is range <>;
-
    type Element_Type (<>) is private;
 
    with function "=" (Left, Right : Element_Type) return Boolean is <>;
@@ -52,8 +51,6 @@ package Ada.Containers.Indefinite_Vectors is
 
    No_Index : constant Extended_Index := Extended_Index'First;
 
-   subtype Index_Subtype is Index_Type;
-
    type Vector is tagged private;
 
    type Cursor is private;
@@ -62,6 +59,8 @@ package Ada.Containers.Indefinite_Vectors is
 
    No_Element : constant Cursor;
 
+   function "=" (Left, Right : Vector) return Boolean;
+
    function To_Vector (Length : Count_Type) return Vector;
 
    function To_Vector
@@ -76,8 +75,6 @@ package Ada.Containers.Indefinite_Vectors is
 
    function "&" (Left, Right : Element_Type) return Vector;
 
-   function "=" (Left, Right : Vector) return Boolean;
-
    function Capacity (Container : Vector) return Count_Type;
 
    procedure Reserve_Capacity
@@ -86,6 +83,10 @@ package Ada.Containers.Indefinite_Vectors is
 
    function Length (Container : Vector) return Count_Type;
 
+   procedure Set_Length
+     (Container : in out Vector;
+      Length    : Count_Type);
+
    function Is_Empty (Container : Vector) return Boolean;
 
    procedure Clear (Container : in out Vector);
@@ -102,6 +103,16 @@ package Ada.Containers.Indefinite_Vectors is
 
    function Element (Position : Cursor) return Element_Type;
 
+   procedure Replace_Element
+     (Container : in out Vector;
+      Index     : Index_Type;
+      New_Item  : Element_Type);
+
+   procedure Replace_Element
+     (Container : in out Vector;
+      Position  : Cursor;
+      New_Item  : Element_Type);
+
    procedure Query_Element
      (Container : Vector;
       Index     : Index_Type;
@@ -112,24 +123,14 @@ package Ada.Containers.Indefinite_Vectors is
       Process  : not null access procedure (Element : Element_Type));
 
    procedure Update_Element
-     (Container : Vector;
+     (Container : in out Vector;
       Index     : Index_Type;
       Process   : not null access procedure (Element : in out Element_Type));
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access procedure (Element : in out Element_Type));
-
-   procedure Replace_Element
-     (Container : Vector;
-      Index     : Index_Type;
-      By        : Element_Type);
-
-   procedure Replace_Element
-     (Position : Cursor;
-      By       : Element_Type);
-
-   procedure Assign (Target : in out Vector; Source : Vector);
+     (Container : in out Vector;
+      Position  : Cursor;
+      Process   : not null access procedure (Element : in out Element_Type));
 
    procedure Move (Target : in out Vector; Source : in out Vector);
 
@@ -197,10 +198,6 @@ package Ada.Containers.Indefinite_Vectors is
       Position  : out Cursor;
       Count     : Count_Type := 1);
 
-   procedure Set_Length
-     (Container : in out Vector;
-      Length    : Count_Type);
-
    procedure Delete
      (Container : in out Vector;
       Index     : Extended_Index;
@@ -219,6 +216,12 @@ package Ada.Containers.Indefinite_Vectors is
      (Container : in out Vector;
       Count     : Count_Type := 1);
 
+   procedure Reverse_Elements (Container : in out Vector);
+
+   procedure Swap (Container : in out Vector; I, J : Index_Type);
+
+   procedure Swap (Container : in out Vector; I, J : Cursor);
+
    function First_Index (Container : Vector) return Index_Type;
 
    function First (Container : Vector) return Cursor;
@@ -231,21 +234,13 @@ package Ada.Containers.Indefinite_Vectors is
 
    function Last_Element (Container : Vector) return Element_Type;
 
-   procedure Swap (Container : Vector; I, J : Index_Type);
-
-   procedure Swap (I, J : Cursor);
-
-   generic
-      with function "<" (Left, Right : Element_Type) return Boolean is <>;
-   package Generic_Sorting is
-
-      function Is_Sorted (Container : Vector) return Boolean;
+   function Next (Position : Cursor) return Cursor;
 
-      procedure Sort (Container : in out Vector);
+   procedure Next (Position : in out Cursor);
 
-      procedure Merge (Target, Source : in out Vector);
+   function Previous (Position : Cursor) return Cursor;
 
-   end Generic_Sorting;
+   procedure Previous (Position : in out Cursor);
 
    function Find_Index
      (Container : Vector;
@@ -255,30 +250,22 @@ package Ada.Containers.Indefinite_Vectors is
    function Find
      (Container : Vector;
       Item      : Element_Type;
-       Position  : Cursor := No_Element) return Cursor;
+      Position  : Cursor := No_Element) return Cursor;
 
    function Reverse_Find_Index
      (Container : Vector;
       Item      : Element_Type;
       Index     : Index_Type := Index_Type'Last) return Extended_Index;
 
-   function Reverse_Find (Container : Vector;
-                          Item      : Element_Type;
-                          Position  : Cursor := No_Element)
-      return Cursor;
+   function Reverse_Find
+     (Container : Vector;
+      Item      : Element_Type;
+      Position  : Cursor := No_Element) return Cursor;
 
    function Contains
      (Container : Vector;
       Item      : Element_Type) return Boolean;
 
-   function Next (Position : Cursor) return Cursor;
-
-   function Previous (Position : Cursor) return Cursor;
-
-   procedure Next (Position : in out Cursor);
-
-   procedure Previous (Position : in out Cursor);
-
    function Has_Element (Position : Cursor) return Boolean;
 
    procedure Iterate
@@ -289,6 +276,18 @@ package Ada.Containers.Indefinite_Vectors is
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor));
 
+   generic
+      with function "<" (Left, Right : Element_Type) return Boolean is <>;
+   package Generic_Sorting is
+
+      function Is_Sorted (Container : Vector) return Boolean;
+
+      procedure Sort (Container : in out Vector);
+
+      procedure Merge (Target : in out Vector; Source : in out Vector);
+
+   end Generic_Sorting;
+
 private
 
    pragma Inline (First_Index);
@@ -346,6 +345,18 @@ private
       Index     : Index_Type := Index_Type'First;
    end record;
 
+   procedure Write
+     (Stream   : access Root_Stream_Type'Class;
+      Position : Cursor);
+
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream   : access Root_Stream_Type'Class;
+      Position : out Cursor);
+
+   for Cursor'Read use Read;
+
    No_Element : constant Cursor := Cursor'(null, Index_Type'First);
 
 end Ada.Containers.Indefinite_Vectors;

gcc/ada/a-convec.adb

@@ -303,37 +303,6 @@ package body Ada.Containers.Vectors is
          Count);
    end Append;
 
-   ------------
-   -- Assign --
-   ------------
-
-   procedure Assign
-     (Target : in out Vector;
-      Source : Vector)
-   is
-      N : constant Count_Type := Length (Source);
-
-   begin
-      if Target'Address = Source'Address then
-         return;
-      end if;
-
-      Clear (Target);
-
-      if N = 0 then
-         return;
-      end if;
-
-      if N > Capacity (Target) then
-         Reserve_Capacity (Target, Capacity => N);
-      end if;
-
-      Target.Elements (Index_Type'First .. Source.Last) :=
-        Source.Elements (Index_Type'First .. Source.Last);
-
-      Target.Last := Source.Last;
-   end Assign;
-
    --------------
    -- Capacity --
    --------------
@@ -443,8 +412,7 @@ package body Ada.Containers.Vectors is
          raise Constraint_Error;
       end if;
 
-      if Position.Container /=
-           Vector_Access'(Container'Unchecked_Access)
+      if Position.Container /= Container'Unrestricted_Access
         or else Position.Index > Container.Last
       then
          raise Program_Error;
@@ -452,11 +420,17 @@ package body Ada.Containers.Vectors is
 
       Delete (Container, Position.Index, Count);
 
-      if Position.Index <= Container.Last then
-         Position := (Container'Unchecked_Access, Position.Index);
-      else
-         Position := No_Element;
-      end if;
+      --  This is the old behavior, prior to the York API (2005/06):
+
+      --  if Position.Index <= Container.Last then
+      --    Position := (Container'Unchecked_Access, Position.Index);
+      --  else
+      --    Position := No_Element;
+      --  end if;
+
+      --  This is the behavior specified by the York API:
+
+      Position := No_Element;
    end Delete;
 
    ------------------
@@ -539,6 +513,7 @@ package body Ada.Containers.Vectors is
 
    procedure Finalize (Container : in out Vector) is
       X : Elements_Access := Container.Elements;
+
    begin
       if Container.Busy > 0 then
          raise Program_Error;
@@ -556,13 +531,12 @@ package body Ada.Containers.Vectors is
    function Find
      (Container : Vector;
       Item      : Element_Type;
-      Position  : Cursor := No_Element) return Cursor is
-
+      Position  : Cursor := No_Element) return Cursor
+   is
    begin
       if Position.Container /= null
-        and then (Position.Container /=
-                    Vector_Access'(Container'Unchecked_Access)
-                  or else Position.Index > Container.Last)
+        and then (Position.Container /= Container'Unrestricted_Access
+                    or else Position.Index > Container.Last)
       then
          raise Program_Error;
       end if;
@@ -583,7 +557,8 @@ package body Ada.Containers.Vectors is
    function Find_Index
      (Container : Vector;
       Item      : Element_Type;
-      Index     : Index_Type := Index_Type'First) return Extended_Index is
+      Index     : Index_Type := Index_Type'First) return Extended_Index
+   is
    begin
       for Indx in Index .. Container.Last loop
          if Container.Elements (Indx) = Item then
@@ -1152,6 +1127,31 @@ package body Ada.Containers.Vectors is
       Position := Cursor'(Container'Unchecked_Access, Index);
    end Insert;
 
+   procedure Insert
+     (Container : in out Vector;
+      Before    : Extended_Index;
+      Count     : Count_Type := 1)
+   is
+      New_Item : Element_Type;  -- Default-initialized value
+      pragma Warnings (Off, New_Item);
+
+   begin
+      Insert (Container, Before, New_Item, Count);
+   end Insert;
+
+   procedure Insert
+     (Container : in out Vector;
+      Before    : Cursor;
+      Position  : out Cursor;
+      Count     : Count_Type := 1)
+   is
+      New_Item : Element_Type;  -- Default-initialized value
+      pragma Warnings (Off, New_Item);
+
+   begin
+      Insert (Container, Before, New_Item, Position, Count);
+   end Insert;
+
    ------------------
    -- Insert_Space --
    ------------------
@@ -1339,7 +1339,7 @@ package body Ada.Containers.Vectors is
          Index := Before.Index;
       end if;
 
-      Insert_Space (Container, Index, Count);
+      Insert_Space (Container, Index, Count => Count);
 
       Position := Cursor'(Container'Unchecked_Access, Index);
    end Insert_Space;
@@ -1365,7 +1365,6 @@ package body Ada.Containers.Vectors is
       B : Natural renames V.Busy;
 
    begin
-
       B := B + 1;
 
       begin
@@ -1379,7 +1378,6 @@ package body Ada.Containers.Vectors is
       end;
 
       B := B - 1;
-
    end Iterate;
 
    ----------
@@ -1620,14 +1618,22 @@ package body Ada.Containers.Vectors is
       end loop;
    end Read;
 
+   procedure Read
+     (Stream   : access Root_Stream_Type'Class;
+      Position : out Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Read;
+
    ---------------------
    -- Replace_Element --
    ---------------------
 
    procedure Replace_Element
-     (Container : Vector;
+     (Container : in out Vector;
       Index     : Index_Type;
-      By        : Element_Type)
+      New_Item  : Element_Type)
    is
    begin
       if Index > Container.Last then
@@ -1638,16 +1644,24 @@ package body Ada.Containers.Vectors is
          raise Program_Error;
       end if;
 
-      Container.Elements (Index) := By;
+      Container.Elements (Index) := New_Item;
    end Replace_Element;
 
-   procedure Replace_Element (Position : Cursor; By : Element_Type) is
+   procedure Replace_Element
+     (Container : in out Vector;
+      Position  : Cursor;
+      New_Item  : Element_Type)
+   is
    begin
       if Position.Container = null then
          raise Constraint_Error;
       end if;
 
-      Replace_Element (Position.Container.all, Position.Index, By);
+      if Position.Container /= Container'Unrestricted_Access then
+         raise Program_Error;
+      end if;
+
+      Replace_Element (Container, Position.Index, New_Item);
    end Replace_Element;
 
    ----------------------
@@ -1799,6 +1813,41 @@ package body Ada.Containers.Vectors is
       end;
    end Reserve_Capacity;
 
+   ----------------------
+   -- Reverse_Elements --
+   ----------------------
+
+   procedure Reverse_Elements (Container : in out Vector) is
+   begin
+      if Container.Length <= 1 then
+         return;
+      end if;
+
+      if Container.Lock > 0 then
+         raise Program_Error;
+      end if;
+
+      declare
+         I : Index_Type := Index_Type'First;
+         J : Index_Type := Container.Last;
+         E : Elements_Type renames Container.Elements.all;
+
+      begin
+         while I < J loop
+            declare
+               EI : constant Element_Type := E (I);
+
+            begin
+               E (I) := E (J);
+               E (J) := EI;
+            end;
+
+            I := I + 1;
+            J := J - 1;
+         end loop;
+      end;
+   end Reverse_Elements;
+
    ------------------
    -- Reverse_Find --
    ------------------
@@ -1921,7 +1970,7 @@ package body Ada.Containers.Vectors is
    -- Swap --
    ----------
 
-   procedure Swap (Container : Vector; I, J : Index_Type) is
+   procedure Swap (Container : in out Vector; I, J : Index_Type) is
    begin
       if I > Container.Last
         or else J > Container.Last
@@ -1949,7 +1998,7 @@ package body Ada.Containers.Vectors is
       end;
    end Swap;
 
-   procedure Swap (I, J : Cursor) is
+   procedure Swap (Container : in out Vector; I, J : Cursor) is
    begin
       if I.Container = null
         or else J.Container = null
@@ -1957,11 +2006,13 @@ package body Ada.Containers.Vectors is
          raise Constraint_Error;
       end if;
 
-      if I.Container /= J.Container then
+      if I.Container /= Container'Unrestricted_Access
+        or else J.Container /= Container'Unrestricted_Access
+      then
          raise Program_Error;
       end if;
 
-      Swap (I.Container.all, I.Index, J.Index);
+      Swap (Container, I.Index, J.Index);
    end Swap;
 
    ---------------
@@ -2057,13 +2108,12 @@ package body Ada.Containers.Vectors is
    --------------------
 
    procedure Update_Element
-     (Container : Vector;
+     (Container : in out Vector;
       Index     : Index_Type;
       Process   : not null access procedure (Element : in out Element_Type))
    is
-      V : Vector renames Container'Unrestricted_Access.all;
-      B : Natural renames V.Busy;
-      L : Natural renames V.Lock;
+      B : Natural renames Container.Busy;
+      L : Natural renames Container.Lock;
 
    begin
       if Index > Container.Last then
@@ -2074,7 +2124,7 @@ package body Ada.Containers.Vectors is
       L := L + 1;
 
       begin
-         Process (V.Elements (Index));
+         Process (Container.Elements (Index));
       exception
          when others =>
             L := L - 1;
@@ -2087,15 +2137,20 @@ package body Ada.Containers.Vectors is
    end Update_Element;
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access procedure (Element : in out Element_Type))
+     (Container : in out Vector;
+      Position  : Cursor;
+      Process   : not null access procedure (Element : in out Element_Type))
    is
    begin
       if Position.Container = null then
          raise Constraint_Error;
       end if;
 
-      Update_Element (Position.Container.all, Position.Index, Process);
+      if Position.Container /= Container'Unrestricted_Access then
+         raise Program_Error;
+      end if;
+
+      Update_Element (Container, Position.Index, Process);
    end Update_Element;
 
    -----------
@@ -2114,4 +2169,12 @@ package body Ada.Containers.Vectors is
       end loop;
    end Write;
 
+   procedure Write
+     (Stream   : access Root_Stream_Type'Class;
+      Position : Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Write;
+
 end Ada.Containers.Vectors;

gcc/ada/a-convec.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -50,8 +50,6 @@ package Ada.Containers.Vectors is
 
    No_Index : constant Extended_Index := Extended_Index'First;
 
-   subtype Index_Subtype is Index_Type;
-
    type Vector is tagged private;
 
    type Cursor is private;
@@ -60,6 +58,8 @@ package Ada.Containers.Vectors is
 
    No_Element : constant Cursor;
 
+   function "=" (Left, Right : Vector) return Boolean;
+
    function To_Vector (Length : Count_Type) return Vector;
 
    function To_Vector
@@ -74,8 +74,6 @@ package Ada.Containers.Vectors is
 
    function "&" (Left, Right : Element_Type) return Vector;
 
-   function "=" (Left, Right : Vector) return Boolean;
-
    function Capacity (Container : Vector) return Count_Type;
 
    procedure Reserve_Capacity
@@ -84,6 +82,10 @@ package Ada.Containers.Vectors is
 
    function Length (Container : Vector) return Count_Type;
 
+   procedure Set_Length
+     (Container : in out Vector;
+      Length    : Count_Type);
+
    function Is_Empty (Container : Vector) return Boolean;
 
    procedure Clear (Container : in out Vector);
@@ -100,6 +102,16 @@ package Ada.Containers.Vectors is
 
    function Element (Position : Cursor) return Element_Type;
 
+   procedure Replace_Element
+     (Container : in out Vector;
+      Index     : Index_Type;
+      New_Item  : Element_Type);
+
+   procedure Replace_Element
+     (Container : in out Vector;
+      Position  : Cursor;
+      New_Item  : Element_Type);
+
    procedure Query_Element
      (Container : Vector;
       Index     : Index_Type;
@@ -110,22 +122,14 @@ package Ada.Containers.Vectors is
       Process  : not null access procedure (Element : Element_Type));
 
    procedure Update_Element
-     (Container : Vector;
+     (Container : in out Vector;
       Index     : Index_Type;
       Process   : not null access procedure (Element : in out Element_Type));
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access procedure (Element : in out Element_Type));
-
-   procedure Replace_Element
-     (Container : Vector;
-      Index     : Index_Type;
-      By        : Element_Type);
-
-   procedure Replace_Element (Position : Cursor; By : Element_Type);
-
-   procedure Assign (Target : in out Vector; Source : Vector);
+     (Container : in out Vector;
+      Position  : Cursor;
+      Process   : not null access procedure (Element : in out Element_Type));
 
    procedure Move (Target : in out Vector; Source : in out Vector);
 
@@ -164,6 +168,17 @@ package Ada.Containers.Vectors is
       Position  : out Cursor;
       Count     : Count_Type := 1);
 
+   procedure Insert
+     (Container : in out Vector;
+      Before    : Extended_Index;
+      Count     : Count_Type := 1);
+
+   procedure Insert
+     (Container : in out Vector;
+      Before    : Cursor;
+      Position  : out Cursor;
+      Count     : Count_Type := 1);
+
    procedure Prepend
      (Container : in out Vector;
       New_Item  : Vector);
@@ -193,10 +208,6 @@ package Ada.Containers.Vectors is
       Position  : out Cursor;
       Count     : Count_Type := 1);
 
-   procedure Set_Length
-     (Container : in out Vector;
-      Length    : Count_Type);
-
    procedure Delete
      (Container : in out Vector;
       Index     : Extended_Index;
@@ -215,6 +226,12 @@ package Ada.Containers.Vectors is
      (Container : in out Vector;
       Count     : Count_Type := 1);
 
+   procedure Reverse_Elements (Container : in out Vector);
+
+   procedure Swap (Container : in out Vector; I, J : Index_Type);
+
+   procedure Swap (Container : in out Vector; I, J : Cursor);
+
    function First_Index (Container : Vector) return Index_Type;
 
    function First (Container : Vector) return Cursor;
@@ -227,21 +244,13 @@ package Ada.Containers.Vectors is
 
    function Last_Element (Container : Vector) return Element_Type;
 
-   procedure Swap (Container : Vector; I, J : Index_Type);
-
-   procedure Swap (I, J : Cursor);
-
-   generic
-      with function "<" (Left, Right : Element_Type) return Boolean is <>;
-   package Generic_Sorting is
-
-      function Is_Sorted (Container : Vector) return Boolean;
+   function Next (Position : Cursor) return Cursor;
 
-      procedure Sort (Container : in out Vector);
+   procedure Next (Position : in out Cursor);
 
-      procedure Merge (Target, Source : in out Vector);
+   function Previous (Position : Cursor) return Cursor;
 
-   end Generic_Sorting;
+   procedure Previous (Position : in out Cursor);
 
    function Find_Index
      (Container : Vector;
@@ -267,14 +276,6 @@ package Ada.Containers.Vectors is
      (Container : Vector;
       Item      : Element_Type) return Boolean;
 
-   function Next (Position : Cursor) return Cursor;
-
-   function Previous (Position : Cursor) return Cursor;
-
-   procedure Next (Position : in out Cursor);
-
-   procedure Previous (Position : in out Cursor);
-
    function Has_Element (Position : Cursor) return Boolean;
 
    procedure Iterate
@@ -285,6 +286,18 @@ package Ada.Containers.Vectors is
      (Container : Vector;
       Process   : not null access procedure (Position : Cursor));
 
+   generic
+      with function "<" (Left, Right : Element_Type) return Boolean is <>;
+   package Generic_Sorting is
+
+      function Is_Sorted (Container : Vector) return Boolean;
+
+      procedure Sort (Container : in out Vector);
+
+      procedure Merge (Target : in out Vector; Source : in out Vector);
+
+   end Generic_Sorting;
+
 private
 
    pragma Inline (First_Index);
@@ -340,6 +353,18 @@ private
       Index     : Index_Type := Index_Type'First;
    end record;
 
+   procedure Write
+     (Stream   : access Root_Stream_Type'Class;
+      Position : Cursor);
+
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream   : access Root_Stream_Type'Class;
+      Position : out Cursor);
+
+   for Cursor'Read use Read;
+
    No_Element : constant Cursor := Cursor'(null, Index_Type'First);
 
 end Ada.Containers.Vectors;

gcc/ada/a-coorma.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -81,6 +81,8 @@ package body Ada.Containers.Ordered_Maps is
    function Copy_Node (Source : Node_Access) return Node_Access;
    pragma Inline (Copy_Node);
 
+   procedure Free (X : in out Node_Access);
+
    function Is_Equal_Node_Node (L, R : Node_Access) return Boolean;
    pragma Inline (Is_Equal_Node_Node);
 
@@ -98,8 +100,6 @@ package body Ada.Containers.Ordered_Maps is
    -- Local Instantiations --
    --------------------------
 
-   procedure Free is new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
-
    package Tree_Operations is
       new Red_Black_Trees.Generic_Operations (Tree_Types);
 
@@ -127,16 +127,42 @@ package body Ada.Containers.Ordered_Maps is
 
    function "<" (Left, Right : Cursor) return Boolean is
    begin
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in ""<""");
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in ""<""");
+
       return Left.Node.Key < Right.Node.Key;
    end "<";
 
    function "<" (Left : Cursor; Right : Key_Type) return Boolean is
    begin
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in ""<""");
+
       return Left.Node.Key < Right;
    end "<";
 
    function "<" (Left : Key_Type; Right : Cursor) return Boolean is
    begin
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in ""<""");
+
       return Left < Right.Node.Key;
    end "<";
 
@@ -155,16 +181,42 @@ package body Ada.Containers.Ordered_Maps is
 
    function ">" (Left, Right : Cursor) return Boolean is
    begin
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in "">""");
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in "">""");
+
       return Right.Node.Key < Left.Node.Key;
    end ">";
 
    function ">" (Left : Cursor; Right : Key_Type) return Boolean is
    begin
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in "">""");
+
       return Right < Left.Node.Key;
    end ">";
 
    function ">" (Left : Key_Type; Right : Cursor) return Boolean is
    begin
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in "">""");
+
       return Right.Node.Key < Left;
    end ">";
 
@@ -231,12 +283,12 @@ package body Ada.Containers.Ordered_Maps is
 
    function Copy_Node (Source : Node_Access) return Node_Access is
       Target : constant Node_Access :=
-                 new Node_Type'(Parent  => null,
-                                Left    => null,
-                                Right   => null,
-                                Color   => Source.Color,
+                 new Node_Type'(Color   => Source.Color,
                                 Key     => Source.Key,
-                                Element => Source.Element);
+                                Element => Source.Element,
+                                Parent  => null,
+                                Left    => null,
+                                Right   => null);
    begin
       return Target;
    end Copy_Node;
@@ -246,16 +298,20 @@ package body Ada.Containers.Ordered_Maps is
    ------------
 
    procedure Delete (Container : in out Map; Position : in out Cursor) is
+      Tree : Tree_Type renames Container.Tree;
+
    begin
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
-      if Position.Container /= Map_Access'(Container'Unrestricted_Access) then
+      if Position.Container /= Container'Unrestricted_Access then
          raise Program_Error;
       end if;
 
-      Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
+      pragma Assert (Vet (Tree, Position.Node), "bad cursor in Delete");
+
+      Tree_Operations.Delete_Node_Sans_Free (Tree, Position.Node);
       Free (Position.Node);
 
       Position.Container := null;
@@ -269,7 +325,7 @@ package body Ada.Containers.Ordered_Maps is
          raise Constraint_Error;
       end if;
 
-      Delete_Node_Sans_Free (Container.Tree, X);
+      Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
       Free (X);
    end Delete;
 
@@ -279,6 +335,7 @@ package body Ada.Containers.Ordered_Maps is
 
    procedure Delete_First (Container : in out Map) is
       X : Node_Access := Container.Tree.First;
+
    begin
       if X /= null then
          Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
@@ -292,6 +349,7 @@ package body Ada.Containers.Ordered_Maps is
 
    procedure Delete_Last (Container : in out Map) is
       X : Node_Access := Container.Tree.Last;
+
    begin
       if X /= null then
          Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
@@ -305,15 +363,42 @@ package body Ada.Containers.Ordered_Maps is
 
    function Element (Position : Cursor) return Element_Type is
    begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Element");
+
       return Position.Node.Element;
    end Element;
 
    function Element (Container : Map; Key : Key_Type) return Element_Type is
       Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
+
    begin
+      if Node = null then
+         raise Constraint_Error;
+      end if;
+
       return Node.Element;
    end Element;
 
+   ---------------------
+   -- Equivalent_Keys --
+   ---------------------
+
+   function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
+   begin
+      if Left < Right
+        or else Right < Left
+      then
+         return False;
+      else
+         return True;
+      end if;
+   end Equivalent_Keys;
+
    -------------
    -- Exclude --
    -------------
@@ -323,7 +408,7 @@ package body Ada.Containers.Ordered_Maps is
 
    begin
       if X /= null then
-         Delete_Node_Sans_Free (Container.Tree, X);
+         Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
          Free (X);
       end if;
    end Exclude;
@@ -348,12 +433,14 @@ package body Ada.Containers.Ordered_Maps is
    -----------
 
    function First (Container : Map) return Cursor is
+      T : Tree_Type renames Container.Tree;
+
    begin
-      if Container.Tree.First = null then
+      if T.First = null then
          return No_Element;
       end if;
 
-      return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
+      return Cursor'(Container'Unrestricted_Access, T.First);
    end First;
 
    -------------------
@@ -361,8 +448,14 @@ package body Ada.Containers.Ordered_Maps is
    -------------------
 
    function First_Element (Container : Map) return Element_Type is
+      T : Tree_Type renames Container.Tree;
+
    begin
-      return Container.Tree.First.Element;
+      if T.First = null then
+         raise Constraint_Error;
+      end if;
+
+      return T.First.Element;
    end First_Element;
 
    ---------------
@@ -370,8 +463,14 @@ package body Ada.Containers.Ordered_Maps is
    ---------------
 
    function First_Key (Container : Map) return Key_Type is
+      T : Tree_Type renames Container.Tree;
+
    begin
-      return Container.Tree.First.Key;
+      if T.First = null then
+         raise Constraint_Error;
+      end if;
+
+      return T.First.Key;
    end First_Key;
 
    -----------
@@ -389,6 +488,26 @@ package body Ada.Containers.Ordered_Maps is
       return Cursor'(Container'Unrestricted_Access, Node);
    end Floor;
 
+   ----------
+   -- Free --
+   ----------
+
+   procedure Free (X : in out Node_Access) is
+      procedure Deallocate is
+         new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+
+   begin
+      if X = null then
+         return;
+      end if;
+
+      X.Parent := X;
+      X.Left := X;
+      X.Right := X;
+
+      Deallocate (X);
+   end Free;
+
    -----------------
    -- Has_Element --
    -----------------
@@ -444,15 +563,13 @@ package body Ada.Containers.Ordered_Maps is
       --------------
 
       function New_Node return Node_Access is
-         Node : constant Node_Access :=
-                  new Node_Type'(Parent  => null,
-                                 Left    => null,
-                                 Right   => null,
-                                 Color   => Red,
-                                 Key     => Key,
-                                 Element => New_Item);
       begin
-         return Node;
+         return new Node_Type'(Key     => Key,
+                               Element => New_Item,
+                               Color   => Red_Black_Trees.Red,
+                               Parent  => null,
+                               Left    => null,
+                               Right   => null);
       end New_Node;
 
    --  Start of processing for Insert
@@ -507,18 +624,13 @@ package body Ada.Containers.Ordered_Maps is
       --------------
 
       function New_Node return Node_Access is
-         Node : Node_Access := new Node_Type;
-
       begin
-         begin
-            Node.Key := Key;
-         exception
-            when others =>
-               Free (Node);
-               raise;
-         end;
-
-         return Node;
+         return new Node_Type'(Key     => Key,
+                               Element => <>,
+                               Color   => Red_Black_Trees.Red,
+                               Parent  => null,
+                               Left    => null,
+                               Right   => null);
       end New_Node;
 
    --  Start of processing for Insert
@@ -633,6 +745,13 @@ package body Ada.Containers.Ordered_Maps is
 
    function Key (Position : Cursor) return Key_Type is
    begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Key");
+
       return Position.Node.Key;
    end Key;
 
@@ -641,12 +760,14 @@ package body Ada.Containers.Ordered_Maps is
    ----------
 
    function Last (Container : Map) return Cursor is
+      T : Tree_Type renames Container.Tree;
+
    begin
-      if Container.Tree.Last = null then
+      if T.Last = null then
          return No_Element;
       end if;
 
-      return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
+      return Cursor'(Container'Unrestricted_Access, T.Last);
    end Last;
 
    ------------------
@@ -654,8 +775,14 @@ package body Ada.Containers.Ordered_Maps is
    ------------------
 
    function Last_Element (Container : Map) return Element_Type is
+      T : Tree_Type renames Container.Tree;
+
    begin
-      return Container.Tree.Last.Element;
+      if T.Last = null then
+         raise Constraint_Error;
+      end if;
+
+      return T.Last.Element;
    end Last_Element;
 
    --------------
@@ -663,8 +790,14 @@ package body Ada.Containers.Ordered_Maps is
    --------------
 
    function Last_Key (Container : Map) return Key_Type is
+      T : Tree_Type renames Container.Tree;
+
    begin
-      return Container.Tree.Last.Key;
+      if T.Last = null then
+         raise Constraint_Error;
+      end if;
+
+      return T.Last.Key;
    end Last_Key;
 
    ----------
@@ -712,6 +845,9 @@ package body Ada.Containers.Ordered_Maps is
          return No_Element;
       end if;
 
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Next");
+
       declare
          Node : constant Node_Access :=
                   Tree_Operations.Next (Position.Node);
@@ -749,6 +885,9 @@ package body Ada.Containers.Ordered_Maps is
          return No_Element;
       end if;
 
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Previous");
+
       declare
          Node : constant Node_Access :=
                   Tree_Operations.Previous (Position.Node);
@@ -771,29 +910,40 @@ package body Ada.Containers.Ordered_Maps is
       Process  : not null access procedure (Key     : Key_Type;
                                             Element : Element_Type))
    is
-      K : Key_Type renames Position.Node.Key;
-      E : Element_Type renames Position.Node.Element;
+   begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
-      T : Tree_Type renames Position.Container.Tree;
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Query_Element");
 
-      B : Natural renames T.Busy;
-      L : Natural renames T.Lock;
+      declare
+         T : Tree_Type renames Position.Container.Tree;
 
-   begin
-      B := B + 1;
-      L := L + 1;
+         B : Natural renames T.Busy;
+         L : Natural renames T.Lock;
 
       begin
-         Process (K, E);
-      exception
-         when others =>
-            L := L - 1;
-            B := B - 1;
-            raise;
-      end;
+         B := B + 1;
+         L := L + 1;
 
-      L := L - 1;
-      B := B - 1;
+         declare
+            K : Key_Type renames Position.Node.Key;
+            E : Element_Type renames Position.Node.Element;
+
+         begin
+            Process (K, E);
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
+
+         L := L - 1;
+         B := B - 1;
+      end;
    end Query_Element;
 
    ----------
@@ -835,6 +985,14 @@ package body Ada.Containers.Ordered_Maps is
       Read (Stream, Container.Tree);
    end Read;
 
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Read;
+
    -------------
    -- Replace --
    -------------
@@ -863,15 +1021,28 @@ package body Ada.Containers.Ordered_Maps is
    -- Replace_Element --
    ---------------------
 
-   procedure Replace_Element (Position : Cursor; By : Element_Type) is
-      E : Element_Type renames Position.Node.Element;
-
+   procedure Replace_Element
+     (Container : in out Map;
+      Position  : Cursor;
+      New_Item  : Element_Type)
+   is
    begin
-      if Position.Container.Tree.Lock > 0 then
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Position.Container /= Container'Unrestricted_Access then
          raise Program_Error;
       end if;
 
-      E := By;
+      if Container.Tree.Lock > 0 then
+         raise Program_Error;
+      end if;
+
+      pragma Assert (Vet (Container.Tree, Position.Node),
+                     "bad cursor in Replace_Element");
+
+      Position.Node.Element := New_Item;
    end Replace_Element;
 
    ---------------------
@@ -968,33 +1139,49 @@ package body Ada.Containers.Ordered_Maps is
    --------------------
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access procedure (Key     : Key_Type;
-                                            Element : in out Element_Type))
+     (Container : in out Map;
+      Position  : Cursor;
+      Process   : not null access procedure (Key     : Key_Type;
+                                             Element : in out Element_Type))
    is
-      K : Key_Type renames Position.Node.Key;
-      E : Element_Type renames Position.Node.Element;
+   begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
-      T : Tree_Type renames Position.Container.Tree;
+      if Position.Container /= Container'Unrestricted_Access then
+         raise Program_Error;
+      end if;
 
-      B : Natural renames T.Busy;
-      L : Natural renames T.Lock;
+      pragma Assert (Vet (Container.Tree, Position.Node),
+                     "bad cursor in Update_Element");
 
-   begin
-      B := B + 1;
-      L := L + 1;
+      declare
+         T : Tree_Type renames Container.Tree;
+
+         B : Natural renames T.Busy;
+         L : Natural renames T.Lock;
 
       begin
-         Process (K, E);
-      exception
-         when others =>
-            L := L - 1;
-            B := B - 1;
-            raise;
-      end;
+         B := B + 1;
+         L := L + 1;
 
-      L := L - 1;
-      B := B - 1;
+         declare
+            K : Key_Type renames Position.Node.Key;
+            E : Element_Type renames Position.Node.Element;
+
+         begin
+            Process (K, E);
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
+
+         L := L - 1;
+         B := B - 1;
+      end;
    end Update_Element;
 
    -----------
@@ -1032,4 +1219,12 @@ package body Ada.Containers.Ordered_Maps is
       Write (Stream, Container.Tree);
    end Write;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Write;
+
 end Ada.Containers.Ordered_Maps;

gcc/ada/a-coorma.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -38,9 +38,7 @@ with Ada.Finalization;
 with Ada.Streams;
 
 generic
-
    type Key_Type is private;
-
    type Element_Type is private;
 
    with function "<" (Left, Right : Key_Type) return Boolean is <>;
@@ -49,6 +47,8 @@ generic
 package Ada.Containers.Ordered_Maps is
    pragma Preelaborate;
 
+   function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
+
    type Map is tagged private;
 
    type Cursor is private;
@@ -69,18 +69,22 @@ package Ada.Containers.Ordered_Maps is
 
    function Element (Position : Cursor) return Element_Type;
 
+   procedure Replace_Element
+     (Container : in out Map;
+      Position  : Cursor;
+      New_Item  : Element_Type);
+
    procedure Query_Element
      (Position : Cursor;
       Process  : not null access
                    procedure (Key : Key_Type; Element : Element_Type));
 
    procedure Update_Element
-     (Position : Cursor;
-      Process  : not null access
+     (Container : in out Map;
+      Position  : Cursor;
+      Process   : not null access
                    procedure (Key : Key_Type; Element : in out Element_Type));
 
-   procedure Replace_Element (Position : Cursor; By : in Element_Type);
-
    procedure Move (Target : in out Map; Source : in out Map);
 
    procedure Insert
@@ -111,6 +115,8 @@ package Ada.Containers.Ordered_Maps is
       Key       : Key_Type;
       New_Item  : Element_Type);
 
+   procedure Exclude (Container : in out Map; Key : Key_Type);
+
    procedure Delete (Container : in out Map; Key : Key_Type);
 
    procedure Delete (Container : in out Map; Position : in out Cursor);
@@ -119,30 +125,18 @@ package Ada.Containers.Ordered_Maps is
 
    procedure Delete_Last (Container : in out Map);
 
-   procedure Exclude (Container : in out Map; Key : Key_Type);
-
-   function Contains (Container : Map; Key : Key_Type) return Boolean;
-
-   function Find (Container : Map; Key : Key_Type) return Cursor;
-
-   function Element (Container : Map; Key : Key_Type) return Element_Type;
-
-   function Floor (Container : Map; Key : Key_Type) return Cursor;
-
-   function Ceiling (Container : Map; Key : Key_Type) return Cursor;
-
    function First (Container : Map) return Cursor;
 
-   function First_Key (Container : Map) return Key_Type;
-
    function First_Element (Container : Map) return Element_Type;
 
-   function Last (Container : Map) return Cursor;
+   function First_Key (Container : Map) return Key_Type;
 
-   function Last_Key (Container : Map) return Key_Type;
+   function Last (Container : Map) return Cursor;
 
    function Last_Element (Container : Map) return Element_Type;
 
+   function Last_Key (Container : Map) return Key_Type;
+
    function Next (Position : Cursor) return Cursor;
 
    procedure Next (Position : in out Cursor);
@@ -151,6 +145,16 @@ package Ada.Containers.Ordered_Maps is
 
    procedure Previous (Position : in out Cursor);
 
+   function Find (Container : Map; Key : Key_Type) return Cursor;
+
+   function Element (Container : Map; Key : Key_Type) return Element_Type;
+
+   function Floor (Container : Map; Key : Key_Type) return Cursor;
+
+   function Ceiling (Container : Map; Key : Key_Type) return Cursor;
+
+   function Contains (Container : Map; Key : Key_Type) return Boolean;
+
    function Has_Element (Position : Cursor) return Boolean;
 
    function "<" (Left, Right : Cursor) return Boolean;
@@ -202,8 +206,9 @@ private
    use Red_Black_Trees;
    use Tree_Types;
    use Ada.Finalization;
+   use Ada.Streams;
 
-   type Map_Access is access Map;
+   type Map_Access is access all Map;
    for Map_Access'Storage_Size use 0;
 
    type Cursor is record
@@ -211,9 +216,19 @@ private
       Node      : Node_Access;
    end record;
 
-   No_Element : constant Cursor := Cursor'(null, null);
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor);
 
-   use Ada.Streams;
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
+   No_Element : constant Cursor := Cursor'(null, null);
 
    procedure Write
      (Stream    : access Root_Stream_Type'Class;

gcc/ada/a-coormu.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -84,6 +84,13 @@ package body Ada.Containers.Ordered_Multisets is
    function Copy_Node (Source : Node_Access) return Node_Access;
    pragma Inline (Copy_Node);
 
+   procedure Free (X : in out Node_Access);
+
+   procedure Insert_Sans_Hint
+     (Tree     : in out Tree_Type;
+      New_Item : Element_Type;
+      Node     : out Node_Access);
+
    procedure Insert_With_Hint
      (Dst_Tree : in out Tree_Type;
       Dst_Hint : Node_Access;
@@ -115,9 +122,6 @@ package body Ada.Containers.Ordered_Multisets is
    -- Local Instantiations --
    --------------------------
 
-   procedure Free is
-     new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
-
    package Tree_Operations is
      new Red_Black_Trees.Generic_Operations (Tree_Types);
 
@@ -154,18 +158,44 @@ package body Ada.Containers.Ordered_Multisets is
 
    function "<" (Left, Right : Cursor) return Boolean is
    begin
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in ""<""");
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in ""<""");
+
       return Left.Node.Element < Right.Node.Element;
    end "<";
 
    function "<" (Left : Cursor; Right : Element_Type)
       return Boolean is
    begin
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in ""<""");
+
       return Left.Node.Element < Right;
    end "<";
 
    function "<" (Left : Element_Type; Right : Cursor)
       return Boolean is
    begin
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in ""<""");
+
       return Left < Right.Node.Element;
    end "<";
 
@@ -184,6 +214,18 @@ package body Ada.Containers.Ordered_Multisets is
 
    function ">" (Left, Right : Cursor) return Boolean is
    begin
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in "">""");
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in "">""");
+
       --  L > R same as R < L
 
       return Right.Node.Element < Left.Node.Element;
@@ -192,12 +234,26 @@ package body Ada.Containers.Ordered_Multisets is
    function ">" (Left : Cursor; Right : Element_Type)
       return Boolean is
    begin
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in "">""");
+
       return Right < Left.Node.Element;
    end ">";
 
    function ">" (Left : Element_Type; Right : Cursor)
       return Boolean is
    begin
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in "">""");
+
       return Right.Node.Element < Left;
    end ">";
 
@@ -299,7 +355,7 @@ package body Ada.Containers.Ordered_Multisets is
       end loop;
    end Delete;
 
-   procedure Delete (Container : in out Set; Position  : in out Cursor) is
+   procedure Delete (Container : in out Set; Position : in out Cursor) is
    begin
       if Position.Node = null then
          raise Constraint_Error;
@@ -309,6 +365,9 @@ package body Ada.Containers.Ordered_Multisets is
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (Container.Tree, Position.Node),
+                     "bad cursor in Delete");
+
       Delete_Node_Sans_Free (Container.Tree, Position.Node);
       Free (Position.Node);
 
@@ -371,9 +430,31 @@ package body Ada.Containers.Ordered_Multisets is
 
    function Element (Position : Cursor) return Element_Type is
    begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Element");
+
       return Position.Node.Element;
    end Element;
 
+   -------------------------
+   -- Equivalent_Elements --
+   -------------------------
+
+   function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
+   begin
+      if Left < Right
+        or else Right < Left
+      then
+         return False;
+      else
+         return True;
+      end if;
+   end Equivalent_Elements;
+
    ---------------------
    -- Equivalent_Sets --
    ---------------------
@@ -460,6 +541,10 @@ package body Ada.Containers.Ordered_Multisets is
 
    function First_Element (Container : Set) return Element_Type is
    begin
+      if Container.Tree.First = null then
+         raise Constraint_Error;
+      end if;
+
       return Container.Tree.First.Element;
    end First_Element;
 
@@ -479,6 +564,24 @@ package body Ada.Containers.Ordered_Multisets is
       return Cursor'(Container'Unrestricted_Access, Node);
    end Floor;
 
+   ----------
+   -- Free --
+   ----------
+
+   procedure Free (X : in out Node_Access) is
+      procedure Deallocate is
+         new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+
+   begin
+      if X /= null then
+         X.Parent := X;
+         X.Left := X;
+         X.Right := X;
+
+         Deallocate (X);
+      end if;
+   end Free;
+
    ------------------
    -- Generic_Keys --
    ------------------
@@ -510,34 +613,6 @@ package body Ada.Containers.Ordered_Multisets is
            Is_Less_Key_Node    => Is_Less_Key_Node,
            Is_Greater_Key_Node => Is_Greater_Key_Node);
 
-      ---------
-      -- "<" --
-      ---------
-
-      function "<" (Left : Key_Type; Right : Cursor) return Boolean is
-      begin
-         return Left < Right.Node.Element;
-      end "<";
-
-      function "<" (Left : Cursor; Right : Key_Type) return Boolean is
-      begin
-         return Right > Left.Node.Element;
-      end "<";
-
-      ---------
-      -- ">" --
-      ---------
-
-      function ">" (Left : Cursor; Right : Key_Type) return Boolean is
-      begin
-         return Right < Left.Node.Element;
-      end ">";
-
-      function ">" (Left : Key_Type; Right : Cursor) return Boolean is
-      begin
-         return Left > Right.Node.Element;
-      end ">";
-
       -------------
       -- Ceiling --
       -------------
@@ -596,9 +671,28 @@ package body Ada.Containers.Ordered_Multisets is
          Node : constant Node_Access :=
                   Key_Keys.Find (Container.Tree, Key);
       begin
+         if Node = null then
+            raise Constraint_Error;
+         end if;
+
          return Node.Element;
       end Element;
 
+      ---------------------
+      -- Equivalent_Keys --
+      ---------------------
+
+      function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
+      begin
+         if Left < Right
+           or else Right < Left
+         then
+            return False;
+         else
+            return True;
+         end if;
+      end Equivalent_Keys;
+
       -------------
       -- Exclude --
       -------------
@@ -608,6 +702,7 @@ package body Ada.Containers.Ordered_Multisets is
          Node : Node_Access := Key_Keys.Ceiling (Tree, Key);
          Done : constant Node_Access := Key_Keys.Upper_Bound (Tree, Key);
          X    : Node_Access;
+
       begin
          while Node /= Done loop
             X := Node;
@@ -657,7 +752,7 @@ package body Ada.Containers.Ordered_Multisets is
         (Left  : Key_Type;
          Right : Node_Access) return Boolean is
       begin
-         return Left > Right.Element;
+         return Key (Right.Element) < Left;
       end Is_Greater_Key_Node;
 
       ----------------------
@@ -668,7 +763,7 @@ package body Ada.Containers.Ordered_Multisets is
         (Left  : Key_Type;
          Right : Node_Access) return Boolean is
       begin
-         return Left < Right.Element;
+         return Left < Key (Right.Element);
       end Is_Less_Key_Node;
 
       -------------
@@ -720,6 +815,13 @@ package body Ada.Containers.Ordered_Multisets is
 
       function Key (Position : Cursor) return Key_Type is
       begin
+         if Position.Node = null then
+            raise Constraint_Error;
+         end if;
+
+         pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                        "bad cursor in Key");
+
          return Key (Position.Node.Element);
       end Key;
 
@@ -786,9 +888,12 @@ package body Ada.Containers.Ordered_Multisets is
             raise Program_Error;
          end if;
 
+         pragma Assert (Vet (Container.Tree, Position.Node),
+                        "bad cursor in Update_Element_Preserving_Key");
+
          declare
             E : Element_Type renames Position.Node.Element;
-            K : Key_Type renames Key (E);
+            K : constant Key_Type := Key (E);
 
             B : Natural renames Tree.Busy;
             L : Natural renames Tree.Lock;
@@ -809,11 +914,7 @@ package body Ada.Containers.Ordered_Multisets is
             L := L - 1;
             B := B - 1;
 
-            if K < E
-              or else K > E
-            then
-               null;
-            else
+            if Equivalent_Keys (Left => K, Right => Key (E)) then
                return;
             end if;
          end;
@@ -854,6 +955,24 @@ package body Ada.Containers.Ordered_Multisets is
       New_Item  : Element_Type;
       Position  : out Cursor)
    is
+   begin
+      Insert_Sans_Hint
+        (Container.Tree,
+         New_Item,
+         Position.Node);
+
+      Position.Container := Container'Unrestricted_Access;
+   end Insert;
+
+   ----------------------
+   -- Insert_Sans_Hint --
+   ----------------------
+
+   procedure Insert_Sans_Hint
+     (Tree     : in out Tree_Type;
+      New_Item : Element_Type;
+      Node     : out Node_Access)
+   is
       function New_Node return Node_Access;
       pragma Inline (New_Node);
 
@@ -869,25 +988,23 @@ package body Ada.Containers.Ordered_Multisets is
 
       function New_Node return Node_Access is
          Node : constant Node_Access :=
-                  new Node_Type'(Parent => null,
-                                 Left   => null,
-                                 Right  => null,
-                                 Color  => Red,
+                  new Node_Type'(Parent  => null,
+                                 Left    => null,
+                                 Right   => null,
+                                 Color   => Red_Black_Trees.Red,
                                  Element => New_Item);
       begin
          return Node;
       end New_Node;
 
-   --  Start of processing for Insert
+   --  Start of processing for Insert_Sans_Hint
 
    begin
       Unconditional_Insert_Sans_Hint
-        (Container.Tree,
+        (Tree,
          New_Item,
-         Position.Node);
-
-      Position.Container := Container'Unrestricted_Access;
-   end Insert;
+         Node);
+   end Insert_Sans_Hint;
 
    ----------------------
    -- Insert_With_Hint --
@@ -1116,6 +1233,10 @@ package body Ada.Containers.Ordered_Multisets is
 
    function Last_Element (Container : Set) return Element_Type is
    begin
+      if Container.Tree.Last = null then
+         raise Constraint_Error;
+      end if;
+
       return Container.Tree.Last.Element;
    end Last_Element;
 
@@ -1165,6 +1286,9 @@ package body Ada.Containers.Ordered_Multisets is
          return No_Element;
       end if;
 
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Next");
+
       declare
          Node : constant Node_Access :=
                   Tree_Operations.Next (Position.Node);
@@ -1211,6 +1335,9 @@ package body Ada.Containers.Ordered_Multisets is
          return No_Element;
       end if;
 
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Previous");
+
       declare
          Node : constant Node_Access :=
                   Tree_Operations.Previous (Position.Node);
@@ -1231,29 +1358,36 @@ package body Ada.Containers.Ordered_Multisets is
      (Position : Cursor;
       Process  : not null access procedure (Element : Element_Type))
    is
-      E : Element_Type renames Position.Node.Element;
+   begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
-      S : Set renames Position.Container.all;
-      T : Tree_Type renames S.Tree'Unrestricted_Access.all;
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Query_Element");
 
-      B : Natural renames T.Busy;
-      L : Natural renames T.Lock;
+      declare
+         T : Tree_Type renames Position.Container.Tree;
 
-   begin
-      B := B + 1;
-      L := L + 1;
+         B : Natural renames T.Busy;
+         L : Natural renames T.Lock;
 
       begin
-         Process (E);
-      exception
-         when others =>
-            L := L - 1;
-            B := B - 1;
-            raise;
-      end;
+         B := B + 1;
+         L := L + 1;
 
-      L := L - 1;
-      B := B - 1;
+         begin
+            Process (Position.Node.Element);
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
+
+         L := L - 1;
+         B := B - 1;
+      end;
    end Query_Element;
 
    ----------
@@ -1294,6 +1428,14 @@ package body Ada.Containers.Ordered_Multisets is
       Read (Stream, Container.Tree);
    end Read;
 
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Read;
+
    ---------------------
    -- Replace_Element --
    ---------------------
@@ -1336,6 +1478,11 @@ package body Ada.Containers.Ordered_Multisets is
          function New_Node return Node_Access is
          begin
             Node.Element := Item;
+            Node.Color := Red_Black_Trees.Red;
+            Node.Parent := null;
+            Node.Left := null;
+            Node.Right := null;
+
             return Node;
          end New_Node;
 
@@ -1354,12 +1501,10 @@ package body Ada.Containers.Ordered_Multisets is
    end Replace_Element;
 
    procedure Replace_Element
-     (Container : Set;
+     (Container : in out Set;
       Position  : Cursor;
-      By        : Element_Type)
+      New_Item  : Element_Type)
    is
-      Tree : Tree_Type renames Container.Tree'Unrestricted_Access.all;
-
    begin
       if Position.Node = null then
          raise Constraint_Error;
@@ -1369,7 +1514,10 @@ package body Ada.Containers.Ordered_Multisets is
          raise Program_Error;
       end if;
 
-      Replace_Element (Tree, Position.Node, By);
+      pragma Assert (Vet (Container.Tree, Position.Node),
+                     "bad cursor in Replace_Element");
+
+      Replace_Element (Container.Tree, Position.Node, New_Item);
    end Replace_Element;
 
    ---------------------
@@ -1514,6 +1662,19 @@ package body Ada.Containers.Ordered_Multisets is
       return Set'(Controlled with Tree);
    end Symmetric_Difference;
 
+   ------------
+   -- To_Set --
+   ------------
+
+   function To_Set (New_Item : Element_Type) return Set is
+      Tree     : Tree_Type;
+      Node     : Node_Access;
+
+   begin
+      Insert_Sans_Hint (Tree, New_Item, Node);
+      return Set'(Controlled with Tree);
+   end To_Set;
+
    -----------
    -- Union --
    -----------
@@ -1564,4 +1725,12 @@ package body Ada.Containers.Ordered_Multisets is
       Write (Stream, Container.Tree);
    end Write;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Write;
+
 end Ada.Containers.Ordered_Multisets;

gcc/ada/a-coormu.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -46,6 +46,8 @@ generic
 package Ada.Containers.Ordered_Multisets is
    pragma Preelaborate;
 
+   function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
+
    type Set is tagged private;
 
    type Cursor is private;
@@ -58,6 +60,8 @@ package Ada.Containers.Ordered_Multisets is
 
    function Equivalent_Sets (Left, Right : Set) return Boolean;
 
+   function To_Set (New_Item : Element_Type) return Set;
+
    function Length (Container : Set) return Count_Type;
 
    function Is_Empty (Container : Set) return Boolean;
@@ -66,18 +70,16 @@ package Ada.Containers.Ordered_Multisets is
 
    function Element (Position : Cursor) return Element_Type;
 
+   procedure Replace_Element
+     (Container : in out Set;
+      Position  : Cursor;
+      New_Item  : Element_Type);
+
    procedure Query_Element
      (Position : Cursor;
       Process  : not null access procedure (Element : Element_Type));
 
-   procedure Replace_Element
-     (Container : Set;
-      Position  : Cursor;
-      By        : Element_Type);
-
-   procedure Move
-     (Target : in out Set;
-      Source : in out Set);
+   procedure Move (Target : in out Set; Source : in out Set);
 
    procedure Insert
      (Container : in out Set;
@@ -88,6 +90,16 @@ package Ada.Containers.Ordered_Multisets is
      (Container : in out Set;
       New_Item  : Element_Type);
 
+--  TODO: include Replace too???
+--
+--     procedure Replace
+--       (Container : in out Set;
+--        New_Item  : Element_Type);
+
+   procedure Exclude
+     (Container : in out Set;
+      Item      : Element_Type);
+
    procedure Delete
      (Container : in out Set;
       Item      : Element_Type);
@@ -100,10 +112,6 @@ package Ada.Containers.Ordered_Multisets is
 
    procedure Delete_Last (Container : in out Set);
 
-   procedure Exclude
-     (Container : in out Set;
-      Item      : Element_Type);
-
    procedure Union (Target : in out Set; Source : Set);
 
    function Union (Left, Right : Set) return Set;
@@ -132,14 +140,6 @@ package Ada.Containers.Ordered_Multisets is
 
    function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
 
-   function Contains (Container : Set; Item : Element_Type) return Boolean;
-
-   function Find (Container : Set; Item : Element_Type) return Cursor;
-
-   function Floor (Container : Set; Item : Element_Type) return Cursor;
-
-   function Ceiling (Container : Set; Item : Element_Type) return Cursor;
-
    function First (Container : Set) return Cursor;
 
    function First_Element (Container : Set) return Element_Type;
@@ -156,6 +156,14 @@ package Ada.Containers.Ordered_Multisets is
 
    procedure Previous (Position : in out Cursor);
 
+   function Find (Container : Set; Item : Element_Type) return Cursor;
+
+   function Floor (Container : Set; Item : Element_Type) return Cursor;
+
+   function Ceiling (Container : Set; Item : Element_Type) return Cursor;
+
+   function Contains (Container : Set; Item : Element_Type) return Boolean;
+
    function Has_Element (Position : Cursor) return Boolean;
 
    function "<" (Left, Right : Cursor) return Boolean;
@@ -189,47 +197,37 @@ package Ada.Containers.Ordered_Multisets is
       Process   : not null access procedure (Position : Cursor));
 
    generic
-      type Key_Type (<>) is limited private;
+      type Key_Type (<>) is private;
 
       with function Key (Element : Element_Type) return Key_Type;
 
-      with function "<" (Left : Key_Type; Right : Element_Type)
-        return Boolean is <>;
-
-      with function ">" (Left : Key_Type; Right : Element_Type)
-        return Boolean is <>;
+      with function "<" (Left, Right : Key_Type) return Boolean is <>;
 
    package Generic_Keys is
 
-      function Contains (Container : Set; Key : Key_Type) return Boolean;
-
-      function Find (Container : Set; Key : Key_Type) return Cursor;
-
-      function Floor (Container : Set; Key : Key_Type) return Cursor;
-
-      function Ceiling (Container : Set; Key : Key_Type) return Cursor;
+      function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
 
       function Key (Position : Cursor) return Key_Type;
 
       function Element (Container : Set; Key : Key_Type) return Element_Type;
 
-      procedure Delete (Container : in out Set; Key : Key_Type);
-
       procedure Exclude (Container : in out Set; Key : Key_Type);
 
-      function "<" (Left : Cursor; Right : Key_Type) return Boolean;
+      procedure Delete (Container : in out Set; Key : Key_Type);
+
+      function Find (Container : Set; Key : Key_Type) return Cursor;
 
-      function ">" (Left : Cursor; Right : Key_Type) return Boolean;
+      function Floor (Container : Set; Key : Key_Type) return Cursor;
 
-      function "<" (Left : Key_Type; Right : Cursor) return Boolean;
+      function Ceiling (Container : Set; Key : Key_Type) return Cursor;
 
-      function ">" (Left : Key_Type; Right : Cursor) return Boolean;
+      function Contains (Container : Set; Key : Key_Type) return Boolean;
 
       procedure Update_Element_Preserving_Key
         (Container : in out Set;
          Position  : Cursor;
          Process   : not null access
-           procedure (Element : in out Element_Type));
+                       procedure (Element : in out Element_Type));
 
       procedure Iterate
         (Container : Set;
@@ -271,6 +269,7 @@ private
    use Red_Black_Trees;
    use Tree_Types;
    use Ada.Finalization;
+   use Ada.Streams;
 
    type Set_Access is access all Set;
    for Set_Access'Storage_Size use 0;
@@ -280,9 +279,19 @@ private
       Node      : Node_Access;
    end record;
 
-   No_Element : constant Cursor := Cursor'(null, null);
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor);
 
-   use Ada.Streams;
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
+   No_Element : constant Cursor := Cursor'(null, null);
 
    procedure Write
      (Stream    : access Root_Stream_Type'Class;

gcc/ada/a-coorse.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -84,6 +84,14 @@ package body Ada.Containers.Ordered_Sets is
    function Copy_Node (Source : Node_Access) return Node_Access;
    pragma Inline (Copy_Node);
 
+   procedure Free (X : in out Node_Access);
+
+   procedure Insert_Sans_Hint
+     (Tree     : in out Tree_Type;
+      New_Item : Element_Type;
+      Node     : out Node_Access;
+      Inserted : out Boolean);
+
    procedure Insert_With_Hint
      (Dst_Tree : in out Tree_Type;
       Dst_Hint : Node_Access;
@@ -115,9 +123,6 @@ package body Ada.Containers.Ordered_Sets is
    -- Local Instantiations --
    --------------------------
 
-   procedure Free is
-     new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
-
    package Tree_Operations is
      new Red_Black_Trees.Generic_Operations (Tree_Types);
 
@@ -154,16 +159,42 @@ package body Ada.Containers.Ordered_Sets is
 
    function "<" (Left, Right : Cursor) return Boolean is
    begin
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in ""<""");
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in ""<""");
+
       return Left.Node.Element < Right.Node.Element;
    end "<";
 
    function "<" (Left : Cursor; Right : Element_Type) return Boolean is
    begin
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in ""<""");
+
       return Left.Node.Element < Right;
    end "<";
 
    function "<" (Left : Element_Type; Right : Cursor) return Boolean is
    begin
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in ""<""");
+
       return Left < Right.Node.Element;
    end "<";
 
@@ -182,6 +213,18 @@ package body Ada.Containers.Ordered_Sets is
 
    function ">" (Left, Right : Cursor) return Boolean is
    begin
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in "">""");
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in "">""");
+
       --  L > R same as R < L
 
       return Right.Node.Element < Left.Node.Element;
@@ -189,11 +232,25 @@ package body Ada.Containers.Ordered_Sets is
 
    function ">" (Left : Element_Type; Right : Cursor) return Boolean is
    begin
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Right.Container.Tree, Right.Node),
+                     "bad Right cursor in "">""");
+
       return Right.Node.Element < Left;
    end ">";
 
    function ">" (Left : Cursor; Right : Element_Type) return Boolean is
    begin
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Left.Container.Tree, Left.Node),
+                     "bad Left cursor in "">""");
+
       return Right < Left.Node.Element;
    end ">";
 
@@ -287,6 +344,9 @@ package body Ada.Containers.Ordered_Sets is
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (Container.Tree, Position.Node),
+                     "bad cursor in Delete");
+
       Tree_Operations.Delete_Node_Sans_Free (Container.Tree, Position.Node);
       Free (Position.Node);
       Position.Container := null;
@@ -356,6 +416,13 @@ package body Ada.Containers.Ordered_Sets is
 
    function Element (Position : Cursor) return Element_Type is
    begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Element");
+
       return Position.Node.Element;
    end Element;
 
@@ -455,6 +522,10 @@ package body Ada.Containers.Ordered_Sets is
 
    function First_Element (Container : Set) return Element_Type is
    begin
+      if Container.Tree.First = null then
+         raise Constraint_Error;
+      end if;
+
       return Container.Tree.First.Element;
    end First_Element;
 
@@ -474,6 +545,24 @@ package body Ada.Containers.Ordered_Sets is
       return Cursor'(Container'Unrestricted_Access, Node);
    end Floor;
 
+   ----------
+   -- Free --
+   ----------
+
+   procedure Free (X : in out Node_Access) is
+      procedure Deallocate is
+         new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+
+   begin
+      if X /= null then
+         X.Parent := X;
+         X.Left := X;
+         X.Right := X;
+
+         Deallocate (X);
+      end if;
+   end Free;
+
    ------------------
    -- Generic_Keys --
    ------------------
@@ -550,13 +639,15 @@ package body Ada.Containers.Ordered_Sets is
       -- Element --
       -------------
 
-      function Element
-        (Container : Set;
-         Key       : Key_Type) return Element_Type
-      is
-         Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
+      function Element (Container : Set; Key : Key_Type) return Element_Type is
+         Node : constant Node_Access :=
+                  Key_Keys.Find (Container.Tree, Key);
 
       begin
+         if Node = null then
+            raise Constraint_Error;
+         end if;
+
          return Node.Element;
       end Element;
 
@@ -649,6 +740,13 @@ package body Ada.Containers.Ordered_Sets is
 
       function Key (Position : Cursor) return Key_Type is
       begin
+         if Position.Node = null then
+            raise Constraint_Error;
+         end if;
+
+         pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                        "bad cursor in Key");
+
          return Key (Position.Node.Element);
       end Key;
 
@@ -691,6 +789,9 @@ package body Ada.Containers.Ordered_Sets is
             raise Program_Error;
          end if;
 
+         pragma Assert (Vet (Container.Tree, Position.Node),
+                        "bad cursor in Update_Element_Preserving_Key");
+
          declare
             E : Element_Type renames Position.Node.Element;
             K : constant Key_Type := Key (E);
@@ -770,32 +871,6 @@ package body Ada.Containers.Ordered_Sets is
       Position  : out Cursor;
       Inserted  : out Boolean)
    is
-      function New_Node return Node_Access;
-      pragma Inline (New_Node);
-
-      procedure Insert_Post is
-        new Element_Keys.Generic_Insert_Post (New_Node);
-
-      procedure Insert_Sans_Hint is
-        new Element_Keys.Generic_Conditional_Insert (Insert_Post);
-
-      --------------
-      -- New_Node --
-      --------------
-
-      function New_Node return Node_Access is
-         Node : constant Node_Access :=
-                  new Node_Type'(Parent => null,
-                                 Left   => null,
-                                 Right  => null,
-                                 Color  => Red,
-                                 Element => New_Item);
-      begin
-         return Node;
-      end New_Node;
-
-   --  Start of processing for Insert
-
    begin
       Insert_Sans_Hint
         (Container.Tree,
@@ -822,6 +897,48 @@ package body Ada.Containers.Ordered_Sets is
    end Insert;
 
    ----------------------
+   -- Insert_Sans_Hint --
+   ----------------------
+
+   procedure Insert_Sans_Hint
+     (Tree     : in out Tree_Type;
+      New_Item : Element_Type;
+      Node     : out Node_Access;
+      Inserted : out Boolean)
+   is
+      function New_Node return Node_Access;
+      pragma Inline (New_Node);
+
+      procedure Insert_Post is
+        new Element_Keys.Generic_Insert_Post (New_Node);
+
+      procedure Conditional_Insert_Sans_Hint is
+        new Element_Keys.Generic_Conditional_Insert (Insert_Post);
+
+      --------------
+      -- New_Node --
+      --------------
+
+      function New_Node return Node_Access is
+      begin
+         return new Node_Type'(Parent  => null,
+                               Left    => null,
+                               Right   => null,
+                               Color   => Red_Black_Trees.Red,
+                               Element => New_Item);
+      end New_Node;
+
+   --  Start of processing for Insert_Sans_Hint
+
+   begin
+      Conditional_Insert_Sans_Hint
+        (Tree,
+         New_Item,
+         Node,
+         Inserted);
+   end Insert_Sans_Hint;
+
+   ----------------------
    -- Insert_With_Hint --
    ----------------------
 
@@ -1012,6 +1129,10 @@ package body Ada.Containers.Ordered_Sets is
 
    function Last_Element (Container : Set) return Element_Type is
    begin
+      if Container.Tree.Last = null then
+         raise Constraint_Error;
+      end if;
+
       return Container.Tree.Last.Element;
    end Last_Element;
 
@@ -1055,6 +1176,9 @@ package body Ada.Containers.Ordered_Sets is
          return No_Element;
       end if;
 
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Next");
+
       declare
          Node : constant Node_Access :=
                   Tree_Operations.Next (Position.Node);
@@ -1101,6 +1225,9 @@ package body Ada.Containers.Ordered_Sets is
          return No_Element;
       end if;
 
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Previous");
+
       declare
          Node : constant Node_Access :=
                   Tree_Operations.Previous (Position.Node);
@@ -1127,29 +1254,36 @@ package body Ada.Containers.Ordered_Sets is
      (Position : Cursor;
       Process  : not null access procedure (Element : Element_Type))
    is
-      E : Element_Type renames Position.Node.Element;
+   begin
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
-      S : Set renames Position.Container.all;
-      T : Tree_Type renames S.Tree'Unrestricted_Access.all;
+      pragma Assert (Vet (Position.Container.Tree, Position.Node),
+                     "bad cursor in Query_Element");
 
-      B : Natural renames T.Busy;
-      L : Natural renames T.Lock;
+      declare
+         T : Tree_Type renames Position.Container.Tree;
 
-   begin
-      B := B + 1;
-      L := L + 1;
+         B : Natural renames T.Busy;
+         L : Natural renames T.Lock;
 
       begin
-         Process (E);
-      exception
-         when others =>
-            L := L - 1;
-            B := B - 1;
-            raise;
-      end;
+         B := B + 1;
+         L := L + 1;
 
-      L := L - 1;
-      B := B - 1;
+         begin
+            Process (Position.Node.Element);
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
+
+         L := L - 1;
+         B := B - 1;
+      end;
    end Query_Element;
 
    ----------
@@ -1192,6 +1326,14 @@ package body Ada.Containers.Ordered_Sets is
       Read (Stream, Container.Tree);
    end Read;
 
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Read;
+
    -------------
    -- Replace --
    -------------
@@ -1254,6 +1396,11 @@ package body Ada.Containers.Ordered_Sets is
          function New_Node return Node_Access is
          begin
             Node.Element := Item;
+            Node.Color := Red;
+            Node.Parent := null;
+            Node.Right := null;
+            Node.Left := null;
+
             return Node;
          end New_Node;
 
@@ -1294,6 +1441,11 @@ package body Ada.Containers.Ordered_Sets is
 
          function New_Node return Node_Access is
          begin
+            Node.Color := Red;
+            Node.Parent := null;
+            Node.Right := null;
+            Node.Left := null;
+
             return Node;
          end New_Node;
 
@@ -1330,6 +1482,9 @@ package body Ada.Containers.Ordered_Sets is
          raise Program_Error;
       end if;
 
+      pragma Assert (Vet (Container.Tree, Position.Node),
+                     "bad cursor in Replace_Element");
+
       Replace_Element (Container.Tree, Position.Node, New_Item);
    end Replace_Element;
 
@@ -1436,6 +1591,20 @@ package body Ada.Containers.Ordered_Sets is
       return Set'(Controlled with Tree);
    end Symmetric_Difference;
 
+   ------------
+   -- To_Set --
+   ------------
+
+   function To_Set (New_Item : Element_Type) return Set is
+      Tree     : Tree_Type;
+      Node     : Node_Access;
+      Inserted : Boolean;
+
+   begin
+      Insert_Sans_Hint (Tree, New_Item, Node, Inserted);
+      return Set'(Controlled with Tree);
+   end To_Set;
+
    -----------
    -- Union --
    -----------
@@ -1486,4 +1655,12 @@ package body Ada.Containers.Ordered_Sets is
       Write (Stream, Container.Tree);
    end Write;
 
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor)
+   is
+   begin
+      raise Program_Error;
+   end Write;
+
 end Ada.Containers.Ordered_Sets;

gcc/ada/a-coorse.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -60,6 +60,8 @@ package Ada.Containers.Ordered_Sets is
 
    function Equivalent_Sets (Left, Right : Set) return Boolean;
 
+   function To_Set (New_Item : Element_Type) return Set;
+
    function Length (Container : Set) return Count_Type;
 
    function Is_Empty (Container : Set) return Boolean;
@@ -255,6 +257,7 @@ private
    use Red_Black_Trees;
    use Tree_Types;
    use Ada.Finalization;
+   use Ada.Streams;
 
    type Set_Access is access all Set;
    for Set_Access'Storage_Size use 0;
@@ -264,9 +267,19 @@ private
       Node      : Node_Access;
    end record;
 
-   No_Element : constant Cursor := Cursor'(null, null);
+   procedure Write
+     (Stream : access Root_Stream_Type'Class;
+      Item   : Cursor);
 
-   use Ada.Streams;
+   for Cursor'Write use Write;
+
+   procedure Read
+     (Stream : access Root_Stream_Type'Class;
+      Item   : out Cursor);
+
+   for Cursor'Read use Read;
+
+   No_Element : constant Cursor := Cursor'(null, null);
 
    procedure Write
      (Stream    : access Root_Stream_Type'Class;

gcc/ada/a-crbtgo.adb

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -49,91 +49,91 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
    procedure Left_Rotate  (Tree : in out Tree_Type; X : Node_Access);
    procedure Right_Rotate (Tree : in out Tree_Type; Y : Node_Access);
 
-   ---------------------
-   -- Check_Invariant --
-   ---------------------
-
-   procedure Check_Invariant (Tree : Tree_Type) is
-      Root : constant Node_Access := Tree.Root;
-
-      function Check (Node : Node_Access) return Natural;
-
-      -----------
-      -- Check --
-      -----------
-
-      function Check (Node : Node_Access) return Natural is
-      begin
-         if Node = null then
-            return 0;
-         end if;
-
-         if Color (Node) = Red then
-            declare
-               L : constant Node_Access := Left (Node);
-            begin
-               pragma Assert (L = null or else Color (L) = Black);
-               null;
-            end;
-
-            declare
-               R : constant Node_Access := Right (Node);
-            begin
-               pragma Assert (R = null or else Color (R) = Black);
-               null;
-            end;
-
-            declare
-               NL : constant Natural := Check (Left (Node));
-               NR : constant Natural := Check (Right (Node));
-            begin
-               pragma Assert (NL = NR);
-               return NL;
-            end;
-         end if;
-
-         declare
-            NL : constant Natural := Check (Left (Node));
-            NR : constant Natural := Check (Right (Node));
-         begin
-            pragma Assert (NL = NR);
-            return NL + 1;
-         end;
-      end Check;
-
-   --  Start of processing for Check_Invariant
-
-   begin
-      if Root = null then
-         pragma Assert (Tree.First = null);
-         pragma Assert (Tree.Last = null);
-         pragma Assert (Tree.Length = 0);
-         null;
-
-      else
-         pragma Assert (Color (Root) = Black);
-         pragma Assert (Tree.Length > 0);
-         pragma Assert (Tree.Root /= null);
-         pragma Assert (Tree.First /= null);
-         pragma Assert (Tree.Last /= null);
-         pragma Assert (Parent (Tree.Root) = null);
-         pragma Assert ((Tree.Length > 1)
-                           or else (Tree.First = Tree.Last
-                                      and Tree.First = Tree.Root));
-         pragma Assert (Left (Tree.First) = null);
-         pragma Assert (Right (Tree.Last) = null);
-
-         declare
-            L  : constant Node_Access := Left (Root);
-            R  : constant Node_Access := Right (Root);
-            NL : constant Natural := Check (L);
-            NR : constant Natural := Check (R);
-         begin
-            pragma Assert (NL = NR);
-            null;
-         end;
-      end if;
-   end Check_Invariant;
+--     ---------------------
+--     -- Check_Invariant --
+--     ---------------------
+
+--     procedure Check_Invariant (Tree : Tree_Type) is
+--        Root : constant Node_Access := Tree.Root;
+--
+--        function Check (Node : Node_Access) return Natural;
+--
+--        -----------
+--        -- Check --
+--        -----------
+--
+--        function Check (Node : Node_Access) return Natural is
+--        begin
+--           if Node = null then
+--              return 0;
+--           end if;
+--
+--           if Color (Node) = Red then
+--              declare
+--                 L : constant Node_Access := Left (Node);
+--              begin
+--                 pragma Assert (L = null or else Color (L) = Black);
+--                 null;
+--              end;
+--
+--              declare
+--                 R : constant Node_Access := Right (Node);
+--              begin
+--                 pragma Assert (R = null or else Color (R) = Black);
+--                 null;
+--              end;
+--
+--              declare
+--                 NL : constant Natural := Check (Left (Node));
+--                 NR : constant Natural := Check (Right (Node));
+--              begin
+--                 pragma Assert (NL = NR);
+--                 return NL;
+--              end;
+--           end if;
+--
+--           declare
+--              NL : constant Natural := Check (Left (Node));
+--              NR : constant Natural := Check (Right (Node));
+--           begin
+--              pragma Assert (NL = NR);
+--              return NL + 1;
+--           end;
+--        end Check;
+--
+--     --  Start of processing for Check_Invariant
+--
+--     begin
+--        if Root = null then
+--           pragma Assert (Tree.First = null);
+--           pragma Assert (Tree.Last = null);
+--           pragma Assert (Tree.Length = 0);
+--           null;
+--
+--        else
+--           pragma Assert (Color (Root) = Black);
+--           pragma Assert (Tree.Length > 0);
+--           pragma Assert (Tree.Root /= null);
+--           pragma Assert (Tree.First /= null);
+--           pragma Assert (Tree.Last /= null);
+--           pragma Assert (Parent (Tree.Root) = null);
+--           pragma Assert ((Tree.Length > 1)
+--                             or else (Tree.First = Tree.Last
+--                                        and Tree.First = Tree.Root));
+--           pragma Assert (Left (Tree.First) = null);
+--           pragma Assert (Right (Tree.Last) = null);
+--
+--           declare
+--              L  : constant Node_Access := Left (Root);
+--              R  : constant Node_Access := Right (Root);
+--              NL : constant Natural := Check (L);
+--              NR : constant Natural := Check (R);
+--           begin
+--              pragma Assert (NL = NR);
+--              null;
+--           end;
+--        end if;
+--     end Check_Invariant;
 
    ------------------
    -- Delete_Fixup --
@@ -249,22 +249,22 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
          raise Program_Error;
       end if;
 
-      pragma Assert (Tree.Length > 0);
-      pragma Assert (Tree.Root /= null);
-      pragma Assert (Tree.First /= null);
-      pragma Assert (Tree.Last /= null);
-      pragma Assert (Parent (Tree.Root) = null);
-      pragma Assert ((Tree.Length > 1)
-                        or else (Tree.First = Tree.Last
-                                   and then Tree.First = Tree.Root));
-      pragma Assert ((Left (Node) = null)
-                        or else (Parent (Left (Node)) = Node));
-      pragma Assert ((Right (Node) = null)
-                        or else (Parent (Right (Node)) = Node));
-      pragma Assert (((Parent (Node) = null) and then (Tree.Root = Node))
-                        or else ((Parent (Node) /= null) and then
-                                  ((Left (Parent (Node)) = Node)
-                                     or else (Right (Parent (Node)) = Node))));
+--    pragma Assert (Tree.Length > 0);
+--    pragma Assert (Tree.Root /= null);
+--    pragma Assert (Tree.First /= null);
+--    pragma Assert (Tree.Last /= null);
+--    pragma Assert (Parent (Tree.Root) = null);
+--    pragma Assert ((Tree.Length > 1)
+--                      or else (Tree.First = Tree.Last
+--                                 and then Tree.First = Tree.Root));
+--    pragma Assert ((Left (Node) = null)
+--                      or else (Parent (Left (Node)) = Node));
+--    pragma Assert ((Right (Node) = null)
+--                      or else (Parent (Right (Node)) = Node));
+--    pragma Assert (((Parent (Node) = null) and then (Tree.Root = Node))
+--                      or else ((Parent (Node) /= null) and then
+--                                ((Left (Parent (Node)) = Node)
+--                                   or else (Right (Parent (Node)) = Node))));
 
       if Left (Z) = null then
          if Right (Z) = null then
@@ -545,7 +545,6 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
       P, X        : Node_Access;
 
    begin
-
       if Right (Source_Root) /= null then
          Set_Right
            (Node  => Target_Root,
@@ -586,7 +585,6 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
       when others =>
          Delete_Tree (Target_Root);
          raise;
-
    end Generic_Copy_Tree;
 
    -------------------------
@@ -1049,4 +1047,106 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
       Set_Parent (Y, X);
    end Right_Rotate;
 
+   ---------
+   -- Vet --
+   ---------
+
+   function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean is
+   begin
+      if Node = null then
+         return True;
+      end if;
+
+      if Parent (Node) = Node
+        or else Left (Node) = Node
+        or else Right (Node) = Node
+      then
+         return False;
+      end if;
+
+      if Tree.Length = 0
+        or else Tree.Root = null
+        or else Tree.First = null
+        or else Tree.Last = null
+      then
+         return False;
+      end if;
+
+      if Parent (Tree.Root) /= null then
+         return False;
+      end if;
+
+      if Left (Tree.First) /= null then
+         return False;
+      end if;
+
+      if Right (Tree.Last) /= null then
+         return False;
+      end if;
+
+      if Tree.Length = 1 then
+         if Tree.First /= Tree.Last
+           or else Tree.First /= Tree.Root
+         then
+            return False;
+         end if;
+
+         if Node /= Tree.First then
+            return False;
+         end if;
+
+         if Parent (Node) /= null
+           or else Left (Node) /= null
+           or else Right (Node) /= null
+         then
+            return False;
+         end if;
+
+         return True;
+      end if;
+
+      if Tree.First = Tree.Last then
+         return False;
+      end if;
+
+      if Tree.Length = 2 then
+         if Tree.First /= Tree.Root
+           and then Tree.Last /= Tree.Root
+         then
+            return False;
+         end if;
+
+         if Tree.First /= Node
+           and then Tree.Last /= Node
+         then
+            return False;
+         end if;
+      end if;
+
+      if Left (Node) /= null
+        and then Parent (Left (Node)) /= Node
+      then
+         return False;
+      end if;
+
+      if Right (Node) /= null
+        and then Parent (Right (Node)) /= Node
+      then
+         return False;
+      end if;
+
+      if Parent (Node) = null then
+         if Tree.Root /= Node then
+            return False;
+         end if;
+
+      elsif Left (Parent (Node)) /= Node
+        and then Right (Parent (Node)) /= Node
+      then
+         return False;
+      end if;
+
+      return True;
+   end Vet;
+
 end Ada.Containers.Red_Black_Trees.Generic_Operations;

gcc/ada/a-crbtgo.ads

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005 Free Software Foundation, Inc.          --
+--          Copyright (C) 2004-2005, 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 --
@@ -56,7 +56,14 @@ package Ada.Containers.Red_Black_Trees.Generic_Operations is
 
    function Max (Node : Node_Access) return Node_Access;
 
-   procedure Check_Invariant (Tree : Tree_Type);
+   --  NOTE: The Check_Invariant operation was used during early
+   --  development of the red-black tree. Now that the tree type
+   --  implementation has matured, we don't really need Check_Invariant
+   --  anymore.
+
+   --  procedure Check_Invariant (Tree : Tree_Type);
+
+   function Vet (Tree : Tree_Type; Node : Node_Access) return Boolean;
 
    function Next (Node : Node_Access) return Node_Access;