a-cihase.adb, [...]: Synchronized with latest draft (Draft 13, August 2005) of Ada Amendment 1.

2005-09-01  Matthew Heaney  <heaney@adacore.com>

	* a-cihase.adb, a-coorse.ads, a-coorse.adb, a-cohama.adb,
	a-ciorse.ads, a-ciorse.adb, a-cihama.adb, a-cdlili.adb,
	a-cidlli.adb, a-chtgop.adb, a-cihase.adb, a-cihase.ads,
	a-cohase.adb, a-cohase.adb, a-cohase.ads: Synchronized with latest
	draft (Draft 13, August 2005) of Ada Amendment 1.

From-SVN: r103892

gcc/ada/a-cdlili.adb

@@ -38,18 +38,19 @@ with Ada.Unchecked_Deallocation;
 
 package body Ada.Containers.Doubly_Linked_Lists is
 
-   procedure Free is
-     new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
-
    -----------------------
    -- Local Subprograms --
    -----------------------
 
+   procedure Free (X : in out Node_Access);
+
    procedure Insert_Internal
      (Container : in out List;
       Before    : Node_Access;
       New_Node  : Node_Access);
 
+   function Vet (Position : Cursor) return Boolean;
+
    ---------
    -- "=" --
    ---------
@@ -110,7 +111,6 @@ package body Ada.Containers.Doubly_Linked_Lists is
       Container.Length := 1;
 
       Src := Src.Next;
-
       while Src /= null loop
          Container.Last.Next := new Node_Type'(Element => Src.Element,
                                                Prev    => Container.Last,
@@ -162,9 +162,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
          pragma Assert (X.Next.Prev = Container.First);
 
          Container.First := X.Next;
-         X.Next := null;  --  prevent mischief
-
          Container.First.Prev := null;
+
          Container.Length := Container.Length - 1;
 
          Free (X);
@@ -181,7 +180,7 @@ package body Ada.Containers.Doubly_Linked_Lists is
    end Clear;
 
    --------------
-   -- Continue --
+   -- Contains --
    --------------
 
    function Contains
@@ -203,28 +202,16 @@ 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
-         pragma Assert (Position.Container = null);
          raise Constraint_Error;
       end if;
 
-      if Position.Container /= List_Access'(Container'Unchecked_Access) then
+      if Position.Container /= Container'Unrestricted_Access then
          raise Program_Error;
       end if;
 
-      pragma Assert (Container.Length > 0);
-      pragma Assert (Container.First.Prev = null);
-      pragma Assert (Container.Last.Next = null);
-
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Container.Last);
-
       if Position.Node = Container.First then
          Delete_First (Container, Count);
          Position := First (Container);
@@ -249,7 +236,6 @@ package body Ada.Containers.Doubly_Linked_Lists is
             Container.Last := X.Prev;
             Container.Last.Next := null;
 
-            X.Prev := null;  --  prevent mischief
             Free (X);
             return;
          end if;
@@ -259,8 +245,6 @@ package body Ada.Containers.Doubly_Linked_Lists is
          X.Next.Prev := X.Prev;
          X.Prev.Next := X.Next;
 
-         X.Next := null;
-         X.Prev := null;
          Free (X);
       end loop;
    end Delete;
@@ -298,7 +282,6 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
          Container.Length := Container.Length - 1;
 
-         X.Next := null;  --  prevent mischief
          Free (X);
       end loop;
    end Delete_First;
@@ -336,7 +319,6 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
          Container.Length := Container.Length - 1;
 
-         X.Prev := null;  --  prevent mischief
          Free (X);
       end loop;
    end Delete_Last;
@@ -347,20 +329,11 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
    function Element (Position : Cursor) return Element_Type is
    begin
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
+      pragma Assert (Vet (Position), "bad cursor in Element");
+
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
       return Position.Node.Element;
    end Element;
@@ -379,23 +352,13 @@ package body Ada.Containers.Doubly_Linked_Lists is
    begin
       if Node = null then
          Node := Container.First;
+
       else
-         if Position.Container /= List_Access'(Container'Unchecked_Access) then
+         pragma Assert (Vet (Position), "bad cursor in Find");
+
+         if Position.Container /= Container'Unrestricted_Access then
             raise Program_Error;
          end if;
-
-         pragma Assert (Container.Length > 0);
-         pragma Assert (Container.First.Prev = null);
-         pragma Assert (Container.Last.Next = null);
-
-         pragma Assert (Position.Node.Prev = null
-                          or else Position.Node.Prev.Next = Position.Node);
-         pragma Assert (Position.Node.Next = null
-                          or else Position.Node.Next.Prev = Position.Node);
-         pragma Assert (Position.Node.Prev /= null
-                          or else Position.Node = Container.First);
-         pragma Assert (Position.Node.Next /= null
-                          or else Position.Node = Container.Last);
       end if;
 
       while Node /= null loop
@@ -428,9 +391,27 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
    function First_Element (Container : List) return Element_Type is
    begin
+      if Container.First = null then
+         raise Constraint_Error;
+      end if;
+
       return Container.First.Element;
    end First_Element;
 
+   ----------
+   -- Free --
+   ----------
+
+   procedure Free (X : in out Node_Access) is
+      procedure Deallocate is
+         new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+
+   begin
+      X.Prev := X;
+      X.Next := X;
+      Deallocate (X);
+   end Free;
+
    ---------------------
    -- Generic_Sorting --
    ---------------------
@@ -605,26 +586,8 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
    function Has_Element (Position : Cursor) return Boolean is
    begin
-      if Position.Node = null then
-         pragma Assert (Position.Container = null);
-         return False;
-      end if;
-
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
-      return True;
+      pragma Assert (Vet (Position), "bad cursor in Has_Element");
+      return Position.Node /= null;
    end Has_Element;
 
    ------------
@@ -641,23 +604,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
       New_Node : Node_Access;
 
    begin
-      if Before.Node /= null then
-         if Before.Container /= List_Access'(Container'Unchecked_Access) then
-            raise Program_Error;
-         end if;
+      pragma Assert (Vet (Before), "bad cursor in Insert");
 
-         pragma Assert (Container.Length > 0);
-         pragma Assert (Container.First.Prev = null);
-         pragma Assert (Container.Last.Next = null);
-
-         pragma Assert (Before.Node.Prev = null
-                          or else Before.Node.Prev.Next = Before.Node);
-         pragma Assert (Before.Node.Next = null
-                          or else Before.Node.Next.Prev = Before.Node);
-         pragma Assert (Before.Node.Prev /= null
-                          or else Before.Node = Container.First);
-         pragma Assert (Before.Node.Next /= null
-                          or else Before.Node = Container.Last);
+      if Before.Container /= null
+        and then Before.Container /= Container'Unrestricted_Access
+      then
+         raise Program_Error;
       end if;
 
       if Count = 0 then
@@ -704,23 +656,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
       New_Node : Node_Access;
 
    begin
-      if Before.Node /= null then
-         if Before.Container /= List_Access'(Container'Unchecked_Access) then
-            raise Program_Error;
-         end if;
+      pragma Assert (Vet (Before), "bad cursor in Insert");
 
-         pragma Assert (Container.Length > 0);
-         pragma Assert (Container.First.Prev = null);
-         pragma Assert (Container.Last.Next = null);
-
-         pragma Assert (Before.Node.Prev = null
-                          or else Before.Node.Prev.Next = Before.Node);
-         pragma Assert (Before.Node.Next = null
-                          or else Before.Node.Next.Prev = Before.Node);
-         pragma Assert (Before.Node.Prev /= null
-                          or else Before.Node = Container.First);
-         pragma Assert (Before.Node.Next /= null
-                          or else Before.Node = Container.Last);
+      if Before.Container /= null
+        and then Before.Container /= Container'Unrestricted_Access
+      then
+         raise Program_Error;
       end if;
 
       if Count = 0 then
@@ -853,6 +794,10 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
    function Last_Element (Container : List) return Element_Type is
    begin
+      if Container.Last = null then
+         raise Constraint_Error;
+      end if;
+
       return Container.Last.Element;
    end Last_Element;
 
@@ -900,25 +845,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
    procedure Next (Position : in out Cursor) is
    begin
+      pragma Assert (Vet (Position), "bad cursor in procedure Next");
+
       if Position.Node = null then
-         pragma Assert (Position.Container = null);
          return;
       end if;
 
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
       Position.Node := Position.Node.Next;
 
       if Position.Node = null then
@@ -928,25 +860,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
    function Next (Position : Cursor) return Cursor is
    begin
+      pragma Assert (Vet (Position), "bad cursor in function Next");
+
       if Position.Node = null then
-         pragma Assert (Position.Container = null);
          return No_Element;
       end if;
 
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
       declare
          Next_Node : constant Node_Access := Position.Node.Next;
       begin
@@ -977,25 +896,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
    procedure Previous (Position : in out Cursor) is
    begin
+      pragma Assert (Vet (Position), "bad cursor in procedure Previous");
+
       if Position.Node = null then
-         pragma Assert (Position.Container = null);
          return;
       end if;
 
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
       Position.Node := Position.Node.Prev;
 
       if Position.Node = null then
@@ -1005,25 +911,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
    function Previous (Position : Cursor) return Cursor is
    begin
+      pragma Assert (Vet (Position), "bad cursor in function Previous");
+
       if Position.Node = null then
-         pragma Assert (Position.Container = null);
          return No_Element;
       end if;
 
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
       declare
          Prev_Node : constant Node_Access := Position.Node.Prev;
       begin
@@ -1043,42 +936,34 @@ package body Ada.Containers.Doubly_Linked_Lists is
      (Position : Cursor;
       Process  : not null access procedure (Element : in Element_Type))
    is
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
-      E : Element_Type renames Position.Node.Element;
-
-      C : List renames Position.Container.all'Unrestricted_Access.all;
-      B : Natural renames C.Busy;
-      L : Natural renames C.Lock;
-
    begin
-      B := B + 1;
-      L := L + 1;
+      pragma Assert (Vet (Position), "bad cursor in Query_Element");
+
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      declare
+         C : List renames Position.Container.all'Unrestricted_Access.all;
+         B : Natural renames C.Busy;
+         L : Natural renames C.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;
 
    ----------
@@ -1141,29 +1026,18 @@ package body Ada.Containers.Doubly_Linked_Lists is
      (Position : Cursor;
       By       : Element_Type)
    is
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
-      E : Element_Type renames Position.Node.Element;
-
    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
          raise Program_Error;
       end if;
 
-      E := By;
+      Position.Node.Element := By;
    end Replace_Element;
 
    ------------------
@@ -1180,23 +1054,13 @@ package body Ada.Containers.Doubly_Linked_Lists is
    begin
       if Node = null then
          Node := Container.Last;
+
       else
-         if Position.Container /= List_Access'(Container'Unchecked_Access) then
+         pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
+
+         if Position.Container /= Container'Unrestricted_Access then
             raise Program_Error;
          end if;
-
-         pragma Assert (Container.Length > 0);
-         pragma Assert (Container.First.Prev = null);
-         pragma Assert (Container.Last.Next = null);
-
-         pragma Assert (Position.Node.Prev = null
-                          or else Position.Node.Prev.Next = Position.Node);
-         pragma Assert (Position.Node.Next = null
-                          or else Position.Node.Next.Prev = Position.Node);
-         pragma Assert (Position.Node.Prev /= null
-                          or else Position.Node = Container.First);
-         pragma Assert (Position.Node.Next /= null
-                          or else Position.Node = Container.Last);
       end if;
 
       while Node /= null loop
@@ -1336,23 +1200,12 @@ package body Ada.Containers.Doubly_Linked_Lists is
       Source : in out List)
    is
    begin
-      if Before.Node /= null then
-         if Before.Container /= List_Access'(Target'Unchecked_Access) then
-            raise Program_Error;
-         end if;
-
-         pragma Assert (Target.Length >= 1);
-         pragma Assert (Target.First.Prev = null);
-         pragma Assert (Target.Last.Next = null);
+      pragma Assert (Vet (Before), "bad cursor in Splice");
 
-         pragma Assert (Before.Node.Prev = null
-                          or else Before.Node.Prev.Next = Before.Node);
-         pragma Assert (Before.Node.Next = null
-                          or else Before.Node.Next.Prev = Before.Node);
-         pragma Assert (Before.Node.Prev /= null
-                          or else Before.Node = Target.First);
-         pragma Assert (Before.Node.Next /= null
-                          or else Before.Node = Target.Last);
+      if Before.Container /= null
+        and then Before.Container /= Target'Unrestricted_Access
+      then
+         raise Program_Error;
       end if;
 
       if Target'Address = Source'Address
@@ -1421,46 +1274,23 @@ package body Ada.Containers.Doubly_Linked_Lists is
       Position : Cursor)
    is
    begin
-      if Before.Node /= null then
-         if Before.Container /= List_Access'(Target'Unchecked_Access) then
-            raise Program_Error;
-         end if;
+      pragma Assert (Vet (Before), "bad Before cursor in Splice");
+      pragma Assert (Vet (Position), "bad Position cursor in Splice");
 
-         pragma Assert (Target.Length >= 1);
-         pragma Assert (Target.First.Prev = null);
-         pragma Assert (Target.Last.Next = null);
-
-         pragma Assert (Before.Node.Prev = null
-                          or else Before.Node.Prev.Next = Before.Node);
-         pragma Assert (Before.Node.Next = null
-                          or else Before.Node.Next.Prev = Before.Node);
-         pragma Assert (Before.Node.Prev /= null
-                          or else Before.Node = Target.First);
-         pragma Assert (Before.Node.Next /= null
-                          or else Before.Node = Target.Last);
+      if Before.Container /= null
+        and then Before.Container /= Target'Unchecked_Access
+      then
+         raise Program_Error;
       end if;
 
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
-      if Position.Container /= List_Access'(Target'Unchecked_Access) then
+      if Position.Container /= Target'Unrestricted_Access then
          raise Program_Error;
       end if;
 
-      pragma Assert (Target.Length >= 1);
-      pragma Assert (Target.First.Prev = null);
-      pragma Assert (Target.Last.Next = null);
-
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Target.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Target.Last);
-
       if Position.Node = Before.Node
         or else Position.Node.Next = Before.Node
       then
@@ -1548,46 +1378,23 @@ package body Ada.Containers.Doubly_Linked_Lists is
          return;
       end if;
 
-      if Before.Node /= null then
-         if Before.Container /= List_Access'(Target'Unchecked_Access) then
-            raise Program_Error;
-         end if;
+      pragma Assert (Vet (Before), "bad Before cursor in Splice");
+      pragma Assert (Vet (Position), "bad Position cursor in Splice");
 
-         pragma Assert (Target.Length >= 1);
-         pragma Assert (Target.First.Prev = null);
-         pragma Assert (Target.Last.Next = null);
-
-         pragma Assert (Before.Node.Prev = null
-                          or else Before.Node.Prev.Next = Before.Node);
-         pragma Assert (Before.Node.Next = null
-                          or else Before.Node.Next.Prev = Before.Node);
-         pragma Assert (Before.Node.Prev /= null
-                          or else Before.Node = Target.First);
-         pragma Assert (Before.Node.Next /= null
-                          or else Before.Node = Target.Last);
+      if Before.Container /= null
+        and then Before.Container /= Target'Unrestricted_Access
+      then
+         raise Program_Error;
       end if;
 
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
-      if Position.Container /= List_Access'(Source'Unchecked_Access) then
+      if Position.Container /= Source'Unrestricted_Access then
          raise Program_Error;
       end if;
 
