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.


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

1 files changed, 138 insertions, 74 deletions

diff --git a/gcc/ada/a-cihama.adb b/gcc/ada/a-cihama.adb
index 16fcd6ea3dd..dc5fa0f82cb 100644
--- a/gcc/ada/a-cihama.adb
+++ b/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;