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

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



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

1 files changed, 171 insertions, 130 deletions

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