-      pragma Assert (Source.Length >= 1);
-      pragma Assert (Source.First.Prev = null);
-      pragma Assert (Source.Last.Next = null);
-
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Source.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Source.Last);
-
       if Target.Length = Count_Type'Last then
          raise Constraint_Error;
       end if;
@@ -1600,12 +1407,14 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
       if Position.Node = Source.First then
          Source.First := Position.Node.Next;
-         Source.First.Prev := null;
 
          if Position.Node = Source.Last then
             pragma Assert (Source.First = null);
             pragma Assert (Source.Length = 1);
             Source.Last := null;
+
+         else
+            Source.First.Prev := null;
          end if;
 
       elsif Position.Node = Source.Last then
@@ -1667,8 +1476,11 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
    procedure Swap (I, J : Cursor) is
    begin
-      if I.Container = null
-        or else J.Container = null
+      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;
@@ -1677,51 +1489,22 @@ package body Ada.Containers.Doubly_Linked_Lists is
          raise Program_Error;
       end if;
 
-      declare
-         C : List renames I.Container.all;
-      begin
-         pragma Assert (C.Length >= 1);
-         pragma Assert (C.First.Prev = null);
-         pragma Assert (C.Last.Next = null);
-
-         pragma Assert (I.Node /= null);
-         pragma Assert (I.Node.Prev = null
-                          or else I.Node.Prev.Next = I.Node);
-         pragma Assert (I.Node.Next = null
-                          or else I.Node.Next.Prev = I.Node);
-         pragma Assert (I.Node.Prev /= null
-                          or else I.Node = C.First);
-         pragma Assert (I.Node.Next /= null
-                          or else I.Node = C.Last);
-
-         if I.Node = J.Node then
-            return;
-         end if;
+      if I.Node = J.Node then
+         return;
+      end if;
 
-         pragma Assert (C.Length >= 2);
-         pragma Assert (J.Node /= null);
-         pragma Assert (J.Node.Prev = null
-                          or else J.Node.Prev.Next = J.Node);
-         pragma Assert (J.Node.Next = null
-                          or else J.Node.Next.Prev = J.Node);
-         pragma Assert (J.Node.Prev /= null
-                          or else J.Node = C.First);
-         pragma Assert (J.Node.Next /= null
-                          or else J.Node = C.Last);
-
-         if C.Lock > 0 then
-            raise Program_Error;
-         end if;
+      if I.Container.Lock > 0 then
+         raise Program_Error;
+      end if;
 
-         declare
-            EI : Element_Type renames I.Node.Element;
-            EJ : Element_Type renames J.Node.Element;
+      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;
-         end;
+         EI_Copy : constant Element_Type := EI;
+      begin
+         EI := EJ;
+         EJ := EI_Copy;
       end;
    end Swap;
 
@@ -1733,50 +1516,25 @@ package body Ada.Containers.Doubly_Linked_Lists is
      (Container : in out List;
       I, J      : Cursor) is
    begin
-      if I.Container = null
-        or else J.Container = null
+      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
          raise Constraint_Error;
       end if;
 
-      if I.Container /= List_Access'(Container'Unchecked_Access) then
-         raise Program_Error;
-      end if;
-
-      if J.Container /= I.Container then
+      if I.Container /= Container'Unrestricted_Access
+        or else I.Container /= J.Container
+      then
          raise Program_Error;
       end if;
 
-      pragma Assert (Container.Length >= 1);
-      pragma Assert (Container.First.Prev = null);
-      pragma Assert (Container.Last.Next = null);
-
-      pragma Assert (I.Node /= null);
-      pragma Assert (I.Node.Prev = null
-                       or else I.Node.Prev.Next = I.Node);
-      pragma Assert (I.Node.Next = null
-                       or else I.Node.Next.Prev = I.Node);
-      pragma Assert (I.Node.Prev /= null
-                       or else I.Node = Container.First);
-      pragma Assert (I.Node.Next /= null
-                       or else I.Node = Container.Last);
-
       if I.Node = J.Node then
          return;
       end if;
 
-      pragma Assert (Container.Length >= 2);
-
-      pragma Assert (J.Node /= null);
-      pragma Assert (J.Node.Prev = null
-                       or else J.Node.Prev.Next = J.Node);
-      pragma Assert (J.Node.Next = null
-                       or else J.Node.Next.Prev = J.Node);
-      pragma Assert (J.Node.Prev /= null
-                       or else J.Node = Container.First);
-      pragma Assert (J.Node.Next /= null
-                       or else J.Node = Container.Last);
-
       if Container.Busy > 0 then
          raise Program_Error;
       end if;
@@ -1813,46 +1571,177 @@ package body Ada.Containers.Doubly_Linked_Lists is
 
    procedure Update_Element
      (Position : Cursor;
-      Process  : not null access procedure (Element : in out Element_Type)) is
-
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length >= 1);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
-      E : Element_Type renames Position.Node.Element;
-
-      C : List renames Position.Container.all'Unrestricted_Access.all;
-      B : Natural renames C.Busy;
-      L : Natural renames C.Lock;
-
+      Process  : not null access procedure (Element : in out Element_Type))
+   is
    begin
-      B := B + 1;
-      L := L + 1;
+      pragma Assert (Vet (Position), "bad cursor in Update_Element");
+
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      declare
+         C : List renames Position.Container.all'Unrestricted_Access.all;
+         B : Natural renames C.Busy;
+         L : Natural renames C.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 Update_Element;
 
+   ---------
+   -- Vet --
+   ---------
+
+   function Vet (Position : Cursor) return Boolean is
+   begin
+      if Position.Node = null then
+         return Position.Container = null;
+      end if;
+
+      if Position.Container = null then
+         return False;
+      end if;
+
+      if Position.Node.Next = Position.Node then
+         return False;
+      end if;
+
+      if Position.Node.Prev = Position.Node then
+         return False;
+      end if;
+
+      declare
+         L : List renames Position.Container.all;
+      begin
+         if L.Length = 0 then
+            return False;
+         end if;
+
+         if L.First = null then
+            return False;
+         end if;
+
+         if L.Last = null then
+            return False;
+         end if;
+
+         if L.First.Prev /= null then
+            return False;
+         end if;
+
+         if L.Last.Next /= null then
+            return False;
+         end if;
+
+         if Position.Node.Prev = null
+           and then Position.Node /= L.First
+         then
+            return False;
+         end if;
+
+         if Position.Node.Next = null
+           and then Position.Node /= L.Last
+         then
+            return False;
+         end if;
+
+         if L.Length = 1 then
+            return L.First = L.Last;
+         end if;
+
+         if L.First = L.Last then
+            return False;
+         end if;
+
+         if L.First.Next = null then
+            return False;
+         end if;
+
+         if L.Last.Prev = null then
+            return False;
+         end if;
+
+         if L.First.Next.Prev /= L.First then
+            return False;
+         end if;
+
+         if L.Last.Prev.Next /= L.Last then
+            return False;
+         end if;
+
+         if L.Length = 2 then
+            if L.First.Next /= L.Last then
+               return False;
+            end if;
+
+            if L.Last.Prev /= L.First then
+               return False;
+            end if;
+
+            return True;
+         end if;
+
+         if L.First.Next = L.Last then
+            return False;
+         end if;
+
+         if L.Last.Prev = L.First then
+            return False;
+         end if;
+
+         if Position.Node = L.First then
+            return True;
+         end if;
+
+         if Position.Node = L.Last then
+            return True;
+         end if;
+
+         if Position.Node.Next = null then
+            return False;
+         end if;
+
+         if Position.Node.Prev = null then
+            return False;
+         end if;
+
+         if Position.Node.Next.Prev /= Position.Node then
+            return False;
+         end if;
+
+         if Position.Node.Prev.Next /= Position.Node then
+            return False;
+         end if;
+
+         if L.Length = 3 then
+            if L.First.Next /= Position.Node then
+               return False;
+            end if;
+
+            if L.Last.Prev /= Position.Node then
+               return False;
+            end if;
+         end if;
+
+         return True;
+      end;
+   end Vet;
+
    -----------
    -- Write --
    -----------

gcc/ada/a-chtgop.adb

@@ -42,14 +42,6 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
    procedure Free is
      new Ada.Unchecked_Deallocation (Buckets_Type, Buckets_Access);
 
-   -----------------------
-   -- Local Subprograms --
-   -----------------------
-
-   procedure Rehash
-     (HT   : in out Hash_Table_Type;
-      Size : Hash_Type);
-
    ------------
    -- Adjust --
    ------------
@@ -405,27 +397,33 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
    begin
       Clear (HT);
 
-      declare
-         B : Buckets_Access := HT.Buckets;
-      begin
-         HT.Buckets := null;
-         HT.Length := 0;
-         Free (B); -- can this fail???
-      end;
-
       Hash_Type'Read (Stream, Last);
 
-      --  TODO: don't immediately deallocate the buckets array we
-      --  already have. Instead, allocate a new buckets array only
-      --  if it needs to expanded because of the value of Last.
+      Count_Type'Base'Read (Stream, N);
+      pragma Assert (N >= 0);
+
+      if N = 0 then
+         return;
+      end if;
 
-      if Last /= 0 then
+      if HT.Buckets = null
+        or else HT.Buckets'Last /= Last
+      then
+         Free (HT.Buckets);
          HT.Buckets := new Buckets_Type (0 .. Last);
       end if;
 
-      Count_Type'Base'Read (Stream, N);
-      pragma Assert (N >= 0);
-      while N > 0 loop
+      --  TODO: should we rewrite this algorithm so that it doesn't
+      --  depend on preserving the exactly length of the hash table
+      --  array?  We would prefer to not have to (re)allocate a
+      --  buckets array (the array that HT already has might be large
+      --  enough), and to not have to stream the count of the number
+      --  of nodes in each bucket.  The algorithm below is vestigial,
+      --  as it was written prior to the meeting in Palma, when the
+      --  semantics of equality were changed (and which obviated the
+      --  need to preserve the hash table length).
+
+      loop
          Hash_Type'Read (Stream, I);
          pragma Assert (I in HT.Buckets'Range);
          pragma Assert (HT.Buckets (I) = null);
@@ -454,6 +452,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
          end loop;
 
          N := N - M;
+
+         exit when N = 0;
       end loop;
    end Generic_Read;
 
@@ -481,6 +481,8 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
          return;
       end if;
 
+      --  TODO: see note in Generic_Read???
+
       for Indx in HT.Buckets'Range loop
          X := HT.Buckets (Indx);
 
@@ -577,104 +579,6 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
       return null;
    end Next;
 
-   ------------
-   -- Rehash --
-   ------------
-
-   procedure Rehash
-     (HT   : in out Hash_Table_Type;
-      Size : Hash_Type)
-   is
-      subtype Buckets_Range is Hash_Type range 0 .. Size - 1;
-
-      Dst_Buckets : Buckets_Access := new Buckets_Type (Buckets_Range);
-      Src_Buckets : Buckets_Access := HT.Buckets;
-
-      L  : Count_Type renames HT.Length;
-      LL : constant Count_Type := L;
-
-   begin
-      if Src_Buckets = null then
-         pragma Assert (L = 0);
-         HT.Buckets := Dst_Buckets;
-         return;
-      end if;
-
-      if L = 0 then
-         HT.Buckets := Dst_Buckets;
-         Free (Src_Buckets);
-         return;
-      end if;
-
-      --  We might want to change this to iter from 1 .. L instead ???
-
-      for Src_Index in Src_Buckets'Range loop
-
-         declare
-            Src_Bucket : Node_Access renames Src_Buckets (Src_Index);
-         begin
-            while Src_Bucket /= null loop
-               declare
-                  Src_Node   : constant Node_Access := Src_Bucket;
-                  Dst_Index  : constant Hash_Type :=
-                                 Index (Dst_Buckets.all, Src_Node);
-                  Dst_Bucket : Node_Access renames Dst_Buckets (Dst_Index);
-               begin
-                  Src_Bucket := Next (Src_Node);
-                  Set_Next (Src_Node, Dst_Bucket);
-                  Dst_Bucket := Src_Node;
-               end;
-
-               pragma Assert (L > 0);
-               L := L - 1;
-
-            end loop;
-
-         exception
-            when others =>
-
-               --  NOTE: see todo below.
-               --  Not clear that we can deallocate the nodes,
-               --  because they may be designated by outstanding
-               --  iterators.  Which means they're now lost... ???
-
-               --                 for J in NB'Range loop
-               --                    declare
-               --                       Dst : Node_Access renames NB (J);
-               --                       X   : Node_Access;
-               --                    begin
-               --                       while Dst /= null loop
-               --                          X := Dst;
-               --                          Dst := Succ (Dst);
-               --                          Free (X);
-               --                       end loop;
-               --                    end;
-               --                 end loop;
-
-               --  TODO: 17 Apr 2005
-               --  What I should do instead is go ahead and deallocate the
-               --  nodes, since when assertions are enabled, we vet the
-               --  cursors, and we modify the state of a node enough when
-               --  it is deallocated in order to detect mischief.
-               --  END TODO.
-
-               Free (Dst_Buckets);
-               raise;  --  TODO: raise Program_Error instead
-         end;
-
-         --  exit when L = 0;
-         --  need to bother???
-
-      end loop;
-
-      pragma Assert (L = 0);
-
-      HT.Buckets := Dst_Buckets;
-      HT.Length := LL;
-
-      Free (Src_Buckets);
-   end Rehash;
-
    ----------------------
    -- Reserve_Capacity --
    ----------------------
@@ -686,74 +590,142 @@ package body Ada.Containers.Hash_Tables.Generic_Operations is
       NN : Hash_Type;
 
    begin
-      if N = 0 then
-         if HT.Length = 0 then
-            Free (HT.Buckets);
+      if HT.Buckets = null then
+         if N > 0 then
+            NN := Prime_Numbers.To_Prime (N);
+            HT.Buckets := new Buckets_Type (0 .. NN - 1);
+         end if;
 
-         elsif HT.Length < HT.Buckets'Length then
-            NN := Prime_Numbers.To_Prime (HT.Length);
+         return;
+      end if;
 
-            --  ASSERT: NN >= HT.Length
+      if HT.Length = 0 then
+         if N = 0 then
+            Free (HT.Buckets);
+            return;
+         end if;
 
-            if NN < HT.Buckets'Length then
-               if HT.Busy > 0 then
-                  raise Program_Error;
-               end if;
+         if N = HT.Buckets'Length then
+            return;
+         end if;
 
-               Rehash (HT, Size => NN);
-            end if;
+         NN := Prime_Numbers.To_Prime (N);
+
+         if NN = HT.Buckets'Length then
+            return;
          end if;
 
+         declare
+            X : Buckets_Access := HT.Buckets;
+         begin
+            HT.Buckets := new Buckets_Type (0 .. NN - 1);
+            Free (X);
+         end;
+
          return;
       end if;
 
-      if HT.Buckets = null then
-         NN := Prime_Numbers.To_Prime (N);
-
-         --  ASSERT: NN >= N
-
-         Rehash (HT, Size => NN);
+      if N = HT.Buckets'Length then
          return;
       end if;
 
-      if N <= HT.Length then
+      if N < HT.Buckets'Length then
          if HT.Length >= HT.Buckets'Length then
             return;
          end if;
 
          NN := Prime_Numbers.To_Prime (HT.Length);
 
-         --  ASSERT: NN >= HT.Length
+         if NN >= HT.Buckets'Length then
+            return;
+         end if;
 
-         if NN < HT.Buckets'Length then
-            if HT.Busy > 0 then
-               raise Program_Error;
-            end if;
+      else
+         NN := Prime_Numbers.To_Prime (Count_Type'Max (N, HT.Length));
 
-            Rehash (HT, Size => NN);
+         if NN = HT.Buckets'Length then -- can't expand any more
+            return;
          end if;
+      end if;
 
-         return;
+      if HT.Busy > 0 then
+         raise Program_Error;
       end if;
 
-      --  ASSERT: N > HT.Length
+      Rehash : declare
+         Dst_Buckets : Buckets_Access := new Buckets_Type (0 .. NN - 1);
+         Src_Buckets : Buckets_Access := HT.Buckets;
 
-      if N = HT.Buckets'Length then
-         return;
-      end if;
+         L : Count_Type renames HT.Length;
+         LL : constant Count_Type := L;
 
-      NN := Prime_Numbers.To_Prime (N);
+         Src_Index : Hash_Type := Src_Buckets'First;
 
-      --  ASSERT: NN >= N
-      --  ASSERT: NN > HT.Length
+      begin
+         while L > 0 loop
+            declare
+               Src_Bucket : Node_Access renames Src_Buckets (Src_Index);
 
-      if NN /= HT.Buckets'Length then
-         if HT.Busy > 0 then
-            raise Program_Error;
-         end if;
+            begin
+               while Src_Bucket /= null loop
+                  declare
+                     Src_Node : constant Node_Access := Src_Bucket;
+
+                     Dst_Index : constant Hash_Type :=
+                       Index (Dst_Buckets.all, Src_Node);
+
+                     Dst_Bucket : Node_Access renames Dst_Buckets (Dst_Index);
+
+                  begin
+                     Src_Bucket := Next (Src_Node);
+
+                     Set_Next (Src_Node, Dst_Bucket);
+
+                     Dst_Bucket := Src_Node;
+                  end;
+
+                  pragma Assert (L > 0);
+                  L := L - 1;
+               end loop;
+            exception
+               when others =>
+                  --  If there's an error computing a hash value during a
+                  --  rehash, then AI-302 says the nodes "become lost."  The
+                  --  issue is whether to actually deallocate these lost nodes,
+                  --  since they might be designated by extant cursors.  Here
+                  --  we decide to deallocate the nodes, since it's better to
+                  --  solve real problems (storage consumption) rather than
+                  --  imaginary ones (the user might, or might not, dereference
+                  --  a cursor designating a node that has been deallocated),
+                  --  and because we have a way to vet a dangling cursor
+                  --  reference anyway, and hence can actually detect the
+                  --  problem.
+
+                  for Dst_Index in Dst_Buckets'Range loop
+                     declare
+                        B : Node_Access renames Dst_Buckets (Dst_Index);
+                        X : Node_Access;
+                     begin
+                        while B /= null loop
+                           X := B;
+                           B := Next (X);
+                           Free (X);
+                        end loop;
+                     end;
+                  end loop;
+
+                  Free (Dst_Buckets);
+                  raise Program_Error;
+            end;
 
-         Rehash (HT, Size => NN);
-      end if;
+            Src_Index := Src_Index + 1;
+         end loop;
+
+         HT.Buckets := Dst_Buckets;
+         HT.Length := LL;
+
+         Free (Src_Buckets);
+      end Rehash;
    end Reserve_Capacity;
 
 end Ada.Containers.Hash_Tables.Generic_Operations;

gcc/ada/a-cidlli.adb

@@ -40,20 +40,21 @@ with Ada.Unchecked_Deallocation;
 package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    procedure Free is
-     new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
-
-   procedure Free is
      new Ada.Unchecked_Deallocation (Element_Type, Element_Access);
 
    -----------------------
    -- Local Subprograms --
    -----------------------
 
+   procedure Free (X : in out Node_Access);
+
    procedure Insert_Internal
      (Container : in out List;
       Before    : Node_Access;
       New_Node  : Node_Access);
 
+   function Vet (Position : Cursor) return Boolean;
+
    ---------
    -- "=" --
    ---------
@@ -188,18 +189,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
          Container.First := X.Next;
          Container.First.Prev := null;
-         Container.Length := Container.Length - 1;
-
-         X.Next := null;  --  prevent mischief
 
-         begin
-            Free (X.Element);
-         exception
-            when others =>
-               X.Element := null;
-               Free (X);
-               raise;
-         end;
+         Container.Length := Container.Length - 1;
 
          Free (X);
       end loop;
@@ -211,15 +202,6 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       Container.Last := null;
       Container.Length := 0;
 
-      begin
-         Free (X.Element);
-      exception
-         when others =>
-            X.Element := null;
-            Free (X);
-            raise;
-      end;
-
       Free (X);
    end Clear;
 
@@ -246,28 +228,16 @@ 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.Container /= List_Access'(Container'Unchecked_Access) then
+      if Position.Container /= Container'Unrestricted_Access then
          raise Program_Error;
       end if;
 
-      pragma Assert (Container.Length > 0);
-      pragma Assert (Container.First.Prev = null);
-      pragma Assert (Container.Last.Next = null);
-
-      pragma Assert (Position.Node.Element /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Container.Last);
-
       if Position.Node = Container.First then
          Delete_First (Container, Count);
          Position := First (Container);
@@ -292,17 +262,6 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
             Container.Last := X.Prev;
             Container.Last.Next := null;
 
-            X.Prev := null;  --  prevent mischief
-
-            begin
-               Free (X.Element);
-            exception
-               when others =>
-                  X.Element := null;
-                  Free (X);
-                  raise;
-            end;
-
             Free (X);
             return;
          end if;
@@ -312,18 +271,6 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
          X.Next.Prev := X.Prev;
          X.Prev.Next := X.Next;
 
-         X.Prev := null;
-         X.Next := null;
-
-         begin
-            Free (X.Element);
-         exception
-            when others =>
-               X.Element := null;
-               Free (X);
-               raise;
-         end;
-
          Free (X);
       end loop;
    end Delete;
@@ -361,17 +308,6 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
          Container.Length := Container.Length - 1;
 
-         X.Next := null;  --  prevent mischief
-
-         begin
-            Free (X.Element);
-         exception
-            when others =>
-               X.Element := null;
-               Free (X);
-               raise;
-         end;
-
          Free (X);
       end loop;
    end Delete_First;
@@ -409,17 +345,6 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
          Container.Length := Container.Length - 1;
 
-         X.Prev := null;  --  prevent mischief
-
-         begin
-            Free (X.Element);
-         exception
-            when others =>
-               X.Element := null;
-               Free (X);
-               raise;
-         end;
-
          Free (X);
       end loop;
    end Delete_Last;
@@ -430,21 +355,11 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    function Element (Position : Cursor) return Element_Type is
    begin
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node /= null);
-      pragma Assert (Position.Node.Element /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
+      pragma Assert (Vet (Position), "bad cursor in Element");
+
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
       return Position.Node.Element.all;
    end Element;
@@ -465,23 +380,11 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
          Node := Container.First;
 
       else
-         if Position.Container /= List_Access'(Container'Unchecked_Access) then
+         pragma Assert (Vet (Position), "bad cursor in Find");
+
+         if Position.Container /= Container'Unrestricted_Access then
             raise Program_Error;
          end if;
-
-         pragma Assert (Container.Length > 0);
-         pragma Assert (Container.First.Prev = null);
-         pragma Assert (Container.Last.Next = null);
-
-         pragma Assert (Position.Node.Element /= null);
-         pragma Assert (Position.Node.Prev = null
-                          or else Position.Node.Prev.Next = Position.Node);
-         pragma Assert (Position.Node.Next = null
-                          or else Position.Node.Next.Prev = Position.Node);
-         pragma Assert (Position.Node.Prev /= null
-                          or else Position.Node = Container.First);
-         pragma Assert (Position.Node.Next /= null
-                          or else Position.Node = Container.Last);
       end if;
 
       while Node /= null loop
@@ -514,9 +417,37 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    function First_Element (Container : List) return Element_Type is
    begin
+      if Container.First = null then
+         raise Constraint_Error;
+      end if;
+
       return Container.First.Element.all;
    end First_Element;
 
+   ----------
+   -- Free --
+   ----------
+
+   procedure Free (X : in out Node_Access) is
+      procedure Deallocate is
+         new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
+
+   begin
+      X.Next := X;
+      X.Prev := X;
+
+      begin
+         Free (X.Element);
+      exception
+         when others =>
+            X.Element := null;
+            Deallocate (X);
+            raise;
+      end;
+
+      Deallocate (X);
+   end Free;
+
    ---------------------
    -- Generic_Sorting --
    ---------------------
@@ -686,27 +617,8 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    function Has_Element (Position : Cursor) return Boolean is
    begin
-      if Position.Node = null then
-         pragma Assert (Position.Container = null);
-         return False;
-      end if;
-
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node.Element /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
-      return True;
+      pragma Assert (Vet (Position), "bad cursor in Has_Element");
+      return Position.Node /= null;
    end Has_Element;
 
    ------------
@@ -723,24 +635,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       New_Node : Node_Access;
 
    begin
-      if Before.Node /= null then
-         if Before.Container /= List_Access'(Container'Unchecked_Access) then
-            raise Program_Error;
-         end if;
-
-         pragma Assert (Container.Length > 0);
-         pragma Assert (Container.First.Prev = null);
-         pragma Assert (Container.Last.Next = null);
+      pragma Assert (Vet (Before), "bad cursor in Insert");
 
-         pragma Assert (Before.Node.Element /= null);
-         pragma Assert (Before.Node.Prev = null
-                          or else Before.Node.Prev.Next = Before.Node);
-         pragma Assert (Before.Node.Next = null
-                          or else Before.Node.Next.Prev = Before.Node);
-         pragma Assert (Before.Node.Prev /= null
-                          or else Before.Node = Container.First);
-         pragma Assert (Before.Node.Next /= null
-                          or else Before.Node = Container.Last);
+      if Before.Container /= null
+        and then Before.Container /= Container'Unrestricted_Access
+      then
+         raise Program_Error;
       end if;
 
       if Count = 0 then
@@ -884,32 +784,6 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
    end Iterate;
 
    ----------
-   -- Move --
-   ----------
-
-   procedure Move (Target : in out List; Source : in out List) is
-   begin
-      if Target'Address = Source'Address then
-         return;
-      end if;
-
-      if Source.Busy > 0 then
-         raise Program_Error;
-      end if;
-
-      Clear (Target);
-
-      Target.First := Source.First;
-      Source.First := null;
-
-      Target.Last := Source.Last;
-      Source.Last := null;
-
-      Target.Length := Source.Length;
-      Source.Length := 0;
-   end Move;
-
-   ----------
    -- Last --
    ----------
 
@@ -928,6 +802,10 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    function Last_Element (Container : List) return Element_Type is
    begin
+      if Container.Last = null then
+         raise Constraint_Error;
+      end if;
+
       return Container.Last.Element.all;
    end Last_Element;
 
@@ -941,31 +819,43 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
    end Length;
 
    ----------
+   -- Move --
+   ----------
+
+   procedure Move (Target : in out List; Source : in out List) is
+   begin
+      if Target'Address = Source'Address then
+         return;
+      end if;
+
+      if Source.Busy > 0 then
+         raise Program_Error;
+      end if;
+
+      Clear (Target);
+
+      Target.First := Source.First;
+      Source.First := null;
+
+      Target.Last := Source.Last;
+      Source.Last := null;
+
+      Target.Length := Source.Length;
+      Source.Length := 0;
+   end Move;
+
+   ----------
    -- Next --
    ----------
 
    procedure Next (Position : in out Cursor) is
    begin
+      pragma Assert (Vet (Position), "bad cursor in procedure Next");
+
       if Position.Node = null then
-         pragma Assert (Position.Container = null);
          return;
       end if;
 
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node.Element /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
       Position.Node := Position.Node.Next;
 
       if Position.Node = null then
@@ -975,26 +865,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    function Next (Position : Cursor) return Cursor is
    begin
+      pragma Assert (Vet (Position), "bad cursor in function Next");
+
       if Position.Node = null then
-         pragma Assert (Position.Container = null);
          return No_Element;
       end if;
 
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node.Element /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
       declare
          Next_Node : constant Node_Access := Position.Node.Next;
       begin
@@ -1025,26 +901,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    procedure Previous (Position : in out Cursor) is
    begin
+      pragma Assert (Vet (Position), "bad cursor in procedure Previous");
+
       if Position.Node = null then
-         pragma Assert (Position.Container = null);
          return;
       end if;
 
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node.Element /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
       Position.Node := Position.Node.Prev;
 
       if Position.Node = null then
@@ -1054,26 +916,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    function Previous (Position : Cursor) return Cursor is
    begin
+      pragma Assert (Vet (Position), "bad cursor in function Previous");
+
       if Position.Node = null then
-         pragma Assert (Position.Container = null);
          return No_Element;
       end if;
 
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node.Element /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
       declare
          Prev_Node : constant Node_Access := Position.Node.Prev;
       begin
@@ -1093,43 +941,34 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
      (Position : Cursor;
       Process  : not null access procedure (Element : in Element_Type))
    is
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node /= null);
-      pragma Assert (Position.Node.Element /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
-      E : Element_Type renames Position.Node.Element.all;
-
-      C : List renames Position.Container.all'Unrestricted_Access.all;
-      B : Natural renames C.Busy;
-      L : Natural renames C.Lock;
-
    begin
-      B := B + 1;
-      L := L + 1;
+      pragma Assert (Vet (Position), "bad cursor in Query_Element");
+
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      declare
+         C : List renames Position.Container.all'Unrestricted_Access.all;
+         B : Natural renames C.Busy;
+         L : Natural renames C.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;
 
    ----------
@@ -1193,31 +1032,23 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
      (Position : Cursor;
       By       : Element_Type)
    is
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node /= null);
-      pragma Assert (Position.Node.Element /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
-      X : Element_Access := Position.Node.Element;
-
    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
          raise Program_Error;
       end if;
 
-      Position.Node.Element := new Element_Type'(By);
-      Free (X);
+      declare
+         X : Element_Access := Position.Node.Element;
+      begin
+         Position.Node.Element := new Element_Type'(By);
+         Free (X);
+      end;
    end Replace_Element;
 
    ------------------
@@ -1236,23 +1067,11 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
          Node := Container.Last;
 
       else
-         if Position.Container /= List_Access'(Container'Unchecked_Access) then
+         pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
+
+         if Position.Container /= Container'Unrestricted_Access then
             raise Program_Error;
          end if;
-
-         pragma Assert (Container.Length > 0);
-         pragma Assert (Container.First.Prev = null);
-         pragma Assert (Container.Last.Next = null);
-
-         pragma Assert (Position.Node.Element /= null);
-         pragma Assert (Position.Node.Prev = null
-                          or else Position.Node.Prev.Next = Position.Node);
-         pragma Assert (Position.Node.Next = null
-                          or else Position.Node.Next.Prev = Position.Node);
-         pragma Assert (Position.Node.Prev /= null
-                          or else Position.Node = Container.First);
-         pragma Assert (Position.Node.Next /= null
-                          or else Position.Node = Container.Last);
       end if;
 
       while Node /= null loop
@@ -1392,24 +1211,12 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       Source : in out List)
    is
    begin
-      if Before.Node /= null then
-         if Before.Container /= List_Access'(Target'Unchecked_Access) then
-            raise Program_Error;
-         end if;
-
-         pragma Assert (Target.Length >= 1);
-         pragma Assert (Target.First.Prev = null);
-         pragma Assert (Target.Last.Next = null);
+      pragma Assert (Vet (Before), "bad cursor in Splice");
 
-         pragma Assert (Before.Node.Element /= null);
-         pragma Assert (Before.Node.Prev = null
-                          or else Before.Node.Prev.Next = Before.Node);
-         pragma Assert (Before.Node.Next = null
-                          or else Before.Node.Next.Prev = Before.Node);
-         pragma Assert (Before.Node.Prev /= null
-                          or else Before.Node = Target.First);
-         pragma Assert (Before.Node.Next /= null
-                          or else Before.Node = Target.Last);
+      if Before.Container /= null
+        and then Before.Container /= Target'Unrestricted_Access
+      then
+         raise Program_Error;
       end if;
 
       if Target'Address = Source'Address
@@ -1477,48 +1284,23 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       Position : Cursor)
    is
    begin
-      if Before.Node /= null then
-         if Before.Container /= List_Access'(Target'Unchecked_Access) then
-            raise Program_Error;
-         end if;
-
-         pragma Assert (Target.Length >= 1);
-         pragma Assert (Target.First.Prev = null);
-         pragma Assert (Target.Last.Next = null);
+      pragma Assert (Vet (Before), "bad Before cursor in Splice");
+      pragma Assert (Vet (Position), "bad Position cursor in Splice");
 
-         pragma Assert (Before.Node.Element /= null);
-         pragma Assert (Before.Node.Prev = null
-                          or else Before.Node.Prev.Next = Before.Node);
-         pragma Assert (Before.Node.Next = null
-                          or else Before.Node.Next.Prev = Before.Node);
-         pragma Assert (Before.Node.Prev /= null
-                          or else Before.Node = Target.First);
-         pragma Assert (Before.Node.Next /= null
-                          or else Before.Node = Target.Last);
+      if Before.Container /= null
+        and then Before.Container /= Target'Unchecked_Access
+      then
+         raise Program_Error;
       end if;
 
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
-      if Position.Container /= List_Access'(Target'Unchecked_Access) then
+      if Position.Container /= Target'Unrestricted_Access then
          raise Program_Error;
       end if;
 
-      pragma Assert (Target.Length >= 1);
-      pragma Assert (Target.First.Prev = null);
-      pragma Assert (Target.Last.Next = null);
-
-      pragma Assert (Position.Node.Element /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Target.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Target.Last);
-
       if Position.Node = Before.Node
         or else Position.Node.Next = Before.Node
       then
@@ -1606,48 +1388,23 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
          return;
       end if;
 
-      if Before.Node /= null then
-         if Before.Container /= List_Access'(Target'Unchecked_Access) then
-            raise Program_Error;
-         end if;
-
-         pragma Assert (Target.Length >= 1);
-         pragma Assert (Target.First.Prev = null);
-         pragma Assert (Target.Last.Next = null);
+      pragma Assert (Vet (Before), "bad Before cursor in Splice");
+      pragma Assert (Vet (Position), "bad Position cursor in Splice");
 
-         pragma Assert (Before.Node.Element /= null);
-         pragma Assert (Before.Node.Prev = null
-                          or else Before.Node.Prev.Next = Before.Node);
-         pragma Assert (Before.Node.Next = null
-                          or else Before.Node.Next.Prev = Before.Node);
-         pragma Assert (Before.Node.Prev /= null
-                          or else Before.Node = Target.First);
-         pragma Assert (Before.Node.Next /= null
-                          or else Before.Node = Target.Last);
+      if Before.Container /= null
+        and then Before.Container /= Target'Unrestricted_Access
+      then
+         raise Program_Error;
       end if;
 
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
-      if Position.Container /= List_Access'(Source'Unchecked_Access) then
+      if Position.Container /= Source'Unrestricted_Access then
          raise Program_Error;
       end if;
 
-      pragma Assert (Source.Length >= 1);
-      pragma Assert (Source.First.Prev = null);
-      pragma Assert (Source.Last.Next = null);
-
-      pragma Assert (Position.Node.Element /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Source.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Source.Last);
-
       if Target.Length = Count_Type'Last then
          raise Constraint_Error;
       end if;
@@ -1660,12 +1417,14 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
       if Position.Node = Source.First then
          Source.First := Position.Node.Next;
-         Source.First.Prev := null;
 
          if Position.Node = Source.Last then
             pragma Assert (Source.First = null);
             pragma Assert (Source.Length = 1);
             Source.Last := null;
+
+         else
+            Source.First.Prev := null;
          end if;
 
       elsif Position.Node = Source.Last then
@@ -1727,8 +1486,11 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
 
    procedure Swap (I, J : Cursor) is
    begin
-      if I.Container = null
-        or else J.Container = null
+      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;
@@ -1737,50 +1499,19 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
          raise Program_Error;
       end if;
 
-      declare
-         C : List renames I.Container.all;
-      begin
-         pragma Assert (C.Length > 0);
-         pragma Assert (C.First.Prev = null);
-         pragma Assert (C.Last.Next = null);
-
-         pragma Assert (I.Node /= null);
-         pragma Assert (I.Node.Element /= null);
-         pragma Assert (I.Node.Prev = null
-                          or else I.Node.Prev.Next = I.Node);
-         pragma Assert (I.Node.Next = null
-                          or else I.Node.Next.Prev = I.Node);
-         pragma Assert (I.Node.Prev /= null
-                          or else I.Node = C.First);
-         pragma Assert (I.Node.Next /= null
-                          or else I.Node = C.Last);
-
-         if I.Node = J.Node then
-            return;
-         end if;
+      if I.Node = J.Node then
+         return;
+      end if;
 
-         pragma Assert (C.Length > 1);
-         pragma Assert (J.Node /= null);
-         pragma Assert (J.Node.Element /= null);
-         pragma Assert (J.Node.Prev = null
-                          or else J.Node.Prev.Next = J.Node);
-         pragma Assert (J.Node.Next = null
-                          or else J.Node.Next.Prev = J.Node);
-         pragma Assert (J.Node.Prev /= null
-                          or else J.Node = C.First);
-         pragma Assert (J.Node.Next /= null
-                          or else J.Node = C.Last);
-
-         if C.Lock > 0 then
-            raise Program_Error;
-         end if;
+      if I.Container.Lock > 0 then
+         raise Program_Error;
+      end if;
 
-         declare
-            EI_Copy : constant Element_Access := I.Node.Element;
-         begin
-            I.Node.Element := J.Node.Element;
-            J.Node.Element := EI_Copy;
-         end;
+      declare
+         EI_Copy : constant Element_Access := I.Node.Element;
+      begin
+         I.Node.Element := J.Node.Element;
+         J.Node.Element := EI_Copy;
       end;
    end Swap;
 
@@ -1793,51 +1524,25 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       I, J      : Cursor)
    is
    begin
-      if I.Container = null
-        or else J.Container = null
+      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
          raise Constraint_Error;
       end if;
 
-      if I.Container /= List_Access'(Container'Unchecked_Access) then
-         raise Program_Error;
-      end if;
-
-      if J.Container /= I.Container then
+      if I.Container /= Container'Unrestricted_Access
+        or else I.Container /= J.Container
+      then
          raise Program_Error;
       end if;
 
-      pragma Assert (Container.Length >= 1);
-      pragma Assert (Container.First.Prev = null);
-      pragma Assert (Container.Last.Next = null);
-
-      pragma Assert (I.Node /= null);
-      pragma Assert (I.Node.Element /= null);
-      pragma Assert (I.Node.Prev = null
-                       or else I.Node.Prev.Next = I.Node);
-      pragma Assert (I.Node.Next = null
-                       or else I.Node.Next.Prev = I.Node);
-      pragma Assert (I.Node.Prev /= null
-                       or else I.Node = Container.First);
-      pragma Assert (I.Node.Next /= null
-                       or else I.Node = Container.Last);
-
       if I.Node = J.Node then
          return;
       end if;
 
-      pragma Assert (Container.Length >= 2);
-      pragma Assert (J.Node /= null);
-      pragma Assert (J.Node.Element /= null);
-      pragma Assert (J.Node.Prev = null
-                       or else J.Node.Prev.Next = J.Node);
-      pragma Assert (J.Node.Next = null
-                       or else J.Node.Next.Prev = J.Node);
-      pragma Assert (J.Node.Prev /= null
-                       or else J.Node = Container.First);
-      pragma Assert (J.Node.Next /= null
-                       or else J.Node = Container.Last);
-
       if Container.Busy > 0 then
          raise Program_Error;
       end if;
@@ -1878,45 +1583,179 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
      (Position : Cursor;
       Process  : not null access procedure (Element : in out Element_Type))
    is
-      pragma Assert (Position.Container /= null);
-      pragma Assert (Position.Container.Length > 0);
-      pragma Assert (Position.Container.First.Prev = null);
-      pragma Assert (Position.Container.Last.Next = null);
-
-      pragma Assert (Position.Node /= null);
-      pragma Assert (Position.Node.Element /= null);
-      pragma Assert (Position.Node.Prev = null
-                       or else Position.Node.Prev.Next = Position.Node);
-      pragma Assert (Position.Node.Next = null
-                       or else Position.Node.Next.Prev = Position.Node);
-      pragma Assert (Position.Node.Prev /= null
-                       or else Position.Node = Position.Container.First);
-      pragma Assert (Position.Node.Next /= null
-                       or else Position.Node = Position.Container.Last);
-
-      E : Element_Type renames Position.Node.Element.all;
-
-      C : List renames Position.Container.all'Unrestricted_Access.all;
-      B : Natural renames C.Busy;
-      L : Natural renames C.Lock;
-
    begin
-      B := B + 1;
-      L := L + 1;
+      pragma Assert (Vet (Position), "bad cursor in Update_Element");
+
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      declare
+         C : List renames Position.Container.all'Unrestricted_Access.all;
+         B : Natural renames C.Busy;
+         L : Natural renames C.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 Update_Element;
 
+   ---------
+   -- Vet --
+   ---------
+
+   function Vet (Position : Cursor) return Boolean is
+   begin
+      if Position.Node = null then
+         return Position.Container = null;
+      end if;
+
+      if Position.Container = null then
+         return False;
+      end if;
+
+      if Position.Node.Next = Position.Node then
+         return False;
+      end if;
+
+      if Position.Node.Prev = Position.Node then
+         return False;
+      end if;
+
+      if Position.Node.Element = null then
+         return False;
+      end if;
+
+      declare
+         L : List renames Position.Container.all;
+      begin
+         if L.Length = 0 then
+            return False;
+         end if;
+
+         if L.First = null then
+            return False;
+         end if;
+
+         if L.Last = null then
+            return False;
+         end if;
+
+         if L.First.Prev /= null then
+            return False;
+         end if;
+
+         if L.Last.Next /= null then
+            return False;
+         end if;
+
+         if Position.Node.Prev = null
+           and then Position.Node /= L.First
+         then
+            return False;
+         end if;
+
+         if Position.Node.Next = null
+           and then Position.Node /= L.Last
+         then
+            return False;
+         end if;
+
+         if L.Length = 1 then
+            return L.First = L.Last;
+         end if;
+
+         if L.First = L.Last then
+            return False;
+         end if;
+
+         if L.First.Next = null then
+            return False;
+         end if;
+
+         if L.Last.Prev = null then
+            return False;
+         end if;
+
+         if L.First.Next.Prev /= L.First then
+            return False;
+         end if;
+
+         if L.Last.Prev.Next /= L.Last then
+            return False;
+         end if;
+
+         if L.Length = 2 then
+            if L.First.Next /= L.Last then
+               return False;
+            end if;
+
+            if L.Last.Prev /= L.First then
+               return False;
+            end if;
+
+            return True;
+         end if;
+
+         if L.First.Next = L.Last then
+            return False;
+         end if;
+
+         if L.Last.Prev = L.First then
+            return False;
+         end if;
+
+         if Position.Node = L.First then
+            return True;
+         end if;
+
+         if Position.Node = L.Last then
+            return True;
+         end if;
+
+         if Position.Node.Next = null then
+            return False;
+         end if;
+
+         if Position.Node.Prev = null then
+            return False;
+         end if;
+
+         if Position.Node.Next.Prev /= Position.Node then
+            return False;
+         end if;
+
+         if Position.Node.Prev.Next /= Position.Node then
+            return False;
+         end if;
+
+         if L.Length = 3 then
+            if L.First.Next /= Position.Node then
+               return False;
+            end if;
+
+            if L.Last.Prev /= Position.Node then
+               return False;
+            end if;
+         end if;
+
+         return True;
+      end;
+   end Vet;
+
    -----------
    -- Write --
    -----------
@@ -1926,8 +1765,10 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
       Item   : List)
    is
       Node : Node_Access := Item.First;
+
    begin
       Count_Type'Base'Write (Stream, Item.Length);
+
       while Node /= null loop
          Element_Type'Output (Stream, Node.Element.all);  --  X.all
          Node := Node.Next;

gcc/ada/a-cihama.adb

@@ -194,19 +194,16 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
    procedure Delete (Container : in out Map; Position : in out Cursor) is
    begin
+      pragma Assert (Vet (Position), "bad cursor in Delete");
+
       if Position.Node = null then
          raise Constraint_Error;
-         return;
       end if;
 
-      if Position.Container /= Map_Access'(Container'Unchecked_Access) then
+      if Position.Container /= Container'Unrestricted_Access then
          raise Program_Error;
       end if;
 
-      pragma Assert (Position.Node.Next /= Position.Node);
-      pragma Assert (Position.Node.Key /= null);
-      pragma Assert (Position.Node.Element /= null);
-
       if Container.HT.Busy > 0 then
          raise Program_Error;
       end if;
@@ -222,14 +219,24 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
    -------------
 
    function Element (Container : Map; Key : Key_Type) return Element_Type is
-      C : constant Cursor := Find (Container, Key);
+      Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
+
    begin
-      return C.Node.Element.all;
+      if Node = null then
+         raise Constraint_Error;
+      end if;
+
+      return Node.Element.all;
    end Element;
 
    function Element (Position : Cursor) return Element_Type is
    begin
-      pragma Assert (Vet (Position));
+      pragma Assert (Vet (Position), "bad cursor in function Element");
+
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
       return Position.Node.Element.all;
    end Element;
 
@@ -251,8 +258,15 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
    function Equivalent_Keys (Left, Right : Cursor) return Boolean is
    begin
-      pragma Assert (Vet (Left));
-      pragma Assert (Vet (Right));
+      pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+      pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
+
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
       return Equivalent_Keys (Left.Node.Key.all, Right.Node.Key.all);
    end Equivalent_Keys;
 
@@ -261,7 +275,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       Right : Key_Type) return Boolean
    is
    begin
-      pragma Assert (Vet (Left));
+      pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
       return Equivalent_Keys (Left.Node.Key.all, Right);
    end Equivalent_Keys;
 
@@ -270,7 +289,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       Right : Cursor) return Boolean
    is
    begin
-      pragma Assert (Vet (Right));
+      pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
+
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
       return Equivalent_Keys (Left, Right.Node.Key.all);
    end Equivalent_Keys;
 
@@ -338,6 +362,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
    function First (Container : Map) return Cursor is
       Node : constant Node_Access := HT_Ops.First (Container.HT);
+
    begin
       if Node = null then
          return No_Element;
@@ -396,13 +421,8 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
    function Has_Element (Position : Cursor) return Boolean is
    begin
-      if Position.Node = null then
-         pragma Assert (Position.Container = null);
-         return False;
-      end if;
-
-      pragma Assert (Vet (Position));
-      return True;
+      pragma Assert (Vet (Position), "bad cursor in Has_Element");
+      return Position.Node /= null;
    end Has_Element;
 
    ---------------
@@ -468,7 +488,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
    is
       function New_Node (Next : Node_Access) return Node_Access;
 
-      procedure Insert is
+      procedure Local_Insert is
         new Key_Ops.Generic_Conditional_Insert (New_Node);
 
       --------------
@@ -478,6 +498,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       function New_Node (Next : Node_Access) return Node_Access is
          K  : Key_Access := new Key_Type'(Key);
          E  : Element_Access;
+
       begin
          E := new Element_Type'(New_Item);
          return new Node_Type'(K, E, Next);
@@ -493,12 +514,18 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
    --  Start of processing for Insert
 
    begin
-      if HT.Length >= HT_Ops.Capacity (HT) then
-         --  TODO: see note in a-cohama.adb.
-         HT_Ops.Reserve_Capacity (HT, HT.Length + 1);
+      if HT_Ops.Capacity (HT) = 0 then
+         HT_Ops.Reserve_Capacity (HT, 1);
+      end if;
+
+      Local_Insert (HT, Key, Position.Node, Inserted);
+
+      if Inserted
+        and then HT.Length > HT_Ops.Capacity (HT)
+      then
+         HT_Ops.Reserve_Capacity (HT, HT.Length);
       end if;
 
-      Insert (HT, Key, Position.Node, Inserted);
       Position.Container := Container'Unchecked_Access;
    end Insert;
 
@@ -562,7 +589,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
    function Key (Position : Cursor) return Key_Type is
    begin
-      pragma Assert (Vet (Position));
+      pragma Assert (Vet (Position), "bad cursor in function Key");
+
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
       return Position.Node.Key.all;
    end Key;
 
@@ -603,13 +635,13 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
    function Next (Position : Cursor) return Cursor is
    begin
+      pragma Assert (Vet (Position), "bad cursor in function Next");
+
       if Position.Node = null then
-         pragma Assert (Position.Container = null);
          return No_Element;
       end if;
 
       declare
-         pragma Assert (Vet (Position));
          HT   : Hash_Table_Type renames Position.Container.HT;
          Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
 
@@ -631,32 +663,40 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       Process  : not null access procedure (Key     : Key_Type;
                                             Element : Element_Type))
    is
-      pragma Assert (Vet (Position));
-
-      K : Key_Type renames Position.Node.Key.all;
-      E : Element_Type renames Position.Node.Element.all;
+   begin
+      pragma Assert (Vet (Position), "bad cursor in Query_Element");
 
-      M  : Map renames Position.Container.all;
-      HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
-      B : Natural renames HT.Busy;
-      L : Natural renames HT.Lock;
+      declare
+         M  : Map renames Position.Container.all;
+         HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
 
-   begin
-      B := B + 1;
-      L := L + 1;
+         B : Natural renames HT.Busy;
+         L : Natural renames HT.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;
 
    ----------
@@ -748,15 +788,24 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
    ---------------------
 
    procedure Replace_Element (Position : Cursor; By : Element_Type) is
-      pragma Assert (Vet (Position));
-      X : Element_Access := Position.Node.Element;
    begin
+      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
+
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
       if Position.Container.HT.Lock > 0 then
          raise Program_Error;
       end if;
 
-      Position.Node.Element := new Element_Type'(By);
-      Free_Element (X);
+      declare
+         X : Element_Access := Position.Node.Element;
+
+      begin
+         Position.Node.Element := new Element_Type'(By);
+         Free_Element (X);
+      end;
    end Replace_Element;
 
    ----------------------
@@ -789,32 +838,40 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       Process  : not null access procedure (Key     : Key_Type;
                                             Element : in out Element_Type))
    is
-      pragma Assert (Vet (Position));
+   begin
+      pragma Assert (Vet (Position), "bad cursor in Update_Element");
 
-      K : Key_Type renames Position.Node.Key.all;
-      E : Element_Type renames Position.Node.Element.all;
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
-      M  : Map renames Position.Container.all;
-      HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
+      declare
+         M  : Map renames Position.Container.all;
+         HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
 
-      B : Natural renames HT.Busy;
-      L : Natural renames HT.Lock;
-
-   begin
-      B := B + 1;
-      L := L + 1;
+         B : Natural renames HT.Busy;
+         L : Natural renames HT.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;
 
    ---------
@@ -824,6 +881,10 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
    function Vet (Position : Cursor) return Boolean is
    begin
       if Position.Node = null then
+         return Position.Container = null;
+      end if;
+
+      if Position.Container = null then
          return False;
       end if;
 
@@ -842,12 +903,15 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       declare
          HT : Hash_Table_Type renames Position.Container.HT;
          X  : Node_Access;
+
       begin
          if HT.Length = 0 then
             return False;
          end if;
 
-         if HT.Buckets = null then
+         if HT.Buckets = null
+           or else HT.Buckets'Length = 0
+         then
             return False;
          end if;
 
@@ -862,7 +926,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
                return False;
             end if;
 
-            if X = X.Next then -- weird
+            if X = X.Next then -- to prevent endless loop
                return False;
             end if;
 

gcc/ada/a-cihase.adb

@@ -84,13 +84,15 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
    pragma Inline (Read_Node);
 
    procedure Replace_Element
-     (HT      : in out Hash_Table_Type;
-      Node    : Node_Access;
-      Element : Element_Type);
+     (HT       : in out Hash_Table_Type;
+      Node     : Node_Access;
+      New_Item : Element_Type);
 
    procedure Set_Next (Node : Node_Access; Next : Node_Access);
    pragma Inline (Set_Next);
 
+   function Vet (Position : Cursor) return Boolean;
+
    procedure Write_Node
      (Stream : access Root_Stream_Type'Class;
       Node   : Node_Access);
@@ -217,11 +219,17 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       Position  : in out Cursor)
    is
    begin
+      pragma Assert (Vet (Position), "bad cursor in Delete");
+
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
-      if Position.Container /= Set_Access'(Container'Unchecked_Access) then
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
+
+      if Position.Container /= Container'Unrestricted_Access then
          raise Program_Error;
       end if;
 
@@ -232,7 +240,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
 
       Free (Position.Node);
-
       Position.Container := null;
    end Delete;
 
@@ -351,6 +358,16 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
    function Element (Position : Cursor) return Element_Type is
    begin
+      pragma Assert (Vet (Position), "bad cursor in function Element");
+
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Position.Node.Element = null then  --  handle dangling reference
+         raise Program_Error;
+      end if;
+
       return Position.Node.Element.all;
    end Element;
 
@@ -370,6 +387,21 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
    function Equivalent_Elements (Left, Right : Cursor)
      return Boolean is
    begin
+      pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+      pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
+
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
+      if Left.Node.Element = null  --  handle dangling cursor reference
+        or else Right.Node.Element = null
+      then
+         raise Program_Error;
+      end if;
+
       return Equivalent_Elements
                (Left.Node.Element.all,
                 Right.Node.Element.all);
@@ -378,12 +410,32 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
    function Equivalent_Elements (Left : Cursor; Right : Element_Type)
      return Boolean is
    begin
+      pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Left.Node.Element = null then  --  handling dangling reference
+         raise Program_Error;
+      end if;
+
       return Equivalent_Elements (Left.Node.Element.all, Right);
    end Equivalent_Elements;
 
    function Equivalent_Elements (Left : Element_Type; Right : Cursor)
      return Boolean is
    begin
+      pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
+
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
+      if Right.Node.Element = null then  --  handle dangling cursor reference
+         raise Program_Error;
+      end if;
+
       return Equivalent_Elements (Left, Right.Node.Element.all);
    end Equivalent_Elements;
 
@@ -520,6 +572,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          return;
       end if;
 
+      X.Next := X;  --  detect mischief (in Vet)
+
       begin
          Free_Element (X.Element);
       exception
@@ -538,12 +592,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
    function Has_Element (Position : Cursor) return Boolean is
    begin
-      if Position.Node = null then
-         pragma Assert (Position.Container = null);
-         return False;
-      end if;
-
-      return True;
+      pragma Assert (Vet (Position), "bad cursor in Has_Element");
+      return Position.Node /= null;
    end Has_Element;
 
    ---------------
@@ -597,7 +647,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       function New_Node (Next : Node_Access) return Node_Access;
       pragma Inline (New_Node);
 
-      procedure Insert is
+      procedure Local_Insert is
          new Element_Keys.Generic_Conditional_Insert (New_Node);
 
       --------------
@@ -620,12 +670,18 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
    --  Start of processing for Insert
 
    begin
-      if HT.Length >= HT_Ops.Capacity (HT) then
-         --  TODO: optimize this (see a-cohase.adb)
-         HT_Ops.Reserve_Capacity (HT, HT.Length + 1);
+      if HT_Ops.Capacity (HT) = 0 then
+         HT_Ops.Reserve_Capacity (HT, 1);
+      end if;
+
+      Local_Insert (HT, New_Item, Position.Node, Inserted);
+
+      if Inserted
+        and then HT.Length > HT_Ops.Capacity (HT)
+      then
+         HT_Ops.Reserve_Capacity (HT, HT.Length);
       end if;
 
-      Insert (HT, New_Item, Position.Node, Inserted);
       Position.Container := Container'Unchecked_Access;
    end Insert;
 
@@ -763,7 +819,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
    function Is_Empty (Container : Set) return Boolean is
    begin
-      return Container.Length = 0;
+      return Container.HT.Length = 0;
    end Is_Empty;
 
    -----------
@@ -833,22 +889,14 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       end Process_Node;
 
       HT : Hash_Table_Type renames Container'Unrestricted_Access.all.HT;
-      B  : Natural renames HT.Busy;
 
    --  Start of processing for Iterate
 
    begin
-      B := B + 1;
-
-      begin
-         Iterate (HT);
-      exception
-         when others =>
-            B := B - 1;
-            raise;
-      end;
+      --  TODO: resolve whether HT_Ops.Generic_Iteration should
+      --  manipulate busy bit.
 
-      B := B - 1;
+      Iterate (HT);
    end Iterate;
 
    ------------
@@ -880,11 +928,16 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
    function Next (Position : Cursor) return Cursor is
    begin
+      pragma Assert (Vet (Position), "bad cursor in function Next");
+
       if Position.Node = null then
-         pragma Assert (Position.Container = null);
          return No_Element;
       end if;
 
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
+
       declare
          HT   : Hash_Table_Type renames Position.Container.HT;
          Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
@@ -939,29 +992,40 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
      (Position : Cursor;
       Process  : not null access procedure (Element : Element_Type))
    is
-      E : Element_Type renames Position.Node.Element.all;
+   begin
+      pragma Assert (Vet (Position), "bad cursor in Query_Element");
 
-      HT : Hash_Table_Type renames
-             Position.Container'Unrestricted_Access.all.HT;
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
-      B : Natural renames HT.Busy;
-      L : Natural renames HT.Lock;
+      if Position.Node.Element = null then
+         raise Program_Error;
+      end if;
 
-   begin
-      B := B + 1;
-      L := L + 1;
+      declare
+         HT : Hash_Table_Type renames
+                Position.Container'Unrestricted_Access.all.HT;
+
+         B : Natural renames HT.Busy;
+         L : Natural renames HT.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;
 
    ----------
@@ -1027,13 +1091,13 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
    ---------------------
 
    procedure Replace_Element
-     (HT      : in out Hash_Table_Type;
-      Node    : Node_Access;
-      Element : Element_Type)
+     (HT       : in out Hash_Table_Type;
+      Node     : Node_Access;
+      New_Item : Element_Type)
    is
    begin
-      if Equivalent_Elements (Node.Element.all, Element) then
-         pragma Assert (Hash (Node.Element.all) = Hash (Element));
+      if Equivalent_Elements (Node.Element.all, New_Item) then
+         pragma Assert (Hash (Node.Element.all) = Hash (New_Item));
 
          if HT.Lock > 0 then
             raise Program_Error;
@@ -1042,7 +1106,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          declare
             X : Element_Access := Node.Element;
          begin
-            Node.Element := new Element_Type'(Element);  --  OK if fails
+            Node.Element := new Element_Type'(New_Item);  --  OK if fails
             Free_Element (X);
          end;
 
@@ -1068,7 +1132,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
          function New_Node (Next : Node_Access) return Node_Access is
          begin
-            Node.Element := new Element_Type'(Element);  -- OK if fails
+            Node.Element := new Element_Type'(New_Item);  -- OK if fails
             Node.Next := Next;
             return Node;
          end New_Node;
@@ -1084,7 +1148,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          Attempt_Insert : begin
             Insert
               (HT       => HT,
-               Key      => Element,
+               Key      => New_Item,
                Node     => Result,
                Inserted => Inserted);
          exception
@@ -1093,7 +1157,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          end Attempt_Insert;
 
          if Inserted then
-            pragma Assert (Result = Node);
             Free_Element (X);  -- Just propagate if fails
             return;
          end if;
@@ -1137,22 +1200,26 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
    end Replace_Element;
 
    procedure Replace_Element
-     (Container : Set;
+     (Container : in out Set;
       Position  : Cursor;
-      By        : Element_Type)
+      New_Item  : Element_Type)
    is
-      HT : Hash_Table_Type renames Container'Unrestricted_Access.all.HT;
-
    begin
+      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
+
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
-      if Position.Container /= Set_Access'(Container'Unrestricted_Access) then
+      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 (HT, Position.Node, By);
+      Replace_Element (Container.HT, Position.Node, New_Item);
    end Replace_Element;
 
    ----------------------
@@ -1613,6 +1680,65 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       return (Controlled with HT => (Buckets, Length, 0, 0));
    end Union;
 
+   ---------
+   -- Vet --
+   ---------
+
+   function Vet (Position : Cursor) return Boolean is
+   begin
+      if Position.Node = null then
+         return Position.Container = null;
+      end if;
+
+      if Position.Container = null then
+         return False;
+      end if;
+
+      if Position.Node.Next = Position.Node then
+         return False;
+      end if;
+
+      if Position.Node.Element = null then
+         return False;
+      end if;
+
+      declare
+         HT : Hash_Table_Type renames Position.Container.HT;
+         X  : Node_Access;
+
+      begin
+         if HT.Length = 0 then
+            return False;
+         end if;
+
+         if HT.Buckets = null
+           or else HT.Buckets'Length = 0
+         then
+            return False;
+         end if;
+
+         X := HT.Buckets (Element_Keys.Index (HT, Position.Node.Element.all));
+
+         for J in 1 .. HT.Length loop
+            if X = Position.Node then
+               return True;
+            end if;
+
+            if X = null then
+               return False;
+            end if;
+
+            if X = X.Next then  --  to prevent unnecessary looping
+               return False;
+            end if;
+
+            X := X.Next;
+         end loop;
+
+         return False;
+      end;
+   end Vet;
+
    -----------
    -- Write --
    -----------
@@ -1714,29 +1840,9 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
         (Key  : Key_Type;
          Node : Node_Access) return Boolean is
       begin
-         return Equivalent_Keys (Key, Node.Element.all);
+         return Equivalent_Keys (Key, Generic_Keys.Key (Node.Element.all));
       end Equivalent_Key_Node;
 
-      ---------------------
-      -- Equivalent_Keys --
-      ---------------------
-
-      function Equivalent_Keys
-        (Left  : Cursor;
-         Right : Key_Type) return Boolean
-      is
-      begin
-         return Equivalent_Keys (Right, Left.Node.Element.all);
-      end Equivalent_Keys;
-
-      function Equivalent_Keys
-        (Left  : Key_Type;
-         Right : Cursor) return Boolean
-      is
-      begin
-         return Equivalent_Keys (Left, Right.Node.Element.all);
-      end Equivalent_Keys;
-
       -------------
       -- Exclude --
       -------------
@@ -1775,6 +1881,16 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
       function Key (Position : Cursor) return Key_Type is
       begin
+         pragma Assert (Vet (Position), "bad cursor in function Key");
+
+         if Position.Node = null then
+            raise Constraint_Error;
+         end if;
+
+         if Position.Node.Element = null then
+            raise Program_Error;
+         end if;
+
          return Key (Position.Node.Element.all);
       end Key;
 
@@ -1804,20 +1920,40 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          Process   : not null access
            procedure (Element : in out Element_Type))
       is
-         HT : Hash_Table_Type renames Container.HT;
+         HT   : Hash_Table_Type renames Container.HT;
+         Indx : Hash_Type;
 
       begin
+         pragma Assert
+           (Vet (Position),
+            "bad cursor in Update_Element_Preserving_Key");
+
          if Position.Node = null then
             raise Constraint_Error;
          end if;
 
-         if Position.Container /= Set_Access'(Container'Unchecked_Access) then
+         if Position.Node.Element = null
+           or else Position.Node.Next = Position.Node
+         then
             raise Program_Error;
          end if;
 
+         if Position.Container /= Container'Unrestricted_Access then
+            raise Program_Error;
+         end if;
+
+         if HT.Buckets = null
+           or else HT.Buckets'Length = 0
+           or else HT.Length = 0
+         then
+            raise Program_Error;
+         end if;
+
+         Indx := HT_Ops.Index (HT, Position.Node);
+
          declare
             E : Element_Type renames Position.Node.Element.all;
-            K : Key_Type renames Key (E);
+            K : constant Key_Type := Key (E);
 
             B : Natural renames HT.Busy;
             L : Natural renames HT.Lock;
@@ -1838,16 +1974,38 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
             L := L - 1;
             B := B - 1;
 
-            if Equivalent_Keys (K, E) then
+            if Equivalent_Keys (K, Key (E)) then
                pragma Assert (Hash (K) = Hash (E));
                return;
             end if;
          end;
 
+         if HT.Buckets (Indx) = Position.Node then
+            HT.Buckets (Indx) := Position.Node.Next;
+
+         else
+            declare
+               Prev : Node_Access := HT.Buckets (Indx);
+
+            begin
+               while Prev.Next /= Position.Node loop
+                  Prev := Prev.Next;
+
+                  if Prev = null then
+                     raise Program_Error;
+                  end if;
+               end loop;
+
+               Prev.Next := Position.Node.Next;
+            end;
+         end if;
+
+         HT.Length := HT.Length - 1;
+
          declare
             X : Node_Access := Position.Node;
+
          begin
-            HT_Ops.Delete_Node_Sans_Free (HT, X);
             Free (X);
          end;
 

gcc/ada/a-cihase.ads

@@ -49,8 +49,7 @@ generic
    with function "=" (Left, Right : Element_Type) return Boolean is <>;
 
 package Ada.Containers.Indefinite_Hashed_Sets is
-
-   pragma Preelaborate (Indefinite_Hashed_Sets);
+   pragma Preelaborate;
 
    type Set is tagged private;
 
@@ -64,6 +63,12 @@ package Ada.Containers.Indefinite_Hashed_Sets is
 
    function Equivalent_Sets (Left, Right : Set) return Boolean;
 
+   function Capacity (Container : Set) return Count_Type;
+
+   procedure Reserve_Capacity
+     (Container : in out Set;
+      Capacity  : Count_Type);
+
    function Length (Container : Set) return Count_Type;
 
    function Is_Empty (Container : Set) return Boolean;
@@ -72,15 +77,15 @@ package Ada.Containers.Indefinite_Hashed_Sets 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);
@@ -97,37 +102,11 @@ package Ada.Containers.Indefinite_Hashed_Sets is
 
    procedure Replace (Container : in out Set; New_Item : Element_Type);
 
-   procedure Delete  (Container : in out Set; Item : Element_Type);
-
-   procedure Delete (Container : in out Set; Position  : in out Cursor);
-
    procedure Exclude (Container : in out Set; Item : Element_Type);
 
-   function Contains (Container : Set; Item : Element_Type) return Boolean;
-
-   function Find (Container : Set; Item : Element_Type) return Cursor;
-
-   function First (Container : Set) return Cursor;
-
-   function Next (Position : Cursor) return Cursor;
-
-   procedure Next (Position : in out Cursor);
-
-   function Has_Element (Position : Cursor) return Boolean;
-
-   function Equivalent_Elements (Left, Right : Cursor) return Boolean;
-
-   function Equivalent_Elements
-     (Left  : Cursor;
-      Right : Element_Type) return Boolean;
-
-   function Equivalent_Elements
-     (Left  : Element_Type;
-      Right : Cursor) return Boolean;
+   procedure Delete  (Container : in out Set; Item : Element_Type);
 
-   procedure Iterate
-     (Container : Set;
-      Process   : not null access procedure (Position : Cursor));
+   procedure Delete (Container : in out Set; Position  : in out Cursor);
 
    procedure Union (Target : in out Set; Source : Set);
 
@@ -158,41 +137,59 @@ package Ada.Containers.Indefinite_Hashed_Sets is
 
    function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
 
-   function Capacity (Container : Set) return Count_Type;
+   function First (Container : Set) return Cursor;
 
-   procedure Reserve_Capacity
-     (Container : in out Set;
-      Capacity  : Count_Type);
+   function Next (Position : Cursor) return Cursor;
+
+   procedure Next (Position : in out Cursor);
+
+   function Find (Container : Set; Item : Element_Type) return Cursor;
+
+   function Contains (Container : Set; Item : Element_Type) return Boolean;
+
+   function Has_Element (Position : Cursor) return Boolean;
+
+   function Equivalent_Elements (Left, Right : Cursor) return Boolean;
+
+   function Equivalent_Elements
+     (Left  : Cursor;
+      Right : Element_Type) return Boolean;
+
+   function Equivalent_Elements
+     (Left  : Element_Type;
+      Right : Cursor) return Boolean;
+
+   procedure Iterate
+     (Container : Set;
+      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 Hash (Key : Key_Type) return Hash_Type;
 
-      with function Equivalent_Keys
-        (Key     : Key_Type;
-         Element : Element_Type) return Boolean;
+      with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
 
    package Generic_Keys is
 
-      function Contains (Container : Set; Key : Key_Type) return Boolean;
-
-      function Find (Container : Set; Key : Key_Type) return Cursor;
-
       function Key (Position : Cursor) return Key_Type;
 
       function Element (Container : Set; Key : Key_Type) return Element_Type;
 
-      procedure Replace
+      procedure Replace           -- TODO: ask Randy why this is still here
         (Container : in out Set;
          Key       : Key_Type;
          New_Item  : Element_Type);
 
+      procedure Exclude (Container : in out Set; Key : Key_Type);
+
       procedure Delete (Container : in out Set; Key : Key_Type);
 
-      procedure Exclude (Container : in out Set; Key : Key_Type);
+      function Find (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;
@@ -200,13 +197,6 @@ package Ada.Containers.Indefinite_Hashed_Sets is
          Process   : not null access
                        procedure (Element : in out Element_Type));
 
-      function Equivalent_Keys
-        (Left  : Cursor;
-         Right : Key_Type) return Boolean;
-
-      function Equivalent_Keys
-        (Left  : Key_Type;
-         Right : Cursor) return Boolean;
    end Generic_Keys;
 
 private

gcc/ada/a-ciorse.adb

@@ -369,6 +369,21 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       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 --
    ---------------------
@@ -528,34 +543,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets 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 --
       -------------
@@ -609,6 +596,21 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          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 --
       -------------
@@ -663,7 +665,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
         (Left  : Key_Type;
          Right : Node_Access) return Boolean is
       begin
-         return Left > Right.Element.all;
+         return Key (Right.Element.all) < Left;
       end Is_Greater_Key_Node;
 
       ----------------------
@@ -674,7 +676,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
         (Left  : Key_Type;
          Right : Node_Access) return Boolean is
       begin
-         return Left < Right.Element.all;
+         return Left < Key (Right.Element.all);
       end Is_Less_Key_Node;
 
       ---------
@@ -728,7 +730,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
          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;
@@ -749,11 +751,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
             L := L - 1;
             B := B - 1;
 
-            if K < E
-              or else K > E
-            then
-               null;
-            else
+            if Equivalent_Keys (K, Key (E)) then
                return;
             end if;
          end;
@@ -1365,12 +1363,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets 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;
@@ -1380,7 +1376,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          raise Program_Error;
       end if;
 
-      Replace_Element (Tree, Position.Node, By);
+      Replace_Element (Container.Tree, Position.Node, New_Item);
    end Replace_Element;
 
    ---------------------

gcc/ada/a-ciorse.ads

@@ -45,7 +45,9 @@ generic
    with function "=" (Left, Right : Element_Type) return Boolean is <>;
 
 package Ada.Containers.Indefinite_Ordered_Sets is
-pragma Preelaborate (Indefinite_Ordered_Sets);
+   pragma Preelaborate;
+
+   function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
 
    type Set is tagged private;
 
@@ -67,15 +69,15 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
 
    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;   --  TODO: need ruling from ARG
-      Position  : Cursor;
-      By        : Element_Type);
-
    procedure Move (Target : in out Set; Source : in out Set);
 
    procedure Insert
@@ -96,6 +98,10 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
      (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);
@@ -108,10 +114,6 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
 
    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;
@@ -124,8 +126,7 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
 
    function "and" (Left, Right : Set) return Set renames Intersection;
 
-   procedure Difference (Target : in out Set;
-                         Source : Set);
+   procedure Difference (Target : in out Set; Source : Set);
 
    function Difference (Left, Right : Set) return Set;
 
@@ -141,14 +142,6 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
 
    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;
@@ -165,6 +158,14 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
 
    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;
@@ -188,21 +189,28 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
       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 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 Replace
+        (Container : in out Set;
+         Key       : Key_Type;
+         New_Item  : Element_Type);
+
+      procedure Exclude (Container : in out Set; Key : Key_Type);
+
+      procedure Delete (Container : in out Set; Key : Key_Type);
 
       function Find
         (Container : Set;
@@ -216,28 +224,9 @@ pragma Preelaborate (Indefinite_Ordered_Sets);
         (Container : Set;
          Key       : Key_Type) return Cursor;
 
-      function Key (Position : Cursor) return Key_Type;
-
-      function Element
+      function Contains
         (Container : Set;
-         Key       : Key_Type) return Element_Type;
-
-      procedure Replace
-        (Container : in out Set;  --  TODO: need ruling from ARG
-         Key       : Key_Type;
-         New_Item  : 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;
-
-      function ">" (Left : Cursor; Right : Key_Type) return Boolean;
-
-      function "<" (Left : Key_Type; Right : Cursor) return Boolean;
-
-      function ">" (Left : Key_Type; Right : Cursor) return Boolean;
+         Key       : Key_Type) return Boolean;
 
       procedure Update_Element_Preserving_Key
         (Container : in out Set;

gcc/ada/a-cohama.adb

@@ -188,16 +188,16 @@ package body Ada.Containers.Hashed_Maps is
 
    procedure Delete (Container : in out Map; Position : in out Cursor) is
    begin
+      pragma Assert (Vet (Position), "bad cursor in Delete");
+
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
-      if Position.Container /= Map_Access'(Container'Unchecked_Access) then
+      if Position.Container /= Container'Unrestricted_Access then
          raise Program_Error;
       end if;
 
-      pragma Assert (Position.Node.Next /= Position.Node);
-
       if Container.HT.Busy > 0 then
          raise Program_Error;
       end if;
@@ -213,14 +213,24 @@ package body Ada.Containers.Hashed_Maps is
    -------------
 
    function Element (Container : Map; Key : Key_Type) return Element_Type is
-      C : constant Cursor := Find (Container, Key);
+      Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
+
    begin
-      return C.Node.Element;
+      if Node = null then
+         raise Constraint_Error;
+      end if;
+
+      return Node.Element;
    end Element;
 
    function Element (Position : Cursor) return Element_Type is
    begin
-      pragma Assert (Vet (Position));
+      pragma Assert (Vet (Position), "bad cursor in function Element");
+
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
       return Position.Node.Element;
    end Element;
 
@@ -242,20 +252,37 @@ package body Ada.Containers.Hashed_Maps is
    function Equivalent_Keys (Left, Right : Cursor)
      return Boolean is
    begin
-      pragma Assert (Vet (Left));
-      pragma Assert (Vet (Right));
+      pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+      pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
+
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
       return Equivalent_Keys (Left.Node.Key, Right.Node.Key);
    end Equivalent_Keys;
 
    function Equivalent_Keys (Left : Cursor; Right : Key_Type) return Boolean is
    begin
-      pragma Assert (Vet (Left));
+      pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
       return Equivalent_Keys (Left.Node.Key, Right);
    end Equivalent_Keys;
 
    function Equivalent_Keys (Left : Key_Type; Right : Cursor) return Boolean is
    begin
-      pragma Assert (Vet (Right));
+      pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
+
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
       return Equivalent_Keys (Left, Right.Node.Key);
    end Equivalent_Keys;
 
@@ -352,13 +379,8 @@ package body Ada.Containers.Hashed_Maps is
 
    function Has_Element (Position : Cursor) return Boolean is
    begin
-      if Position.Node = null then
-         pragma Assert (Position.Container = null);
-         return False;
-      end if;
-
-      pragma Assert (Vet (Position));
-      return True;
+      pragma Assert (Vet (Position), "bad cursor in Has_Element");
+      return Position.Node /= null;
    end Has_Element;
 
    ---------------
@@ -435,25 +457,18 @@ package body Ada.Containers.Hashed_Maps is
    --  Start of processing for Insert
 
    begin
-      if HT.Length >= HT_Ops.Capacity (HT) then
+      if HT_Ops.Capacity (HT) = 0 then
+         HT_Ops.Reserve_Capacity (HT, 1);
+      end if;
 
-         --  TODO: 17 Apr 2005
-         --  We should defer the expansion until we're sure that the
-         --  element was successfully inserted.  We can do that by
-         --  first performing the insertion attempt, and allowing the
-         --  invariant len <= cap to be violated temporarily.  After
-         --  the insertion we can restore the invariant.  The
-         --  worst that can happen is that the insertion succeeds
-         --  (new element is added to the map), but the
-         --  invariant is broken (len > cap).  But it's only
-         --  broken by a little (since len = cap + 1), so the
-         --  effect is benign.
-         --  END TODO.
+      Local_Insert (HT, Key, Position.Node, Inserted);
 
-         HT_Ops.Reserve_Capacity (HT, HT.Length + 1);
+      if Inserted
+        and then HT.Length > HT_Ops.Capacity (HT)
+      then
+         HT_Ops.Reserve_Capacity (HT, HT.Length);
       end if;
 
-      Local_Insert (HT, Key, Position.Node, Inserted);
       Position.Container := Container'Unchecked_Access;
    end Insert;
 
@@ -485,12 +500,18 @@ package body Ada.Containers.Hashed_Maps is
    --  Start of processing for Insert
 
    begin
-      if HT.Length >= HT_Ops.Capacity (HT) then
-         --  TODO: see note above.
-         HT_Ops.Reserve_Capacity (HT, HT.Length + 1);
+      if HT_Ops.Capacity (HT) = 0 then
+         HT_Ops.Reserve_Capacity (HT, 1);
       end if;
 
       Local_Insert (HT, Key, Position.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;
 
@@ -553,7 +574,12 @@ package body Ada.Containers.Hashed_Maps is
 
    function Key (Position : Cursor) return Key_Type is
    begin
-      pragma Assert (Vet (Position));
+      pragma Assert (Vet (Position), "bad cursor in function Key");
+
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
       return Position.Node.Key;
    end Key;
 
@@ -589,16 +615,15 @@ package body Ada.Containers.Hashed_Maps is
 
    function Next (Position : Cursor) return Cursor is
    begin
+      pragma Assert (Vet (Position), "bad cursor in function Next");
+
       if Position.Node = null then
-         pragma Assert (Position.Container = null);
          return No_Element;
       end if;
 
       declare
-         pragma Assert (Vet (Position));
          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;
@@ -621,34 +646,41 @@ package body Ada.Containers.Hashed_Maps is
      (Position : Cursor;
       Process  : not null access
                    procedure (Key : Key_Type; Element : Element_Type))
-
    is
-      pragma Assert (Vet (Position));
-
-      K : Key_Type renames Position.Node.Key;
-      E : Element_Type renames Position.Node.Element;
+   begin
+      pragma Assert (Vet (Position), "bad cursor in Query_Element");
 
-      M  : Map renames Position.Container.all;
-      HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
-      B : Natural renames HT.Busy;
-      L : Natural renames HT.Lock;
+      declare
+         M  : Map renames Position.Container.all;
+         HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
 
-   begin
-      B := B + 1;
-      L := L + 1;
+         B : Natural renames HT.Busy;
+         L : Natural renames HT.Lock;
 
       begin
-         Process (K, E);
-      exception
-         when others =>
-            L := L - 1;
-            B := B - 1;
-            raise;
+         B := B + 1;
+         L := L + 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;
-
-      L := L - 1;
-      B := B - 1;
    end Query_Element;
 
    ----------
@@ -712,15 +744,18 @@ package body Ada.Containers.Hashed_Maps is
    ---------------------
 
    procedure Replace_Element (Position : Cursor; By : Element_Type) is
-      pragma Assert (Vet (Position));
-      E : Element_Type renames Position.Node.Element;
-
    begin
+      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
+
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
       if Position.Container.HT.Lock > 0 then
          raise Program_Error;
       end if;
 
-      E := By;
+      Position.Node.Element := By;
    end Replace_Element;
 
    ----------------------
@@ -753,32 +788,40 @@ package body Ada.Containers.Hashed_Maps is
       Process  : not null access procedure (Key     : Key_Type;
                                             Element : in out Element_Type))
    is
-      pragma Assert (Vet (Position));
-
-      K : Key_Type renames Position.Node.Key;
-      E : Element_Type renames Position.Node.Element;
+   begin
+      pragma Assert (Vet (Position), "bad cursor in Update_Element");
 
-      M  : Map renames Position.Container.all;
-      HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
-      B : Natural renames HT.Busy;
-      L : Natural renames HT.Lock;
+      declare
+         M  : Map renames Position.Container.all;
+         HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
 
-   begin
-      B := B + 1;
-      L := L + 1;
+         B : Natural renames HT.Busy;
+         L : Natural renames HT.Lock;
 
       begin
-         Process (K, E);
-      exception
-         when others =>
-            L := L - 1;
-            B := B - 1;
-            raise;
+         B := B + 1;
+         L := L + 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;
-
-      L := L - 1;
-      B := B - 1;
    end Update_Element;
 
    ---------
@@ -788,34 +831,32 @@ package body Ada.Containers.Hashed_Maps is
    function Vet (Position : Cursor) return Boolean is
    begin
       if Position.Node = null then
-         return False;
+         return Position.Container = null;
       end if;
 
-      if Position.Node.Next = Position.Node then
+      if Position.Container = null then
          return False;
       end if;
 
-      if Position.Container = null then
+      if Position.Node.Next = Position.Node then
          return False;
       end if;
 
       declare
          HT : Hash_Table_Type renames Position.Container.HT;
          X  : Node_Access;
+
       begin
          if HT.Length = 0 then
             return False;
          end if;
 
-         if HT.Buckets = null then
+         if HT.Buckets = null
+           or else HT.Buckets'Length = 0
+         then
             return False;
          end if;
 
---       NOTE: see notes in Insert.
---       if HT.Length > HT.Buckets'Length then
---          return False;
---       end if;
-
          X := HT.Buckets (Key_Ops.Index (HT, Position.Node.Key));
 
          for J in 1 .. HT.Length loop
@@ -827,7 +868,7 @@ package body Ada.Containers.Hashed_Maps is
                return False;
             end if;
 
-            if X = X.Next then  --  weird
+            if X = X.Next then  --  to prevent endless loop
                return False;
             end if;
 

gcc/ada/a-cohase.adb

@@ -67,6 +67,8 @@ package body Ada.Containers.Hashed_Sets is
      (R_HT   : Hash_Table_Type;
       L_Node : Node_Access) return Boolean;
 
+   procedure Free (X : in out Node_Access);
+
    function Hash_Node (Node : Node_Access) return Hash_Type;
    pragma Inline (Hash_Node);
 
@@ -83,13 +85,15 @@ package body Ada.Containers.Hashed_Sets is
    pragma Inline (Read_Node);
 
    procedure Replace_Element
-     (HT      : in out Hash_Table_Type;
-      Node    : Node_Access;
-      Element : Element_Type);
+     (HT       : in out Hash_Table_Type;
+      Node     : Node_Access;
+      New_Item : Element_Type);
 
    procedure Set_Next (Node : Node_Access; Next : Node_Access);
    pragma Inline (Set_Next);
 
+   function Vet (Position : Cursor) return Boolean;
+
    procedure Write_Node
      (Stream : access Root_Stream_Type'Class;
       Node   : Node_Access);
@@ -99,9 +103,6 @@ package body Ada.Containers.Hashed_Sets is
    -- Local Instantiations --
    --------------------------
 
-   procedure Free is
-      new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
-
    package HT_Ops is
       new Hash_Tables.Generic_Operations
        (HT_Types  => HT_Types,
@@ -211,11 +212,13 @@ package body Ada.Containers.Hashed_Sets is
       Position  : in out Cursor)
    is
    begin
+      pragma Assert (Vet (Position), "bad cursor in Delete");
+
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
-      if Position.Container /= Set_Access'(Container'Unchecked_Access) then
+      if Position.Container /= Container'Unrestricted_Access then
          raise Program_Error;
       end if;
 
@@ -226,7 +229,6 @@ package body Ada.Containers.Hashed_Sets is
       HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
 
       Free (Position.Node);
-
       Position.Container := null;
    end Delete;
 
@@ -345,6 +347,12 @@ package body Ada.Containers.Hashed_Sets is
 
    function Element (Position : Cursor) return Element_Type is
    begin
+      pragma Assert (Vet (Position), "bad cursor in function Element");
+
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
+
       return Position.Node.Element;
    end Element;
 
@@ -364,18 +372,39 @@ package body Ada.Containers.Hashed_Sets is
    function Equivalent_Elements (Left, Right : Cursor)
      return Boolean is
    begin
+      pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+      pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
+
+      if Left.Node = null
+        or else Right.Node = null
+      then
+         raise Constraint_Error;
+      end if;
+
       return Equivalent_Elements (Left.Node.Element, Right.Node.Element);
    end Equivalent_Elements;
 
    function Equivalent_Elements (Left : Cursor; Right : Element_Type)
      return Boolean is
    begin
+      pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+
+      if Left.Node = null then
+         raise Constraint_Error;
+      end if;
+
       return Equivalent_Elements (Left.Node.Element, Right);
    end Equivalent_Elements;
 
    function Equivalent_Elements (Left : Element_Type; Right : Cursor)
      return Boolean is
    begin
+      pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
+
+      if Right.Node = null then
+         raise Constraint_Error;
+      end if;
+
       return Equivalent_Elements (Left, Right.Node.Element);
    end Equivalent_Elements;
 
@@ -499,18 +528,29 @@ package body Ada.Containers.Hashed_Sets is
       return Cursor'(Container'Unrestricted_Access, Node);
    end First;
 
+   ----------
+   -- 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.Next := X;     --  detect mischief (in Vet)
+         Deallocate (X);
+      end if;
+   end Free;
+
    -----------------
    -- Has_Element --
    -----------------
 
    function Has_Element (Position : Cursor) return Boolean is
    begin
-      if Position.Node = null then
-         pragma Assert (Position.Container = null);
-         return False;
-      end if;
-
-      return True;
+      pragma Assert (Vet (Position), "bad cursor in Has_Element");
+      return Position.Node /= null;
    end Has_Element;
 
    ---------------
@@ -576,18 +616,18 @@ package body Ada.Containers.Hashed_Sets is
    --  Start of processing for Insert
 
    begin
-      if HT.Length >= HT_Ops.Capacity (HT) then
+      if HT_Ops.Capacity (HT) = 0 then
+         HT_Ops.Reserve_Capacity (HT, 1);
+      end if;
 
-         --  TODO:
-         --  Perform the insertion first, and then reserve
-         --  capacity, but only if the insertion succeeds and
-         --  the (new) length is greater then current capacity.
-         --  END TODO.
+      Local_Insert (HT, New_Item, Position.Node, Inserted);
 
-         HT_Ops.Reserve_Capacity (HT, HT.Length + 1);
+      if Inserted
+        and then HT.Length > HT_Ops.Capacity (HT)
+      then
+         HT_Ops.Reserve_Capacity (HT, HT.Length);
       end if;
 
-      Local_Insert (HT, New_Item, Position.Node, Inserted);
       Position.Container := Container'Unchecked_Access;
    end Insert;
 
@@ -725,7 +765,7 @@ package body Ada.Containers.Hashed_Sets is
 
    function Is_Empty (Container : Set) return Boolean is
    begin
-      return Container.Length = 0;
+      return Container.HT.Length = 0;
    end Is_Empty;
 
    -----------
@@ -790,23 +830,13 @@ package body Ada.Containers.Hashed_Sets is
          Process (Cursor'(Container'Unrestricted_Access, Node));
       end Process_Node;
 
-      HT : Hash_Table_Type renames Container'Unrestricted_Access.all.HT;
-      B  : Natural renames HT.Busy;
-
    --  Start of processing for Iterate
 
    begin
-      B := B + 1;
-
-      begin
-         Iterate (HT);
-      exception
-         when others =>
-            B := B - 1;
-            raise;
-      end;
+      --  TODO: resolve whether HT_Ops.Generic_Iteration should
+      --  manipulate busy bit.
 
-      B := B - 1;
+      Iterate (Container.HT);
    end Iterate;
 
    ------------
@@ -838,8 +868,9 @@ package body Ada.Containers.Hashed_Sets is
 
    function Next (Position : Cursor) return Cursor is
    begin
+      pragma Assert (Vet (Position), "bad cursor in function Next");
+
       if Position.Node = null then
-         pragma Assert (Position.Container = null);
          return No_Element;
       end if;
 
@@ -896,28 +927,35 @@ package body Ada.Containers.Hashed_Sets is
      (Position : Cursor;
       Process  : not null access procedure (Element : Element_Type))
    is
-      E : Element_Type renames Position.Node.Element;
+   begin
+      pragma Assert (Vet (Position), "bad cursor in Query_Element");
 
-      HT : Hash_Table_Type renames Position.Container.HT;
+      if Position.Node = null then
+         raise Constraint_Error;
+      end if;
 
-      B : Natural renames HT.Busy;
-      L : Natural renames HT.Lock;
+      declare
+         HT : Hash_Table_Type renames Position.Container.HT;
 
-   begin
-      B := B + 1;
-      L := L + 1;
+         B : Natural renames HT.Busy;
+         L : Natural renames HT.Lock;
 
       begin
-         Process (E);
-      exception
-         when others =>
-            L := L - 1;
-            B := B - 1;
-            raise;
-      end;
+         B := B + 1;
+         L := L + 1;
+
+         begin
+            Process (Position.Node.Element);
+         exception
+            when others =>
+               L := L - 1;
+               B := B - 1;
+               raise;
+         end;
 
-      L := L - 1;
-      B := B - 1;
+         L := L - 1;
+         B := B - 1;
+      end;
    end Query_Element;
 
    ----------
@@ -955,7 +993,7 @@ package body Ada.Containers.Hashed_Sets is
    -------------
 
    procedure Replace
-     (Container : in out Set;    --  TODO: need ruling from ARG
+     (Container : in out Set;
       New_Item  : Element_Type)
    is
       Node : constant Node_Access :=
@@ -978,19 +1016,19 @@ package body Ada.Containers.Hashed_Sets is
    ---------------------
 
    procedure Replace_Element
-     (HT      : in out Hash_Table_Type;
-      Node    : Node_Access;
-      Element : Element_Type)
+     (HT       : in out Hash_Table_Type;
+      Node     : Node_Access;
+      New_Item : Element_Type)
    is
    begin
-      if Equivalent_Elements (Node.Element, Element) then
-         pragma Assert (Hash (Node.Element) = Hash (Element));
+      if Equivalent_Elements (Node.Element, New_Item) then
+         pragma Assert (Hash (Node.Element) = Hash (New_Item));
 
          if HT.Lock > 0 then
             raise Program_Error;
          end if;
 
-         Node.Element := Element;  --  Note that this assignment can fail
+         Node.Element := New_Item;  --  Note that this assignment can fail
          return;
       end if;
 
@@ -1013,7 +1051,7 @@ package body Ada.Containers.Hashed_Sets is
 
          function New_Node (Next : Node_Access) return Node_Access is
          begin
-            Node.Element := Element;  -- Note that this assignment can fail
+            Node.Element := New_Item;  -- Note that this assignment can fail
             Node.Next := Next;
             return Node;
          end New_Node;
@@ -1026,12 +1064,11 @@ package body Ada.Containers.Hashed_Sets is
       begin
          Local_Insert
            (HT       => HT,
-            Key      => Element,
+            Key      => New_Item,
             Node     => Result,
             Inserted => Inserted);
 
          if Inserted then
-            pragma Assert (Result = Node);
             return;
          end if;
       exception
@@ -1076,22 +1113,22 @@ package body Ada.Containers.Hashed_Sets is
    end Replace_Element;
 
    procedure Replace_Element
-     (Container : Set;
+     (Container : in out Set;
       Position  : Cursor;
-      By        : Element_Type)
+      New_Item  : Element_Type)
    is
-      HT : Hash_Table_Type renames Container'Unrestricted_Access.all.HT;
-
    begin
+      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
+
       if Position.Node = null then
          raise Constraint_Error;
       end if;
 
-      if Position.Container /= Set_Access'(Container'Unrestricted_Access) then
+      if Position.Container /= Container'Unrestricted_Access then
          raise Program_Error;
       end if;
 
-      Replace_Element (HT, Position.Node, By);
+      Replace_Element (Container.HT, Position.Node, New_Item);
    end Replace_Element;
 
    ----------------------
@@ -1491,6 +1528,61 @@ package body Ada.Containers.Hashed_Sets is
       return (Controlled with HT => (Buckets, Length, 0, 0));
    end Union;
 
+   ---------
+   -- Vet --
+   ---------
+
+   function Vet (Position : Cursor) return Boolean is
+   begin
+      if Position.Node = null then
+         return Position.Container = null;
+      end if;
+
+      if Position.Container = null then
+         return False;
+      end if;
+
+      if Position.Node.Next = Position.Node then
+         return False;
+      end if;
+
+      declare
+         HT : Hash_Table_Type renames Position.Container.HT;
+         X  : Node_Access;
+
+      begin
+         if HT.Length = 0 then
+            return False;
+         end if;
+
+         if HT.Buckets = null
+           or else HT.Buckets'Length = 0
+         then
+            return False;
+         end if;
+
+         X := HT.Buckets (Element_Keys.Index (HT, Position.Node.Element));
+
+         for J in 1 .. HT.Length loop
+            if X = Position.Node then
+               return True;
+            end if;
+
+            if X = null then
+               return False;
+            end if;
+
+            if X = X.Next then  --  to prevent unnecessary looping
+               return False;
+            end if;
+
+            X := X.Next;
+         end loop;
+
+         return False;
+      end;
+   end Vet;
+
    -----------
    -- Write --
    -----------
@@ -1594,27 +1686,9 @@ package body Ada.Containers.Hashed_Sets is
          Node : Node_Access) return Boolean
       is
       begin
-         return Equivalent_Keys (Key, Node.Element);
+         return Equivalent_Keys (Key, Generic_Keys.Key (Node.Element));
       end Equivalent_Key_Node;
 
-      ---------------------
-      -- Equivalent_Keys --
-      ---------------------
-
-      function Equivalent_Keys
-        (Left  : Cursor;
-         Right : Key_Type) return Boolean is
-      begin
-         return Equivalent_Keys (Right, Left.Node.Element);
-      end Equivalent_Keys;
-
-      function Equivalent_Keys
-        (Left  : Key_Type;
-         Right : Cursor) return Boolean is
-      begin
-         return Equivalent_Keys (Left, Right.Node.Element);
-      end Equivalent_Keys;
-
       -------------
       -- Exclude --
       -------------
@@ -1654,6 +1728,12 @@ package body Ada.Containers.Hashed_Sets is
 
       function Key (Position : Cursor) return Key_Type is
       begin
+         pragma Assert (Vet (Position), "bad cursor in function Key");
+
+         if Position.Node = null then
+            raise Constraint_Error;
+         end if;
+
          return Key (Position.Node.Element);
       end Key;
 
@@ -1687,20 +1767,35 @@ package body Ada.Containers.Hashed_Sets is
          Process   : not null access
                        procedure (Element : in out Element_Type))
       is
-         HT : Hash_Table_Type renames Container.HT;
+         HT   : Hash_Table_Type renames Container.HT;
+         Indx : Hash_Type;
 
       begin
+         pragma Assert
+           (Vet (Position),
+            "bad cursor in Update_Element_Preserving_Key");
+
          if Position.Node = null then
             raise Constraint_Error;
          end if;
 
-         if Position.Container /= Set_Access'(Container'Unchecked_Access) then
+         if Position.Container /= Container'Unrestricted_Access then
             raise Program_Error;
          end if;
 
+         if HT.Buckets = null
+           or else HT.Buckets'Length = 0
+           or else HT.Length = 0
+           or else Position.Node.Next = Position.Node
+         then
+            raise Program_Error;
+         end if;
+
+         Indx := HT_Ops.Index (HT, Position.Node);
+
          declare
             E : Element_Type renames Position.Node.Element;
-            K : Key_Type renames Key (E);
+            K : constant Key_Type := Key (E);
 
             B : Natural renames HT.Busy;
             L : Natural renames HT.Lock;
@@ -1721,16 +1816,38 @@ package body Ada.Containers.Hashed_Sets is
             L := L - 1;
             B := B - 1;
 
-            if Equivalent_Keys (K, E) then
+            if Equivalent_Keys (K, Key (E)) then
                pragma Assert (Hash (K) = Hash (E));
                return;
             end if;
          end;
 
+         if HT.Buckets (Indx) = Position.Node then
+            HT.Buckets (Indx) := Position.Node.Next;
+
+         else
+            declare
+               Prev : Node_Access := HT.Buckets (Indx);
+
+            begin
+               while Prev.Next /= Position.Node loop
+                  Prev := Prev.Next;
+
+                  if Prev = null then
+                     raise Program_Error;
+                  end if;
+               end loop;
+
+               Prev.Next := Position.Node.Next;
+            end;
+         end if;
+
+         HT.Length := HT.Length - 1;
+
          declare
             X : Node_Access := Position.Node;
+
          begin
-            HT_Ops.Delete_Node_Sans_Free (HT, X);
             Free (X);
          end;
 

gcc/ada/a-cohase.ads

@@ -48,7 +48,7 @@ generic
    with function "=" (Left, Right : Element_Type) return Boolean is <>;
 
 package Ada.Containers.Hashed_Sets is
-pragma Preelaborate (Hashed_Sets);
+   pragma Preelaborate;
 
    type Set is tagged private;
 
@@ -62,6 +62,12 @@ pragma Preelaborate (Hashed_Sets);
 
    function Equivalent_Sets (Left, Right : Set) return Boolean;
 
+   function Capacity (Container : Set) return Count_Type;
+
+   procedure Reserve_Capacity
+     (Container : in out Set;
+      Capacity  : Count_Type);
+
    function Length (Container : Set) return Count_Type;
 
    function Is_Empty (Container : Set) return Boolean;
@@ -70,15 +76,15 @@ pragma Preelaborate (Hashed_Sets);
 
    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
@@ -93,39 +99,11 @@ pragma Preelaborate (Hashed_Sets);
 
    procedure Replace (Container : in out Set; New_Item : Element_Type);
 
-   procedure Delete  (Container : in out Set; Item     : Element_Type);
-
-   procedure Delete (Container : in out Set; Position  : in out Cursor);
-
    procedure Exclude (Container : in out Set; Item     : Element_Type);
 
-   function Contains (Container : Set; Item : Element_Type) return Boolean;
-
-   function Find
-     (Container : Set;
-      Item      : Element_Type) return Cursor;
-
-   function First (Container : Set) return Cursor;
-
-   function Next (Position : Cursor) return Cursor;
-
-   procedure Next (Position : in out Cursor);
-
-   function Has_Element (Position : Cursor) return Boolean;
-
-   function Equivalent_Elements (Left, Right : Cursor) return Boolean;
-
-   function Equivalent_Elements
-     (Left  : Cursor;
-      Right : Element_Type) return Boolean;
-
-   function Equivalent_Elements
-     (Left  : Element_Type;
-      Right : Cursor) return Boolean;
+   procedure Delete  (Container : in out Set; Item     : Element_Type);
 
-   procedure Iterate
-     (Container : Set;
-      Process   : not null access procedure (Position : Cursor));
+   procedure Delete (Container : in out Set; Position  : in out Cursor);
 
    procedure Union (Target : in out Set; Source : Set);
 
@@ -156,41 +134,61 @@ pragma Preelaborate (Hashed_Sets);
 
    function Is_Subset (Subset : Set; Of_Set : Set) return Boolean;
 
-   function Capacity (Container : Set) return Count_Type;
+   function First (Container : Set) return Cursor;
 
-   procedure Reserve_Capacity
-     (Container : in out Set;
-      Capacity  : Count_Type);
+   function Next (Position : Cursor) return Cursor;
+
+   procedure Next (Position : in out Cursor);
+
+   function Find
+     (Container : Set;
+      Item      : Element_Type) return Cursor;
+
+   function Contains (Container : Set; Item : Element_Type) return Boolean;
+
+   function Has_Element (Position : Cursor) return Boolean;
+
+   function Equivalent_Elements (Left, Right : Cursor) return Boolean;
+
+   function Equivalent_Elements
+     (Left  : Cursor;
+      Right : Element_Type) return Boolean;
+
+   function Equivalent_Elements
+     (Left  : Element_Type;
+      Right : Cursor) return Boolean;
+
+   procedure Iterate
+     (Container : Set;
+      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 Hash (Key : Key_Type) return Hash_Type;
 
-      with function Equivalent_Keys
-        (Key     : Key_Type;
-         Element : Element_Type) return Boolean;
+      with function Equivalent_Keys (Left, Right : Key_Type) return Boolean;
 
    package Generic_Keys is
 
-      function Contains (Container : Set; Key : Key_Type) return Boolean;
-
-      function Find (Container : Set; Key : Key_Type) return Cursor;
-
       function Key (Position : Cursor) return Key_Type;
 
       function Element (Container : Set; Key : Key_Type) return Element_Type;
 
-      procedure Replace
+      procedure Replace          --  TODO: ask Randy why this wasn't removed
         (Container : in out Set;
          Key       : Key_Type;
          New_Item  : Element_Type);
 
+      procedure Exclude (Container : in out Set; Key : Key_Type);
+
       procedure Delete (Container : in out Set; Key : Key_Type);
 
-      procedure Exclude (Container : in out Set; Key : Key_Type);
+      function Find (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;
@@ -198,18 +196,9 @@ pragma Preelaborate (Hashed_Sets);
          Process   : not null access
                        procedure (Element : in out Element_Type));
 
-      function Equivalent_Keys
-        (Left  : Cursor;
-         Right : Key_Type) return Boolean;
-
-      function Equivalent_Keys
-        (Left  : Key_Type;
-         Right : Cursor) return Boolean;
-
    end Generic_Keys;
 
 private
-
    type Node_Type;
    type Node_Access is access Node_Type;
 

gcc/ada/a-coorse.adb

@@ -359,6 +359,21 @@ package body Ada.Containers.Ordered_Sets is
       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 --
    ---------------------
@@ -490,34 +505,6 @@ package body Ada.Containers.Ordered_Sets 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 : 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 ">";
-
       -------------
       -- Ceiling --
       -------------
@@ -573,6 +560,21 @@ package body Ada.Containers.Ordered_Sets is
          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 --
       -------------
@@ -626,7 +628,7 @@ package body Ada.Containers.Ordered_Sets is
          Right : Node_Access) return Boolean
       is
       begin
-         return Left > Right.Element;
+         return Key (Right.Element) < Left;
       end Is_Greater_Key_Node;
 
       ----------------------
@@ -638,7 +640,7 @@ package body Ada.Containers.Ordered_Sets is
          Right : Node_Access) return Boolean
       is
       begin
-         return Left < Right.Element;
+         return Left < Key (Right.Element);
       end Is_Less_Key_Node;
 
       ---------
@@ -691,7 +693,7 @@ package body Ada.Containers.Ordered_Sets is
 
          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;
@@ -712,11 +714,7 @@ package body Ada.Containers.Ordered_Sets is
             L := L - 1;
             B := B - 1;
 
-            if K < E
-              or else K > E
-            then
-               null;
-            else
+            if Equivalent_Keys (K, Key (E)) then
                return;
             end if;
          end;
@@ -1319,12 +1317,10 @@ package body Ada.Containers.Ordered_Sets 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;
@@ -1334,7 +1330,7 @@ package body Ada.Containers.Ordered_Sets is
          raise Program_Error;
       end if;
 
-      Replace_Element (Tree, Position.Node, By);
+      Replace_Element (Container.Tree, Position.Node, New_Item);
    end Replace_Element;
 
    ---------------------

gcc/ada/a-coorse.ads

@@ -38,14 +38,15 @@ with Ada.Finalization;
 with Ada.Streams;
 
 generic
-
    type Element_Type is private;
 
    with function "<" (Left, Right : Element_Type) return Boolean is <>;
    with function "=" (Left, Right : Element_Type) return Boolean is <>;
 
 package Ada.Containers.Ordered_Sets is
-pragma Preelaborate (Ordered_Sets);
+   pragma Preelaborate;
+
+   function Equivalent_Elements (Left, Right : Element_Type) return Boolean;
 
    type Set is tagged private;
 
@@ -67,18 +68,16 @@ pragma Preelaborate (Ordered_Sets);
 
    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;  --  TODO: need ARG ruling
-      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;
@@ -95,9 +94,13 @@ pragma Preelaborate (Ordered_Sets);
       New_Item  : Element_Type);
 
    procedure Replace
-     (Container : in out Set;  --  TODO: need ARG ruling
+     (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);
@@ -110,10 +113,6 @@ pragma Preelaborate (Ordered_Sets);
 
    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;
@@ -126,8 +125,7 @@ pragma Preelaborate (Ordered_Sets);
 
    function "and" (Left, Right : Set) return Set renames Intersection;
 
-   procedure Difference (Target : in out Set;
-                         Source : Set);
+   procedure Difference (Target : in out Set; Source : Set);
 
    function Difference (Left, Right : Set) return Set;
 
@@ -143,14 +141,6 @@ pragma Preelaborate (Ordered_Sets);
 
    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;
@@ -167,6 +157,14 @@ pragma Preelaborate (Ordered_Sets);
 
    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;
@@ -190,48 +188,36 @@ pragma Preelaborate (Ordered_Sets);
       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 Replace
-        (Container : in out Set;  --  TODO: need ARG ruling
+        (Container : in out Set;
          Key       : Key_Type;
          New_Item  : 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;