a-rbtgso.adb, [...]: All explicit raise statements now include an exception message.

2006-02-13  Matthew Heaney  <heaney@adacore.com>

	* a-rbtgso.adb, a-crbtgo.adb, a-crbtgk.adb, a-coorse.adb, 
	a-cohama.adb, a-ciorse.adb, a-cihama.adb, a-cihase.adb, 
	a-cohase.adb: All explicit raise statements now include an exception
	message.

	* a-ciormu.ads, a-ciormu.adb, a-coormu.ads, a-coormu.adb
	(Update_Element_Preserving_Key): renamed op to just Update_Element.
	Explicit raise statements now include an exception message

	* a-cihase.ads, a-cohase.ads: Removed comment.

	* a-stboha.ads, a-stboha.adb, a-stfiha.ads, a-envvar.adb,
	a-envvar.ads, a-swbwha.ads, a-swbwha.adb, a-swfwha.ads, a-szbzha.ads,
	a-szbzha.adb, a-szfzha.ads: New files.

From-SVN: r111035

gcc/ada/a-cihama.adb

@@ -186,7 +186,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       Key_Ops.Delete_Key_Sans_Free (Container.HT, Key, X);
 
       if X = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "attempt to delete key not in map";
       end if;
 
       Free (X);
@@ -194,20 +194,23 @@ 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;
+         raise Constraint_Error with
+           "Position cursor of Delete equals No_Element";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor of Delete designates wrong map";
       end if;
 
       if Container.HT.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "Delete attempted to tamper with elements (map is busy)";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Delete");
+
       HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
 
       Free (Position.Node);
@@ -223,7 +226,8 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
    begin
       if Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "no element available because key not in map";
       end if;
 
       return Node.Element.all;
@@ -231,16 +235,18 @@ package body Ada.Containers.Indefinite_Hashed_Maps 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;
+         raise Constraint_Error with
+           "Position cursor of function Element equals No_Element";
       end if;
 
       if Position.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor of function Element is bad";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in function Element");
+
       return Position.Node.Element.all;
    end Element;
 
@@ -262,21 +268,29 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
    function Equivalent_Keys (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 then
+         raise Constraint_Error with
+           "Left cursor of Equivalent_Keys equals No_Element";
+      end if;
 
-      if Left.Node = null
-        or else Right.Node = null
-      then
-         raise Constraint_Error;
+      if Right.Node = null then
+         raise Constraint_Error with
+           "Right cursor of Equivalent_Keys equals No_Element";
       end if;
 
-      if Left.Node.Key = null
-        or else Right.Node.Key = null
-      then
-         raise Program_Error;
+      if Left.Node.Key = null then
+         raise Program_Error with
+           "Left cursor of Equivalent_Keys is bad";
+      end if;
+
+      if Right.Node.Key = null then
+         raise Program_Error with
+           "Right cursor of Equivalent_Keys is bad";
       end if;
 
+      pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+      pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
+
       return Equivalent_Keys (Left.Node.Key.all, Right.Node.Key.all);
    end Equivalent_Keys;
 
@@ -285,16 +299,18 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       Right : Key_Type) return Boolean
    is
    begin
-      pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
-
       if Left.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Left cursor of Equivalent_Keys equals No_Element";
       end if;
 
       if Left.Node.Key = null then
-         raise Program_Error;
+         raise Program_Error with
+           "Left cursor of Equivalent_Keys is bad";
       end if;
 
+      pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Keys");
+
       return Equivalent_Keys (Left.Node.Key.all, Right);
    end Equivalent_Keys;
 
@@ -303,16 +319,18 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       Right : Cursor) return Boolean
    is
    begin
-      pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
-
       if Right.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Right cursor of Equivalent_Keys equals No_Element";
       end if;
 
       if Right.Node.Key = null then
-         raise Program_Error;
+         raise Program_Error with
+           "Right cursor of Equivalent_Keys is bad";
       end if;
 
+      pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Keys");
+
       return Equivalent_Keys (Left, Right.Node.Key.all);
    end Equivalent_Keys;
 
@@ -472,7 +490,8 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
       if not Inserted then
          if Container.HT.Lock > 0 then
-            raise Program_Error;
+            raise Program_Error with
+              "Include attempted to tamper with cursors (map is locked)";
          end if;
 
          K := Position.Node.Key;
@@ -559,7 +578,8 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       Insert (Container, Key, New_Item, Position, Inserted);
 
       if not Inserted then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "attempt to insert key already in map";
       end if;
    end Insert;
 
@@ -607,16 +627,18 @@ package body Ada.Containers.Indefinite_Hashed_Maps 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;
+         raise Constraint_Error with
+           "Position cursor of function Key equals No_Element";
       end if;
 
       if Position.Node.Key = null then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor of function Key is bad";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in function Key");
+
       return Position.Node.Key.all;
    end Key;
 
@@ -657,8 +679,6 @@ 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
          return No_Element;
       end if;
@@ -666,9 +686,11 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       if Position.Node.Key = null
         or else Position.Node.Element = null
       then
-         raise Program_Error;
+         raise Program_Error with "Position cursor of Next is bad";
       end if;
 
+      pragma Assert (Vet (Position), "Position cursor of Next is bad");
+
       declare
          HT   : Hash_Table_Type renames Position.Container.HT;
          Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
@@ -692,18 +714,20 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
                                             Element : Element_Type))
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Query_Element");
-
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Position cursor of Query_Element equals No_Element";
       end if;
 
       if Position.Node.Key = null
         or else Position.Node.Element = null
       then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor of Query_Element is bad";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Query_Element");
+
       declare
          M  : Map renames Position.Container.all;
          HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
@@ -752,7 +776,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       Item   : out Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream map cursor";
    end Read;
 
    ---------------
@@ -801,11 +825,13 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
 
    begin
       if Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "attempt to replace key not in map";
       end if;
 
       if Container.HT.Lock > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "Replace attempted to tamper with cursors (map is locked)";
       end if;
 
       K := Node.Key;
@@ -835,26 +861,30 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       New_Item  : Element_Type)
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
-
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Position cursor of Replace_Element equals No_Element";
       end if;
 
       if Position.Node.Key = null
         or else Position.Node.Element = null
       then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor of Replace_Element is bad";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor of Replace_Element designates wrong map";
       end if;
 
       if Position.Container.HT.Lock > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "Replace_Element attempted to tamper with cursors (map is locked)";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
+
       declare
          X : Element_Access := Position.Node.Element;
 
@@ -896,22 +926,25 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
                                              Element : in out Element_Type))
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Update_Element");
-
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Position cursor of Update_Element equals No_Element";
       end if;
 
       if Position.Node.Key = null
         or else Position.Node.Element = null
       then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor of Update_Element is bad";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor of Update_Element designates wrong map";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Update_Element");
+
       declare
          HT : Hash_Table_Type renames Container.HT;
 
@@ -1021,7 +1054,7 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
       Item   : Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream map cursor";
    end Write;
 
    ----------------

gcc/ada/a-cihase.adb

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2006, 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 --
@@ -42,10 +42,10 @@ pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Operations);
 with Ada.Containers.Hash_Tables.Generic_Keys;
 pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Keys);
 
-with System;  use type System.Address;
-
 with Ada.Containers.Prime_Numbers;
 
+with System;  use type System.Address;
+
 package body Ada.Containers.Indefinite_Hashed_Sets is
 
    -----------------------
@@ -214,7 +214,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       Element_Keys.Delete_Key_Sans_Free (Container.HT, Item, X);
 
       if X = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "attempt to delete element not in set";
       end if;
 
       Free (X);
@@ -225,24 +225,25 @@ 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;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       if Position.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Position cursor is bad";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with "Position cursor designates wrong set";
       end if;
 
       if Container.HT.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with elements (set is busy)";
       end if;
 
+      pragma Assert (Vet (Position), "Position cursor is bad");
+
       HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
 
       Free (Position.Node);
@@ -270,7 +271,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       end if;
 
       if Target.HT.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with elements (set is busy)";
       end if;
 
       --  TODO: This can be written in terms of a loop instead as
@@ -367,16 +369,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;
+         raise Constraint_Error with "Position cursor of equals No_Element";
       end if;
 
       if Position.Node.Element = null then  --  handle dangling reference
-         raise Program_Error;
+         raise Program_Error with "Position cursor is bad";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in function Element");
+
       return Position.Node.Element.all;
    end Element;
 
@@ -396,21 +398,29 @@ 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 then
+         raise Constraint_Error with
+           "Left cursor of Equivalent_Elements equals No_Element";
+      end if;
 
-      if Left.Node = null
-        or else Right.Node = null
-      then
-         raise Constraint_Error;
+      if Right.Node = null then
+         raise Constraint_Error with
+           "Right cursor of Equivalent_Elements equals No_Element";
       end if;
 
-      if Left.Node.Element = null  --  handle dangling cursor reference
-        or else Right.Node.Element = null
-      then
-         raise Program_Error;
+      if Left.Node.Element = null then
+         raise Program_Error with
+           "Left cursor of Equivalent_Elements is bad";
       end if;
 
+      if Right.Node.Element = null then
+         raise Program_Error with
+           "Right cursor of Equivalent_Elements is bad";
+      end if;
+
+      pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Elements");
+      pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Elements");
+
       return Equivalent_Elements
                (Left.Node.Element.all,
                 Right.Node.Element.all);
@@ -419,32 +429,36 @@ 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;
+         raise Constraint_Error with
+           "Left cursor of Equivalent_Elements equals No_Element";
       end if;
 
-      if Left.Node.Element = null then  --  handling dangling reference
-         raise Program_Error;
+      if Left.Node.Element = null then
+         raise Program_Error with
+           "Left cursor of Equivalent_Elements is bad";
       end if;
 
+      pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Elements");
+
       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;
+         raise Constraint_Error with
+           "Right cursor of Equivalent_Elements equals No_Element";
       end if;
 
-      if Right.Node.Element = null then  --  handle dangling cursor reference
-         raise Program_Error;
+      if Right.Node.Element = null then
+         raise Program_Error with
+           "Right cursor of Equivalent_Elements is bad";
       end if;
 
+      pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Elements");
+
       return Equivalent_Elements (Left, Right.Node.Element.all);
    end Equivalent_Elements;
 
@@ -632,7 +646,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
       if not Inserted then
          if Container.HT.Lock > 0 then
-            raise Program_Error;
+            raise Program_Error with
+              "attempt to tamper with cursors (set is locked)";
          end if;
 
          X := Position.Node.Element;
@@ -669,7 +684,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       Insert (Container, New_Item, Position, Inserted);
 
       if not Inserted then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "attempt to insert element already in set";
       end if;
    end Insert;
 
@@ -737,7 +753,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       end if;
 
       if Target.HT.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with elements (set is busy)";
       end if;
 
       --  TODO: optimize this to use an explicit
@@ -951,16 +968,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
          return No_Element;
       end if;
 
       if Position.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "bad cursor in Next";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Next");
+
       declare
          HT   : Hash_Table_Type renames Position.Container.HT;
          Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
@@ -1016,16 +1033,17 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       Process  : not null access procedure (Element : Element_Type))
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Query_Element");
-
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Position cursor of Query_Element equals No_Element";
       end if;
 
       if Position.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "bad cursor in Query_Element";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Query_Element");
+
       declare
          HT : Hash_Table_Type renames
                 Position.Container'Unrestricted_Access.all.HT;
@@ -1068,7 +1086,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       Item   : out Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream set cursor";
    end Read;
 
    ---------------
@@ -1103,11 +1121,13 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
    begin
       if Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "attempt to replace element not in set";
       end if;
 
       if Container.HT.Lock > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with cursors (set is locked)";
       end if;
 
       X := Node.Element;
@@ -1131,7 +1151,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          pragma Assert (Hash (Node.Element.all) = Hash (New_Item));
 
          if HT.Lock > 0 then
-            raise Program_Error;
+            raise Program_Error with
+              "attempt to tamper with cursors (set is locked)";
          end if;
 
          declare
@@ -1145,7 +1166,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       end if;
 
       if HT.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with elements (set is busy)";
       end if;
 
       HT_Ops.Delete_Node_Sans_Free (HT, Node);
@@ -1227,7 +1249,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
             null;
       end Reinsert_Old_Element;
 
-      raise Program_Error;
+      raise Program_Error with "attempt to replace existing element";
    end Replace_Element;
 
    procedure Replace_Element
@@ -1236,20 +1258,21 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       New_Item  : Element_Type)
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
-
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       if Position.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "bad cursor in Replace_Element";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor designates wrong set";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
+
       Replace_Element (Container.HT, Position.Node, New_Item);
    end Replace_Element;
 
@@ -1289,7 +1312,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       end if;
 
       if Target.HT.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with elements (set is busy)";
       end if;
 
       declare
@@ -1605,7 +1629,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       end if;
 
       if Target.HT.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with elements (set is busy)";
       end if;
 
       declare
@@ -1808,7 +1833,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
       Item   : Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream set cursor";
    end Write;
 
    ----------------
@@ -1873,7 +1898,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          Key_Keys.Delete_Key_Sans_Free (Container.HT, Key, X);
 
          if X = null then
-            raise Constraint_Error;
+            raise Constraint_Error with "key not in map";
          end if;
 
          Free (X);
@@ -1888,7 +1913,12 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          Key       : Key_Type) return Element_Type
       is
          Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
+
       begin
+         if Node = null then
+            raise Constraint_Error with "key not in map";
+         end if;
+
          return Node.Element.all;
       end Element;
 
@@ -1941,16 +1971,17 @@ 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;
+            raise Constraint_Error with
+              "Position cursor equals No_Element";
          end if;
 
          if Position.Node.Element = null then
-            raise Program_Error;
+            raise Program_Error with "Position cursor is bad";
          end if;
 
+         pragma Assert (Vet (Position), "bad cursor in function Key");
+
          return Key (Position.Node.Element.all);
       end Key;
 
@@ -1968,7 +1999,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
       begin
          if Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with
+              "attempt to replace key not in set";
          end if;
 
          Replace_Element (Container.HT, Node, New_Item);
@@ -1976,7 +2008,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
 
       procedure Update_Element_Preserving_Key
         (Container : in out Set;
-         Position  : in     Cursor;
+         Position  : Cursor;
          Process   : not null access
            procedure (Element : in out Element_Type))
       is
@@ -1984,31 +2016,33 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
          Indx : Hash_Type;
 
       begin
-         pragma Assert
-           (Vet (Position),
-            "bad cursor in Update_Element_Preserving_Key");
-
          if Position.Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with
+              "Position cursor equals No_Element";
          end if;
 
          if Position.Node.Element = null
            or else Position.Node.Next = Position.Node
          then
-            raise Program_Error;
+            raise Program_Error with "Position cursor is bad";
          end if;
 
          if Position.Container /= Container'Unrestricted_Access then
-            raise Program_Error;
+            raise Program_Error with
+              "Position cursor designates wrong set";
          end if;
 
          if HT.Buckets = null
            or else HT.Buckets'Length = 0
            or else HT.Length = 0
          then
-            raise Program_Error;
+            raise Program_Error with "Position cursor is bad (set is empty)";
          end if;
 
+         pragma Assert
+           (Vet (Position),
+            "bad cursor in Update_Element_Preserving_Key");
+
          Indx := HT_Ops.Index (HT, Position.Node);
 
          declare
@@ -2052,7 +2086,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
                   Prev := Prev.Next;
 
                   if Prev = null then
-                     raise Program_Error;
+                     raise Program_Error with
+                       "Position cursor is bad (node not found)";
                   end if;
                end loop;
 
@@ -2069,7 +2104,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
             Free (X);
          end;
 
-         raise Program_Error;
+         raise Program_Error with "key was modified";
       end Update_Element_Preserving_Key;
 
    end Generic_Keys;

gcc/ada/a-cihase.ads

@@ -180,7 +180,7 @@ package Ada.Containers.Indefinite_Hashed_Sets is
 
       function Element (Container : Set; Key : Key_Type) return Element_Type;
 
-      procedure Replace           -- TODO: ask Randy why this is still here
+      procedure Replace
         (Container : in out Set;
          Key       : Key_Type;
          New_Item  : Element_Type);

gcc/ada/a-ciormu.adb

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2006, 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 --
@@ -162,16 +162,20 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
 
    function "<" (Left, Right : Cursor) return Boolean is
    begin
-      if Left.Node = null
-        or else Right.Node = null
-      then
-         raise Constraint_Error;
+      if Left.Node = null then
+         raise Constraint_Error with "Left cursor equals No_Element";
       end if;
 
-      if Left.Node.Element = null
-        or else Right.Node.Element = null
-      then
-         raise Program_Error;
+      if Right.Node = null then
+         raise Constraint_Error with "Right cursor equals No_Element";
+      end if;
+
+      if Left.Node.Element = null then
+         raise Program_Error with "Left cursor is bad";
+      end if;
+
+      if Right.Node.Element = null then
+         raise Program_Error with "Right cursor is bad";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -186,11 +190,11 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
    function "<" (Left : Cursor; Right : Element_Type) return Boolean is
    begin
       if Left.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Left cursor equals No_Element";
       end if;
 
       if Left.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Left cursor is bad";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -202,11 +206,11 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
    function "<" (Left : Element_Type; Right : Cursor) return Boolean is
    begin
       if Right.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Right cursor equals No_Element";
       end if;
 
       if Right.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Right cursor is bad";
       end if;
 
       pragma Assert (Vet (Right.Container.Tree, Right.Node),
@@ -230,16 +234,20 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
 
    function ">" (Left, Right : Cursor) return Boolean is
    begin
-      if Left.Node = null
-        or else Right.Node = null
-      then
-         raise Constraint_Error;
+      if Left.Node = null then
+         raise Constraint_Error with "Left cursor equals No_Element";
       end if;
 
-      if Left.Node.Element = null
-        or else Right.Node.Element = null
-      then
-         raise Program_Error;
+      if Right.Node = null then
+         raise Constraint_Error with "Right cursor equals No_Element";
+      end if;
+
+      if Left.Node.Element = null then
+         raise Program_Error with "Left cursor is bad";
+      end if;
+
+      if Right.Node.Element = null then
+         raise Program_Error with "Right cursor is bad";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -256,11 +264,11 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
    function ">" (Left : Cursor; Right : Element_Type) return Boolean is
    begin
       if Left.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Left cursor equals No_Element";
       end if;
 
       if Left.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Left cursor is bad";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -272,11 +280,11 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
    function ">" (Left : Element_Type; Right : Cursor) return Boolean is
    begin
       if Right.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Right cursor equals No_Element";
       end if;
 
       if Right.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Right cursor is bad";
       end if;
 
       pragma Assert (Vet (Right.Container.Tree, Right.Node),
@@ -375,7 +383,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
 
    begin
       if Node = Done then
-         raise Constraint_Error;
+         raise Constraint_Error with "attempt to delete element not in set";
       end if;
 
       loop
@@ -391,11 +399,15 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
    procedure Delete (Container : in out Set; Position : in out Cursor) is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
+      end if;
+
+      if Position.Node.Element = null then
+         raise Program_Error with "Position cursor is bad";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with "Position cursor designates wrong set";
       end if;
 
       pragma Assert (Vet (Container.Tree, Position.Node),
@@ -464,11 +476,11 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
    function Element (Position : Cursor) return Element_Type is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       if Position.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Position cursor is bad";
       end if;
 
       pragma Assert (Vet (Position.Container.Tree, Position.Node),
@@ -580,13 +592,10 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
    function First_Element (Container : Set) return Element_Type is
    begin
       if Container.Tree.First = null then
-         raise Constraint_Error;
-      end if;
-
-      if Container.Tree.First.Element = null then
-         raise Program_Error;
+         raise Constraint_Error with "set is empty";
       end if;
 
+      pragma Assert (Container.Tree.First.Element /= null);
       return Container.Tree.First.Element.all;
    end First_Element;
 
@@ -703,7 +712,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
 
       begin
          if Node = Done then
-            raise Constraint_Error;
+            raise Constraint_Error with "attempt to delete key not in set";
          end if;
 
          loop
@@ -726,7 +735,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
 
       begin
          if Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with "key not in set";
          end if;
 
          return Node.Element.all;
@@ -870,11 +879,13 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
       function Key (Position : Cursor) return Key_Type is
       begin
          if Position.Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with
+              "Position cursor equals No_Element";
          end if;
 
          if Position.Node.Element = null then
-            raise Program_Error;
+            raise Program_Error with
+              "Position cursor is bad";
          end if;
 
          pragma Assert (Vet (Position.Container.Tree, Position.Node),
@@ -930,35 +941,36 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
          B := B - 1;
       end Reverse_Iterate;
 
-      -----------------------------------
-      -- Update_Element_Preserving_Key --
-      -----------------------------------
+      --------------------
+      -- Update_Element --
+      --------------------
 
-      procedure Update_Element_Preserving_Key
+      procedure Update_Element
         (Container : in out Set;
          Position  : Cursor;
          Process   : not null access procedure (Element : in out Element_Type))
       is
          Tree : Tree_Type renames Container.Tree;
+         Node : constant Node_Access := Position.Node;
 
       begin
-         if Position.Node = null then
-            raise Constraint_Error;
+         if Node = null then
+            raise Constraint_Error with "Position cursor equals No_Element";
          end if;
 
-         if Position.Node.Element = null then
-            raise Program_Error;
+         if Node.Element = null then
+            raise Program_Error with "Position cursor is bad";
          end if;
 
          if Position.Container /= Container'Unrestricted_Access then
-            raise Program_Error;
+            raise Program_Error with "Position cursor designates wrong set";
          end if;
 
-         pragma Assert (Vet (Container.Tree, Position.Node),
-                        "bad cursor in Update_Element_Preserving_Key");
+         pragma Assert (Vet (Tree, Node),
+                        "bad cursor in Update_Element");
 
          declare
-            E : Element_Type renames Position.Node.Element.all;
+            E : Element_Type renames Node.Element.all;
             K : constant Key_Type := Key (E);
 
             B : Natural renames Tree.Busy;
@@ -985,15 +997,47 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
             end if;
          end;
 
-         declare
-            X : Node_Access := Position.Node;
+         --  Delete_Node checks busy-bit
+
+         Tree_Operations.Delete_Node_Sans_Free (Tree, Node);
+
+         Insert_New_Item : declare
+            function New_Node return Node_Access;
+            pragma Inline (New_Node);
+
+            procedure Insert_Post is
+               new Element_Keys.Generic_Insert_Post (New_Node);
+
+            procedure Unconditional_Insert is
+               new Element_Keys.Generic_Unconditional_Insert (Insert_Post);
+
+            --------------
+            -- New_Node --
+            --------------
+
+            function New_Node return Node_Access is
+            begin
+               Node.Color := Red_Black_Trees.Red;
+               Node.Parent := null;
+               Node.Left := null;
+               Node.Right := null;
+
+               return Node;
+            end New_Node;
+
+            Result : Node_Access;
+
+         --  Start of processing for Insert_New_Item
+
          begin
-            Tree_Operations.Delete_Node_Sans_Free (Tree, X);
-            Free (X);
-         end;
+            Unconditional_Insert
+              (Tree => Tree,
+               Key  => Node.Element.all,
+               Node => Result);
 
-         raise Program_Error;
-      end Update_Element_Preserving_Key;
+            pragma Assert (Result = Node);
+         end Insert_New_Item;
+      end Update_Element;
 
    end Generic_Keys;
 
@@ -1022,11 +1066,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
       Position  : out Cursor)
    is
    begin
-      Insert_Sans_Hint
-        (Container.Tree,
-         New_Item,
-         Position.Node);
-
+      Insert_Sans_Hint (Container.Tree, New_Item, Position.Node);
       Position.Container := Container'Unrestricted_Access;
    end Insert;
 
@@ -1045,7 +1085,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
       procedure Insert_Post is
         new Element_Keys.Generic_Insert_Post (New_Node);
 
-      procedure Unconditional_Insert_Sans_Hint is
+      procedure Unconditional_Insert is
         new Element_Keys.Generic_Unconditional_Insert (Insert_Post);
 
       --------------
@@ -1053,28 +1093,24 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
       --------------
 
       function New_Node return Node_Access is
-         X : Element_Access := new Element_Type'(New_Item);
+         Element : Element_Access := new Element_Type'(New_Item);
 
       begin
          return new Node_Type'(Parent  => null,
                                Left    => null,
                                Right   => null,
                                Color   => Red_Black_Trees.Red,
-                               Element => X);
-
+                               Element => Element);
       exception
          when others =>
-            Free_Element (X);
+            Free_Element (Element);
             raise;
       end New_Node;
 
    --  Start of processing for Insert_Sans_Hint
 
    begin
-      Unconditional_Insert_Sans_Hint
-        (Tree,
-         New_Item,
-         Node);
+      Unconditional_Insert (Tree, New_Item, Node);
    end Insert_Sans_Hint;
 
    ----------------------
@@ -1310,9 +1346,10 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
    function Last_Element (Container : Set) return Element_Type is
    begin
       if Container.Tree.Last = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "set is empty";
       end if;
 
+      pragma Assert (Container.Tree.Last.Element /= null);
       return Container.Tree.Last.Element.all;
    end Last_Element;
 
@@ -1436,11 +1473,11 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
    is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       if Position.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Position cursor is bad";
       end if;
 
       pragma Assert (Vet (Position.Container.Tree, Position.Node),
@@ -1513,7 +1550,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
       Item   : out Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream set cursor";
    end Read;
 
    ---------------------
@@ -1532,7 +1569,8 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
          null;
       else
          if Tree.Lock > 0 then
-            raise Program_Error;
+            raise Program_Error with
+              "attempt to tamper with cursors (set is locked)";
          end if;
 
          declare
@@ -1596,15 +1634,15 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
    is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       if Position.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Position cursor is bad";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with "Position cursor designates wrong set";
       end if;
 
       pragma Assert (Vet (Container.Tree, Position.Node),
@@ -1823,7 +1861,7 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
       Item   : Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream set cursor";
    end Write;
 
 end Ada.Containers.Indefinite_Ordered_Multisets;

gcc/ada/a-ciormu.ads

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2006, 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 --
@@ -216,7 +216,7 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
 
       function Contains (Container : Set; Key : Key_Type) return Boolean;
 
-      procedure Update_Element_Preserving_Key
+      procedure Update_Element
         (Container : in out Set;
          Position  : Cursor;
          Process   : not null access

gcc/ada/a-ciorse.adb

@@ -150,16 +150,20 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
    function "<" (Left, Right : Cursor) return Boolean is
    begin
-      if Left.Node = null
-        or else Right.Node = null
-      then
-         raise Constraint_Error;
+      if Left.Node = null then
+         raise Constraint_Error with "Left cursor equals No_Element";
       end if;
 
-      if Left.Node.Element = null
-        or else Right.Node.Element = null
-      then
-         raise Program_Error;
+      if Right.Node = null then
+         raise Constraint_Error with "Right cursor equals No_Element";
+      end if;
+
+      if Left.Node.Element = null then
+         raise Program_Error with "Left cursor is bad";
+      end if;
+
+      if Right.Node.Element = null then
+         raise Program_Error with "Right cursor is bad";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -174,11 +178,11 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    function "<" (Left : Cursor; Right : Element_Type) return Boolean is
    begin
       if Left.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Left cursor equals No_Element";
       end if;
 
       if Left.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Left cursor is bad";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -190,11 +194,11 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    function "<" (Left : Element_Type; Right : Cursor) return Boolean is
    begin
       if Right.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Right cursor equals No_Element";
       end if;
 
       if Right.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Right cursor is bad";
       end if;
 
       pragma Assert (Vet (Right.Container.Tree, Right.Node),
@@ -236,16 +240,20 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
    function ">" (Left, Right : Cursor) return Boolean is
    begin
-      if Left.Node = null
-        or else Right.Node = null
-      then
-         raise Constraint_Error;
+      if Left.Node = null then
+         raise Constraint_Error with "Left cursor equals No_Element";
       end if;
 
-      if Left.Node.Element = null
-        or else Right.Node.Element = null
-      then
-         raise Program_Error;
+      if Right.Node = null then
+         raise Constraint_Error with "Right cursor equals No_Element";
+      end if;
+
+      if Left.Node.Element = null then
+         raise Program_Error with "Left cursor is bad";
+      end if;
+
+      if Right.Node.Element = null then
+         raise Program_Error with "Right cursor is bad";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -262,11 +270,11 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    function ">" (Left : Cursor; Right : Element_Type) return Boolean is
    begin
       if Left.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Left cursor equals No_Element";
       end if;
 
       if Left.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Left cursor is bad";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -278,11 +286,11 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    function ">" (Left : Element_Type; Right : Cursor) return Boolean is
    begin
       if Right.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Right cursor equals No_Element";
       end if;
 
       if Right.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Right cursor is bad";
       end if;
 
       pragma Assert (Vet (Right.Container.Tree, Right.Node),
@@ -372,14 +380,18 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    -- Delete --
    ------------
 
-   procedure Delete (Container : in out Set; Position  : in out Cursor) is
+   procedure Delete (Container : in out Set; Position : in out Cursor) is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
+      end if;
+
+      if Position.Node.Element = null then
+         raise Program_Error with "Position cursor is bad";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with "Position cursor designates wrong set";
       end if;
 
       pragma Assert (Vet (Container.Tree, Position.Node),
@@ -396,7 +408,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
    begin
       if X = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "attempt to delete element not in set";
       end if;
 
       Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
@@ -456,11 +468,11 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    function Element (Position : Cursor) return Element_Type is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       if Position.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Position cursor is bad";
       end if;
 
       pragma Assert (Vet (Position.Container.Tree, Position.Node),
@@ -568,7 +580,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    function First_Element (Container : Set) return Element_Type is
    begin
       if Container.Tree.First = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "set is empty";
       end if;
 
       return Container.Tree.First.Element.all;
@@ -684,7 +696,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
       begin
          if X = null then
-            raise Constraint_Error;
+            raise Constraint_Error with "attempt to delete key not in set";
          end if;
 
          Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
@@ -701,7 +713,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
       begin
          if Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with "key not in set";
          end if;
 
          return Node.Element.all;
@@ -797,11 +809,13 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       function Key (Position : Cursor) return Key_Type is
       begin
          if Position.Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with
+              "Position cursor equals No_Element";
          end if;
 
          if Position.Node.Element = null then
-            raise Program_Error;
+            raise Program_Error with
+              "Position cursor is bad";
          end if;
 
          pragma Assert (Vet (Position.Container.Tree, Position.Node),
@@ -823,7 +837,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
       begin
          if Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with
+              "attempt to replace key not in set";
          end if;
 
          Replace_Element (Container.Tree, Node, New_Item);
@@ -843,15 +858,15 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
       begin
          if Position.Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with "Position cursor equals No_Element";
          end if;
 
          if Position.Node.Element = null then
-            raise Program_Error;
+            raise Program_Error with "Position cursor is bad";
          end if;
 
          if Position.Container /= Container'Unrestricted_Access then
-            raise Program_Error;
+            raise Program_Error with "Position cursor designates wrong set";
          end if;
 
          pragma Assert (Vet (Container.Tree, Position.Node),
@@ -892,7 +907,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
             Free (X);
          end;
 
-         raise Program_Error;
+         raise Program_Error with "key was modified";
       end Update_Element_Preserving_Key;
 
    end Generic_Keys;
@@ -921,7 +936,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
       if not Inserted then
          if Container.Tree.Lock > 0 then
-            raise Program_Error;
+            raise Program_Error with
+              "attempt to tamper with cursors (set is locked)";
          end if;
 
          X := Position.Node.Element;
@@ -957,7 +973,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       Insert (Container, New_Item, Position, Inserted);
 
       if not Inserted then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "attempt to insert element already in set";
       end if;
    end Insert;
 
@@ -1196,7 +1213,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    function Last_Element (Container : Set) return Element_Type is
    begin
       if Container.Tree.Last = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "set is empty";
       end if;
 
       return Container.Tree.Last.Element.all;
@@ -1247,6 +1264,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          return No_Element;
       end if;
 
+      if Position.Node.Element = null then
+         raise Program_Error with "Position cursor is bad";
+      end if;
+
       pragma Assert (Vet (Position.Container.Tree, Position.Node),
                      "bad cursor in Next");
 
@@ -1296,6 +1317,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          return No_Element;
       end if;
 
+      if Position.Node.Element = null then
+         raise Program_Error with "Position cursor is bad";
+      end if;
+
       pragma Assert (Vet (Position.Container.Tree, Position.Node),
                      "bad cursor in Previous");
 
@@ -1322,11 +1347,11 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       if Position.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Position cursor is bad";
       end if;
 
       pragma Assert (Vet (Position.Container.Tree, Position.Node),
@@ -1401,7 +1426,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       Item   : out Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream set cursor";
    end Read;
 
    -------------
@@ -1416,11 +1441,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
 
    begin
       if Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "attempt to replace element not in set";
       end if;
 
       if Container.Tree.Lock > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with cursors (set is locked)";
       end if;
 
       X := Node.Element;
@@ -1444,7 +1470,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
          null;
       else
          if Tree.Lock > 0 then
-            raise Program_Error;
+            raise Program_Error with
+              "attempt to tamper with cursors (set is locked)";
          end if;
 
          declare
@@ -1550,7 +1577,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
             null;
       end Reinsert_Old_Element;
 
-      raise Program_Error;
+      raise Program_Error with "attempt to replace existing element";
    end Replace_Element;
 
    procedure Replace_Element
@@ -1560,15 +1587,15 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
    is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       if Position.Node.Element = null then
-         raise Program_Error;
+         raise Program_Error with "Position cursor is bad";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with "Position cursor designates wrong set";
       end if;
 
       pragma Assert (Vet (Container.Tree, Position.Node),
@@ -1749,7 +1776,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
       Item   : Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream set cursor";
    end Write;
 
 end Ada.Containers.Indefinite_Ordered_Sets;

gcc/ada/a-cohama.adb

@@ -180,7 +180,7 @@ package body Ada.Containers.Hashed_Maps is
       Key_Ops.Delete_Key_Sans_Free (Container.HT, Key, X);
 
       if X = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "attempt to delete key not in map";
       end if;
 
       Free (X);
@@ -188,20 +188,23 @@ 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;
+         raise Constraint_Error with
+           "Position cursor of Delete equals No_Element";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor of Delete designates wrong map";
       end if;
 
       if Container.HT.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "Delete attempted to tamper with elements (map is busy)";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Delete");
+
       HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
 
       Free (Position.Node);
@@ -217,7 +220,8 @@ package body Ada.Containers.Hashed_Maps is
 
    begin
       if Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "no element available because key not in map";
       end if;
 
       return Node.Element;
@@ -225,12 +229,13 @@ package body Ada.Containers.Hashed_Maps 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;
+         raise Constraint_Error with
+           "Position cursor of function Element equals No_Element";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in function Element");
+
       return Position.Node.Element;
    end Element;
 
@@ -252,37 +257,43 @@ package body Ada.Containers.Hashed_Maps is
    function Equivalent_Keys (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 then
+         raise Constraint_Error with
+           "Left cursor of Equivalent_Keys equals No_Element";
+      end if;
 
-      if Left.Node = null
-        or else Right.Node = null
-      then
-         raise Constraint_Error;
+      if Right.Node = null then
+         raise Constraint_Error with
+           "Right cursor of Equivalent_Keys equals No_Element";
       end if;
 
+      pragma Assert (Vet (Left), "Left cursor of Equivalent_Keys is bad");
+      pragma Assert (Vet (Right), "Right cursor of Equivalent_Keys is bad");
+
       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), "bad Left cursor in Equivalent_Keys");
-
       if Left.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Left cursor of Equivalent_Keys equals No_Element";
       end if;
 
+      pragma Assert (Vet (Left), "Left cursor in Equivalent_Keys is bad");
+
       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), "bad Right cursor in Equivalent_Keys");
-
       if Right.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Right cursor of Equivalent_Keys equals No_Element";
       end if;
 
+      pragma Assert (Vet (Right), "Right cursor of Equivalent_Keys is bad");
+
       return Equivalent_Keys (Left, Right.Node.Key);
    end Equivalent_Keys;
 
@@ -409,7 +420,8 @@ package body Ada.Containers.Hashed_Maps is
 
       if not Inserted then
          if Container.HT.Lock > 0 then
-            raise Program_Error;
+            raise Program_Error with
+              "Include attempted to tamper with cursors (map is locked)";
          end if;
 
          Position.Node.Key := Key;
@@ -518,7 +530,8 @@ package body Ada.Containers.Hashed_Maps is
       Insert (Container, Key, New_Item, Position, Inserted);
 
       if not Inserted then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "attempt to insert key already in map";
       end if;
    end Insert;
 
@@ -565,12 +578,13 @@ package body Ada.Containers.Hashed_Maps 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;
+         raise Constraint_Error with
+           "Position cursor of function Key equals No_Element";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in function Key");
+
       return Position.Node.Key;
    end Key;
 
@@ -606,12 +620,12 @@ 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
          return No_Element;
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in function Next");
+
       declare
          HT   : Hash_Table_Type renames Position.Container.HT;
          Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
@@ -640,12 +654,13 @@ package body Ada.Containers.Hashed_Maps is
                    procedure (Key : Key_Type; Element : Element_Type))
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Query_Element");
-
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Position cursor of Query_Element equals No_Element";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Query_Element");
+
       declare
          M  : Map renames Position.Container.all;
          HT : Hash_Table_Type renames M.HT'Unrestricted_Access.all;
@@ -692,7 +707,7 @@ package body Ada.Containers.Hashed_Maps is
       Item   : out Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream map cursor";
    end Read;
 
    ---------------
@@ -728,11 +743,13 @@ package body Ada.Containers.Hashed_Maps is
 
    begin
       if Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "attempt to replace key not in map";
       end if;
 
       if Container.HT.Lock > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "Replace attempted to tamper with cursors (map is locked)";
       end if;
 
       Node.Key := Key;
@@ -749,20 +766,23 @@ package body Ada.Containers.Hashed_Maps is
       New_Item  : Element_Type)
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
-
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Position cursor of Replace_Element equals No_Element";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor of Replace_Element designates wrong map";
       end if;
 
       if Position.Container.HT.Lock > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "Replace_Element attempted to tamper with cursors (map is locked)";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
+
       Position.Node.Element := New_Item;
    end Replace_Element;
 
@@ -798,16 +818,18 @@ package body Ada.Containers.Hashed_Maps is
                                              Element : in out Element_Type))
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Update_Element");
-
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Position cursor of Update_Element equals No_Element";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor of Update_Element designates wrong map";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Update_Element");
+
       declare
          HT : Hash_Table_Type renames Container.HT;
          B  : Natural renames HT.Busy;
@@ -906,7 +928,7 @@ package body Ada.Containers.Hashed_Maps is
       Item   : Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream map cursor";
    end Write;
 
    ----------------

gcc/ada/a-cohase.adb

@@ -207,7 +207,7 @@ package body Ada.Containers.Hashed_Sets is
       Element_Keys.Delete_Key_Sans_Free (Container.HT, Item, X);
 
       if X = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "attempt to delete element not in set";
       end if;
 
       Free (X);
@@ -218,20 +218,21 @@ 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;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with "Position cursor designates wrong set";
       end if;
 
       if Container.HT.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with elements (set is busy)";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Delete");
+
       HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
 
       Free (Position.Node);
@@ -254,12 +255,13 @@ package body Ada.Containers.Hashed_Sets is
          return;
       end if;
 
-      if Source.Length = 0 then
+      if Source.HT.Length = 0 then
          return;
       end if;
 
       if Target.HT.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with elements (set is busy)";
       end if;
 
       --  TODO: This can be written in terms of a loop instead as
@@ -291,11 +293,11 @@ package body Ada.Containers.Hashed_Sets is
          return Empty_Set;
       end if;
 
-      if Left.Length = 0 then
+      if Left.HT.Length = 0 then
          return Empty_Set;
       end if;
 
-      if Right.Length = 0 then
+      if Right.HT.Length = 0 then
          return Left;
       end if;
 
@@ -353,12 +355,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;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in function Element");
+
       return Position.Node.Element;
    end Element;
 
@@ -378,39 +380,47 @@ 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 then
+         raise Constraint_Error with
+           "Left cursor of Equivalent_Elements equals No_Element";
+      end if;
 
-      if Left.Node = null
-        or else Right.Node = null
-      then
-         raise Constraint_Error;
+      if Right.Node = null then
+         raise Constraint_Error with
+           "Right cursor of Equivalent_Elements equals No_Element";
       end if;
 
+      pragma Assert (Vet (Left), "bad Left cursor in Equivalent_Elements");
+      pragma Assert (Vet (Right), "bad Right cursor in Equivalent_Elements");
+
       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;
+         raise Constraint_Error with
+           "Left cursor of Equivalent_Elements equals No_Element";
       end if;
 
+      pragma Assert (Vet (Left), "Left cursor in Equivalent_Elements is bad");
+
       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;
+         raise Constraint_Error with
+           "Right cursor of Equivalent_Elements equals No_Element";
       end if;
 
+      pragma Assert
+        (Vet (Right),
+         "Right cursor of Equivalent_Elements is bad");
+
       return Equivalent_Elements (Left, Right.Node.Element);
    end Equivalent_Elements;
 
@@ -584,7 +594,8 @@ package body Ada.Containers.Hashed_Sets is
 
       if not Inserted then
          if Container.HT.Lock > 0 then
-            raise Program_Error;
+            raise Program_Error with
+              "attempt to tamper with cursors (set is locked)";
          end if;
 
          Position.Node.Element := New_Item;
@@ -617,7 +628,8 @@ package body Ada.Containers.Hashed_Sets is
       Insert (Container, New_Item, Position, Inserted);
 
       if not Inserted then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "attempt to insert element already in set";
       end if;
    end Insert;
 
@@ -679,7 +691,8 @@ package body Ada.Containers.Hashed_Sets is
       end if;
 
       if Target.HT.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with elements (set is busy)";
       end if;
 
       --  TODO: optimize this to use an explicit
@@ -880,12 +893,12 @@ 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
          return No_Element;
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Next");
+
       declare
          HT   : Hash_Table_Type renames Position.Container.HT;
          Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
@@ -940,12 +953,13 @@ package body Ada.Containers.Hashed_Sets is
       Process  : not null access procedure (Element : Element_Type))
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Query_Element");
-
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Position cursor of Query_Element equals No_Element";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Query_Element");
+
       declare
          HT : Hash_Table_Type renames Position.Container.HT;
 
@@ -987,7 +1001,7 @@ package body Ada.Containers.Hashed_Sets is
       Item   : out Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream set cursor";
    end Read;
 
    ---------------
@@ -1021,11 +1035,13 @@ package body Ada.Containers.Hashed_Sets is
 
    begin
       if Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "attempt to replace element not in set";
       end if;
 
       if Container.HT.Lock > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with cursors (set is locked)";
       end if;
 
       Node.Element := New_Item;
@@ -1045,7 +1061,8 @@ package body Ada.Containers.Hashed_Sets is
          pragma Assert (Hash (Node.Element) = Hash (New_Item));
 
          if HT.Lock > 0 then
-            raise Program_Error;
+            raise Program_Error with
+              "attempt to tamper with cursors (set is locked)";
          end if;
 
          Node.Element := New_Item;  --  Note that this assignment can fail
@@ -1053,7 +1070,8 @@ package body Ada.Containers.Hashed_Sets is
       end if;
 
       if HT.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with elements (set is busy)";
       end if;
 
       HT_Ops.Delete_Node_Sans_Free (HT, Node);
@@ -1129,7 +1147,7 @@ package body Ada.Containers.Hashed_Sets is
             null;
       end Reinsert_Old_Element;
 
-      raise Program_Error;
+      raise Program_Error with "attempt to replace existing element";
    end Replace_Element;
 
    procedure Replace_Element
@@ -1138,16 +1156,18 @@ package body Ada.Containers.Hashed_Sets is
       New_Item  : Element_Type)
    is
    begin
-      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
-
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Position cursor equals No_Element";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor designates wrong set";
       end if;
 
+      pragma Assert (Vet (Position), "bad cursor in Replace_Element");
+
       Replace_Element (Container.HT, Position.Node, New_Item);
    end Replace_Element;
 
@@ -1187,7 +1207,8 @@ package body Ada.Containers.Hashed_Sets is
       end if;
 
       if Target.HT.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with elements (set is busy)";
       end if;
 
       declare
@@ -1452,7 +1473,8 @@ package body Ada.Containers.Hashed_Sets is
       end if;
 
       if Target.HT.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with elements (set is busy)";
       end if;
 
       declare
@@ -1634,7 +1656,7 @@ package body Ada.Containers.Hashed_Sets is
       Item   : Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream set cursor";
    end Write;
 
    ----------------
@@ -1699,7 +1721,7 @@ package body Ada.Containers.Hashed_Sets is
          Key_Keys.Delete_Key_Sans_Free (Container.HT, Key, X);
 
          if X = null then
-            raise Constraint_Error;
+            raise Constraint_Error with "attempt to delete key not in set";
          end if;
 
          Free (X);
@@ -1716,6 +1738,10 @@ package body Ada.Containers.Hashed_Sets is
          Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
 
       begin
+         if Node = null then
+            raise Constraint_Error with "key not in map";
+         end if;
+
          return Node.Element;
       end Element;
 
@@ -1770,12 +1796,13 @@ 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;
+            raise Constraint_Error with
+              "Position cursor equals No_Element";
          end if;
 
+         pragma Assert (Vet (Position), "bad cursor in function Key");
+
          return Key (Position.Node.Element);
       end Key;
 
@@ -1793,7 +1820,8 @@ package body Ada.Containers.Hashed_Sets is
 
       begin
          if Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with
+              "attempt to replace key not in set";
          end if;
 
          Replace_Element (Container.HT, Node, New_Item);
@@ -1813,16 +1841,14 @@ package body Ada.Containers.Hashed_Sets is
          Indx : Hash_Type;
 
       begin
-         pragma Assert
-           (Vet (Position),
-            "bad cursor in Update_Element_Preserving_Key");
-
          if Position.Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with
+              "Position cursor equals No_Element";
          end if;
 
          if Position.Container /= Container'Unrestricted_Access then
-            raise Program_Error;
+            raise Program_Error with
+              "Position cursor designates wrong set";
          end if;
 
          if HT.Buckets = null
@@ -1830,9 +1856,13 @@ package body Ada.Containers.Hashed_Sets is
            or else HT.Length = 0
            or else Position.Node.Next = Position.Node
          then
-            raise Program_Error;
+            raise Program_Error with "Position cursor is bad (set is empty)";
          end if;
 
+         pragma Assert
+           (Vet (Position),
+            "bad cursor in Update_Element_Preserving_Key");
+
          Indx := HT_Ops.Index (HT, Position.Node);
 
          declare
@@ -1876,7 +1906,8 @@ package body Ada.Containers.Hashed_Sets is
                   Prev := Prev.Next;
 
                   if Prev = null then
-                     raise Program_Error;
+                     raise Program_Error with
+                       "Position cursor is bad (node not found)";
                   end if;
                end loop;
 
@@ -1893,7 +1924,7 @@ package body Ada.Containers.Hashed_Sets is
             Free (X);
          end;
 
-         raise Program_Error;
+         raise Program_Error with "key was modified";
       end Update_Element_Preserving_Key;
 
    end Generic_Keys;

gcc/ada/a-cohase.ads

@@ -179,7 +179,7 @@ package Ada.Containers.Hashed_Sets is
 
       function Element (Container : Set; Key : Key_Type) return Element_Type;
 
-      procedure Replace          --  TODO: ask Randy why this wasn't removed
+      procedure Replace
         (Container : in out Set;
          Key       : Key_Type;
          New_Item  : Element_Type);

gcc/ada/a-coormu.adb

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2006, 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 --
@@ -158,10 +158,12 @@ package body Ada.Containers.Ordered_Multisets is
 
    function "<" (Left, Right : Cursor) return Boolean is
    begin
-      if Left.Node = null
-        or else Right.Node = null
-      then
-         raise Constraint_Error;
+      if Left.Node = null then
+         raise Constraint_Error with "Left cursor equals No_Element";
+      end if;
+
+      if Right.Node = null then
+         raise Constraint_Error with "Right cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -177,7 +179,7 @@ package body Ada.Containers.Ordered_Multisets is
       return Boolean is
    begin
       if Left.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Left cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -190,7 +192,7 @@ package body Ada.Containers.Ordered_Multisets is
       return Boolean is
    begin
       if Right.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Right cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Right.Container.Tree, Right.Node),
@@ -214,10 +216,12 @@ package body Ada.Containers.Ordered_Multisets is
 
    function ">" (Left, Right : Cursor) return Boolean is
    begin
-      if Left.Node = null
-        or else Right.Node = null
-      then
-         raise Constraint_Error;
+      if Left.Node = null then
+         raise Constraint_Error with "Left cursor equals No_Element";
+      end if;
+
+      if Right.Node = null then
+         raise Constraint_Error with "Right cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -235,7 +239,7 @@ package body Ada.Containers.Ordered_Multisets is
       return Boolean is
    begin
       if Left.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Left cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -248,7 +252,7 @@ package body Ada.Containers.Ordered_Multisets is
       return Boolean is
    begin
       if Right.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Right cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Right.Container.Tree, Right.Node),
@@ -342,7 +346,8 @@ package body Ada.Containers.Ordered_Multisets is
 
    begin
       if Node = Done then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "attempt to delete element not in set";
       end if;
 
       loop
@@ -358,11 +363,11 @@ package body Ada.Containers.Ordered_Multisets is
    procedure Delete (Container : in out Set; Position : in out Cursor) is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with "Position cursor designates wrong set";
       end if;
 
       pragma Assert (Vet (Container.Tree, Position.Node),
@@ -431,7 +436,7 @@ package body Ada.Containers.Ordered_Multisets is
    function Element (Position : Cursor) return Element_Type is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Position.Container.Tree, Position.Node),
@@ -542,7 +547,7 @@ package body Ada.Containers.Ordered_Multisets is
    function First_Element (Container : Set) return Element_Type is
    begin
       if Container.Tree.First = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "set is empty";
       end if;
 
       return Container.Tree.First.Element;
@@ -650,7 +655,7 @@ package body Ada.Containers.Ordered_Multisets is
 
       begin
          if Node = Done then
-            raise Constraint_Error;
+            raise Constraint_Error with "attempt to delete key not in set";
          end if;
 
          loop
@@ -672,7 +677,7 @@ package body Ada.Containers.Ordered_Multisets is
                   Key_Keys.Find (Container.Tree, Key);
       begin
          if Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with "key not in set";
          end if;
 
          return Node.Element;
@@ -816,7 +821,8 @@ package body Ada.Containers.Ordered_Multisets is
       function Key (Position : Cursor) return Key_Type is
       begin
          if Position.Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with
+              "Position cursor equals No_Element";
          end if;
 
          pragma Assert (Vet (Position.Container.Tree, Position.Node),
@@ -868,31 +874,34 @@ package body Ada.Containers.Ordered_Multisets is
          B := B - 1;
       end Reverse_Iterate;
 
-      -----------------------------------
-      -- Update_Element_Preserving_Key --
-      -----------------------------------
+      --------------------
+      -- Update_Element --
+      --------------------
 
-      procedure Update_Element_Preserving_Key
+      procedure Update_Element
         (Container : in out Set;
          Position  : Cursor;
          Process   : not null access procedure (Element : in out Element_Type))
       is
          Tree : Tree_Type renames Container.Tree;
+         Node : constant Node_Access := Position.Node;
 
       begin
-         if Position.Node = null then
-            raise Constraint_Error;
+         if Node = null then
+            raise Constraint_Error with
+              "Position cursor equals No_Element";
          end if;
 
          if Position.Container /= Container'Unrestricted_Access then
-            raise Program_Error;
+            raise Program_Error with
+              "Position cursor designates wrong set";
          end if;
 
-         pragma Assert (Vet (Container.Tree, Position.Node),
-                        "bad cursor in Update_Element_Preserving_Key");
+         pragma Assert (Vet (Tree, Node),
+                        "bad cursor in Update_Element");
 
          declare
-            E : Element_Type renames Position.Node.Element;
+            E : Element_Type renames Node.Element;
             K : constant Key_Type := Key (E);
 
             B : Natural renames Tree.Busy;
@@ -919,15 +928,47 @@ package body Ada.Containers.Ordered_Multisets is
             end if;
          end;
 
-         declare
-            X : Node_Access := Position.Node;
+         --  Delete_Node checks busy-bit
+
+         Tree_Operations.Delete_Node_Sans_Free (Tree, Node);
+
+         Insert_New_Item : declare
+            function New_Node return Node_Access;
+            pragma Inline (New_Node);
+
+            procedure Insert_Post is
+               new Element_Keys.Generic_Insert_Post (New_Node);
+
+            procedure Unconditional_Insert is
+               new Element_Keys.Generic_Unconditional_Insert (Insert_Post);
+
+            --------------
+            -- New_Node --
+            --------------
+
+            function New_Node return Node_Access is
+            begin
+               Node.Color := Red_Black_Trees.Red;
+               Node.Parent := null;
+               Node.Left := null;
+               Node.Right := null;
+
+               return Node;
+            end New_Node;
+
+            Result : Node_Access;
+
+         --  Start of processing for Insert_New_Item
+
          begin
-            Tree_Operations.Delete_Node_Sans_Free (Tree, X);
-            Free (X);
-         end;
+            Unconditional_Insert
+              (Tree => Tree,
+               Key  => Node.Element,
+               Node => Result);
 
-         raise Program_Error;
-      end Update_Element_Preserving_Key;
+            pragma Assert (Result = Node);
+         end Insert_New_Item;
+      end Update_Element;
 
    end Generic_Keys;
 
@@ -944,7 +985,7 @@ package body Ada.Containers.Ordered_Multisets is
    -- Insert --
    ------------
 
-   procedure Insert (Container : in out Set; New_Item  : Element_Type) is
+   procedure Insert (Container : in out Set; New_Item : Element_Type) is
       Position : Cursor;
    begin
       Insert (Container, New_Item, Position);
@@ -956,11 +997,7 @@ package body Ada.Containers.Ordered_Multisets is
       Position  : out Cursor)
    is
    begin
-      Insert_Sans_Hint
-        (Container.Tree,
-         New_Item,
-         Position.Node);
-
+      Insert_Sans_Hint (Container.Tree, New_Item, Position.Node);
       Position.Container := Container'Unrestricted_Access;
    end Insert;
 
@@ -979,7 +1016,7 @@ package body Ada.Containers.Ordered_Multisets is
       procedure Insert_Post is
         new Element_Keys.Generic_Insert_Post (New_Node);
 
-      procedure Unconditional_Insert_Sans_Hint is
+      procedure Unconditional_Insert is
         new Element_Keys.Generic_Unconditional_Insert (Insert_Post);
 
       --------------
@@ -1000,10 +1037,7 @@ package body Ada.Containers.Ordered_Multisets is
    --  Start of processing for Insert_Sans_Hint
 
    begin
-      Unconditional_Insert_Sans_Hint
-        (Tree,
-         New_Item,
-         Node);
+      Unconditional_Insert (Tree, New_Item, Node);
    end Insert_Sans_Hint;
 
    ----------------------
@@ -1234,7 +1268,7 @@ package body Ada.Containers.Ordered_Multisets is
    function Last_Element (Container : Set) return Element_Type is
    begin
       if Container.Tree.Last = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "set is empty";
       end if;
 
       return Container.Tree.Last.Element;
@@ -1360,7 +1394,7 @@ package body Ada.Containers.Ordered_Multisets is
    is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Position.Container.Tree, Position.Node),
@@ -1433,7 +1467,7 @@ package body Ada.Containers.Ordered_Multisets is
       Item   : out Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream set cursor";
    end Read;
 
    ---------------------
@@ -1452,7 +1486,8 @@ package body Ada.Containers.Ordered_Multisets is
          null;
       else
          if Tree.Lock > 0 then
-            raise Program_Error;
+            raise Program_Error with
+              "attempt to tamper with cursors (set is locked)";
          end if;
 
          Node.Element := Item;
@@ -1507,11 +1542,13 @@ package body Ada.Containers.Ordered_Multisets is
    is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Position cursor equals No_Element";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor designates wrong set";
       end if;
 
       pragma Assert (Vet (Container.Tree, Position.Node),
@@ -1730,7 +1767,7 @@ package body Ada.Containers.Ordered_Multisets is
       Item   : Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream set cursor";
    end Write;
 
 end Ada.Containers.Ordered_Multisets;

gcc/ada/a-coormu.ads

@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2006, 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 --
@@ -223,7 +223,7 @@ package Ada.Containers.Ordered_Multisets is
 
       function Contains (Container : Set; Key : Key_Type) return Boolean;
 
-      procedure Update_Element_Preserving_Key
+      procedure Update_Element
         (Container : in out Set;
          Position  : Cursor;
          Process   : not null access

gcc/ada/a-coorse.adb

@@ -159,10 +159,12 @@ package body Ada.Containers.Ordered_Sets is
 
    function "<" (Left, Right : Cursor) return Boolean is
    begin
-      if Left.Node = null
-        or else Right.Node = null
-      then
-         raise Constraint_Error;
+      if Left.Node = null then
+         raise Constraint_Error with "Left cursor equals No_Element";
+      end if;
+
+      if Right.Node = null then
+         raise Constraint_Error with "Right cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -177,7 +179,7 @@ package body Ada.Containers.Ordered_Sets is
    function "<" (Left : Cursor; Right : Element_Type) return Boolean is
    begin
       if Left.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Left cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -189,7 +191,7 @@ package body Ada.Containers.Ordered_Sets is
    function "<" (Left : Element_Type; Right : Cursor) return Boolean is
    begin
       if Right.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Right cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Right.Container.Tree, Right.Node),
@@ -213,10 +215,12 @@ package body Ada.Containers.Ordered_Sets is
 
    function ">" (Left, Right : Cursor) return Boolean is
    begin
-      if Left.Node = null
-        or else Right.Node = null
-      then
-         raise Constraint_Error;
+      if Left.Node = null then
+         raise Constraint_Error with "Left cursor equals No_Element";
+      end if;
+
+      if Right.Node = null then
+         raise Constraint_Error with "Right cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -233,7 +237,7 @@ package body Ada.Containers.Ordered_Sets is
    function ">" (Left : Element_Type; Right : Cursor) return Boolean is
    begin
       if Right.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Right cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Right.Container.Tree, Right.Node),
@@ -245,7 +249,7 @@ package body Ada.Containers.Ordered_Sets is
    function ">" (Left : Cursor; Right : Element_Type) return Boolean is
    begin
       if Left.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Left cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Left.Container.Tree, Left.Node),
@@ -337,11 +341,11 @@ package body Ada.Containers.Ordered_Sets is
    procedure Delete (Container : in out Set; Position : in out Cursor) is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with "Position cursor designates wrong set";
       end if;
 
       pragma Assert (Vet (Container.Tree, Position.Node),
@@ -357,7 +361,7 @@ package body Ada.Containers.Ordered_Sets is
 
    begin
       if X = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "attempt to delete element not in set";
       end if;
 
       Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
@@ -417,7 +421,7 @@ package body Ada.Containers.Ordered_Sets is
    function Element (Position : Cursor) return Element_Type is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Position.Container.Tree, Position.Node),
@@ -523,7 +527,7 @@ package body Ada.Containers.Ordered_Sets is
    function First_Element (Container : Set) return Element_Type is
    begin
       if Container.Tree.First = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "set is empty";
       end if;
 
       return Container.Tree.First.Element;
@@ -628,7 +632,7 @@ package body Ada.Containers.Ordered_Sets is
 
       begin
          if X = null then
-            raise Constraint_Error;
+            raise Constraint_Error with "attempt to delete key not in set";
          end if;
 
          Delete_Node_Sans_Free (Container.Tree, X);
@@ -645,7 +649,7 @@ package body Ada.Containers.Ordered_Sets is
 
       begin
          if Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with "key not in set";
          end if;
 
          return Node.Element;
@@ -741,7 +745,8 @@ package body Ada.Containers.Ordered_Sets is
       function Key (Position : Cursor) return Key_Type is
       begin
          if Position.Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with
+              "Position cursor equals No_Element";
          end if;
 
          pragma Assert (Vet (Position.Container.Tree, Position.Node),
@@ -763,7 +768,8 @@ package body Ada.Containers.Ordered_Sets is
 
       begin
          if Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with
+              "attempt to replace key not in set";
          end if;
 
          Replace_Element (Container.Tree, Node, New_Item);
@@ -782,11 +788,13 @@ package body Ada.Containers.Ordered_Sets is
 
       begin
          if Position.Node = null then
-            raise Constraint_Error;
+            raise Constraint_Error with
+              "Position cursor equals No_Element";
          end if;
 
          if Position.Container /= Container'Unrestricted_Access then
-            raise Program_Error;
+            raise Program_Error with
+              "Position cursor designates wrong set";
          end if;
 
          pragma Assert (Vet (Container.Tree, Position.Node),
@@ -827,7 +835,7 @@ package body Ada.Containers.Ordered_Sets is
             Free (X);
          end;
 
-         raise Program_Error;
+         raise Program_Error with "key was modified";
       end Update_Element_Preserving_Key;
 
    end Generic_Keys;
@@ -854,7 +862,8 @@ package body Ada.Containers.Ordered_Sets is
 
       if not Inserted then
          if Container.Tree.Lock > 0 then
-            raise Program_Error;
+            raise Program_Error with
+              "attempt to tamper with cursors (set is locked)";
          end if;
 
          Position.Node.Element := New_Item;
@@ -892,7 +901,8 @@ package body Ada.Containers.Ordered_Sets is
       Insert (Container, New_Item, Position, Inserted);
 
       if not Inserted then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "attempt to insert element already in set";
       end if;
    end Insert;
 
@@ -1130,7 +1140,7 @@ package body Ada.Containers.Ordered_Sets is
    function Last_Element (Container : Set) return Element_Type is
    begin
       if Container.Tree.Last = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "set is empty";
       end if;
 
       return Container.Tree.Last.Element;
@@ -1256,7 +1266,7 @@ package body Ada.Containers.Ordered_Sets is
    is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with "Position cursor equals No_Element";
       end if;
 
       pragma Assert (Vet (Position.Container.Tree, Position.Node),
@@ -1331,7 +1341,7 @@ package body Ada.Containers.Ordered_Sets is
       Item   : out Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream set cursor";
    end Read;
 
    -------------
@@ -1344,11 +1354,13 @@ package body Ada.Containers.Ordered_Sets is
 
    begin
       if Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "attempt to replace element not in set";
       end if;
 
       if Container.Tree.Lock > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with cursors (set is locked)";
       end if;
 
       Node.Element := New_Item;
@@ -1370,7 +1382,8 @@ package body Ada.Containers.Ordered_Sets is
          null;
       else
          if Tree.Lock > 0 then
-            raise Program_Error;
+            raise Program_Error with
+              "attempt to tamper with cursors (set is locked)";
          end if;
 
          Node.Element := Item;
@@ -1465,7 +1478,7 @@ package body Ada.Containers.Ordered_Sets is
             null;  -- Assignment must have failed
       end Reinsert_Old_Element;
 
-      raise Program_Error;
+      raise Program_Error with "attempt to replace existing element";
    end Replace_Element;
 
    procedure Replace_Element
@@ -1475,11 +1488,13 @@ package body Ada.Containers.Ordered_Sets is
    is
    begin
       if Position.Node = null then
-         raise Constraint_Error;
+         raise Constraint_Error with
+           "Position cursor equals No_Element";
       end if;
 
       if Position.Container /= Container'Unrestricted_Access then
-         raise Program_Error;
+         raise Program_Error with
+           "Position cursor designates wrong set";
       end if;
 
       pragma Assert (Vet (Container.Tree, Position.Node),
@@ -1660,7 +1675,7 @@ package body Ada.Containers.Ordered_Sets is
       Item   : Cursor)
    is
    begin
-      raise Program_Error;
+      raise Program_Error with "attempt to stream set cursor";
    end Write;
 
 end Ada.Containers.Ordered_Sets;

gcc/ada/a-crbtgk.adb

@@ -254,13 +254,14 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
       Key  : Key_Type;
       Z    : out Node_Access)
    is
-      subtype Length_Subtype is Count_Type range 0 .. Count_Type'Last - 1;
-
-      New_Length : constant Count_Type := Length_Subtype'(Tree.Length) + 1;
-
    begin
+      if Tree.Length = Count_Type'Last then
+         raise Constraint_Error with "too many elements";
+      end if;
+
       if Tree.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with cursors (container is busy)";
       end if;
 
       if Y = null
@@ -316,7 +317,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Keys is
 
       Ops.Set_Parent (Z, Y);
       Ops.Rebalance_For_Insert (Tree, Z);
-      Tree.Length := New_Length;
+      Tree.Length := Tree.Length + 1;
    end Generic_Insert_Post;
 
    -----------------------

gcc/ada/a-crbtgo.adb

@@ -7,7 +7,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 2004-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 2004-2006, 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 --
@@ -246,7 +246,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
 
    begin
       if Tree.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with cursors (container is busy)";
       end if;
 
 --    pragma Assert (Tree.Length > 0);
@@ -523,7 +524,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
       Root : Node_Access := Tree.Root;
    begin
       if Tree.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with cursors (container is busy)";
       end if;
 
       Tree := (First  => null,
@@ -672,7 +674,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
       end if;
 
       if Source.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with cursors (container is busy)";
       end if;
 
       Clear (Target);
@@ -771,7 +774,7 @@ package body Ada.Containers.Red_Black_Trees.Generic_Operations is
 
    procedure Generic_Write
      (Stream : access Root_Stream_Type'Class;
-      Tree   : in     Tree_Type)
+      Tree   : Tree_Type)
    is
       procedure Process (Node : Node_Access);
       pragma Inline (Process);

gcc/ada/a-envvar.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--              A D A . E N V I R O N M E N T _ V A R I A B L E S           --
+--                                                                          --
+--                                 B o d y                                  --
+--                                                                          --
+--            Copyright (C) 2005, Free Software Foundation, Inc.            --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, USA.                                              --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- GNAT was originally developed  by the GNAT team at  New York University. --
+-- Extensive contributions were provided by Ada Core Technologies Inc.      --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with System;
+with Interfaces.C.Strings;
+with Ada.Unchecked_Deallocation;
+
+package body Ada.Environment_Variables is
+
+   -----------
+   -- Clear --
+   -----------
+
+   procedure Clear (Name : String) is
+      procedure Clear_Env_Var (Name : System.Address);
+      pragma Import (C, Clear_Env_Var, "__gnat_unsetenv");
+
+      F_Name  : String (1 .. Name'Length + 1);
+
+   begin
+      F_Name (1 .. Name'Length) := Name;
+      F_Name (F_Name'Last)      := ASCII.NUL;
+
+      Clear_Env_Var (F_Name'Address);
+   end Clear;
+
+   -----------
+   -- Clear --
+   -----------
+
+   procedure Clear is
+      procedure Clear_Env;
+      pragma Import (C, Clear_Env, "__gnat_clearenv");
+   begin
+      Clear_Env;
+   end Clear;
+
+   ------------
+   -- Exists --
+   ------------
+
+   function Exists (Name : String) return Boolean is
+      use System;
+
+      procedure Get_Env_Value_Ptr (Name, Length, Ptr : Address);
+      pragma Import (C, Get_Env_Value_Ptr, "__gnat_getenv");
+
+      Env_Value_Ptr    : aliased Address;
+      Env_Value_Length : aliased Integer;
+      F_Name           : aliased String (1 .. Name'Length + 1);
+
+   begin
+      F_Name (1 .. Name'Length) := Name;
+      F_Name (F_Name'Last)      := ASCII.NUL;
+
+      Get_Env_Value_Ptr
+        (F_Name'Address, Env_Value_Length'Address, Env_Value_Ptr'Address);
+
+      if Env_Value_Ptr = System.Null_Address then
+         return False;
+      end if;
+
+      return True;
+   end Exists;
+
+   -------------
+   -- Iterate --
+   -------------
+
+   procedure Iterate
+     (Process : not null access procedure (Name, Value : String))
+   is
+      use Interfaces.C.Strings;
+      type C_String_Array is array (Natural) of aliased chars_ptr;
+      type C_String_Array_Access is access C_String_Array;
+
+      function Get_Env return C_String_Array_Access;
+      pragma Import (C, Get_Env, "__gnat_environ");
+
+      type String_Access is access all String;
+      procedure Free is new Ada.Unchecked_Deallocation (String, String_Access);
+
+      Env_Length : Natural := 0;
+      Env        : constant C_String_Array_Access := Get_Env;
+
+   begin
+      --  If the environment is null return directly
+
+      if Env = null then
+         return;
+      end if;
+
+      --  First get the number of environment variables
+
+      loop
+         exit when Env (Env_Length) = Null_Ptr;
+         Env_Length := Env_Length + 1;
+      end loop;
+
+      declare
+         Env_Copy : array (1 .. Env_Length) of String_Access;
+
+      begin
+         --  Copy the environment
+
+         for Iterator in 1 ..  Env_Length loop
+            Env_Copy (Iterator) := new String'(Value (Env (Iterator - 1)));
+         end loop;
+
+         --  Iterate on the environment copy
+
+         for Iterator in 1 .. Env_Length loop
+            declare
+               Current_Var : constant String := Env_Copy (Iterator).all;
+               Value_Index : Natural := Env_Copy (Iterator)'First;
+
+            begin
+               loop
+                  exit when Current_Var (Value_Index) = '=';
+                  Value_Index := Value_Index + 1;
+               end loop;
+
+               Process
+                 (Current_Var (Current_Var'First .. Value_Index - 1),
+                  Current_Var (Value_Index + 1 .. Current_Var'Last));
+            end;
+         end loop;
+
+         --  Free the copy of the environment
+
+         for Iterator in 1 .. Env_Length loop
+            Free (Env_Copy (Iterator));
+         end loop;
+      end;
+   end Iterate;
+
+   ---------
+   -- Set --
+   ---------
+
+   procedure Set (Name : String; Value : String) is
+      F_Name  : String (1 .. Name'Length + 1);
+      F_Value : String (1 .. Value'Length + 1);
+
+      procedure Set_Env_Value (Name, Value : System.Address);
+      pragma Import (C, Set_Env_Value, "__gnat_setenv");
+
+   begin
+      F_Name (1 .. Name'Length) := Name;
+      F_Name (F_Name'Last)      := ASCII.NUL;
+
+      F_Value (1 .. Value'Length) := Value;
+      F_Value (F_Value'Last)      := ASCII.NUL;
+
+      Set_Env_Value (F_Name'Address, F_Value'Address);
+   end Set;
+
+   -----------
+   -- Value --
+   -----------
+
+   function Value (Name : String) return String is
+      use System;
+
+      procedure Get_Env_Value_Ptr (Name, Length, Ptr : Address);
+      pragma Import (C, Get_Env_Value_Ptr, "__gnat_getenv");
+
+      procedure Strncpy (Astring_Addr, Cstring : Address; N : Integer);
+      pragma Import (C, Strncpy, "strncpy");
+
+      Env_Value_Ptr    : aliased Address;
+      Env_Value_Length : aliased Integer;
+      F_Name           : aliased String (1 .. Name'Length + 1);
+
+   begin
+      F_Name (1 .. Name'Length) := Name;
+      F_Name (F_Name'Last)      := ASCII.NUL;
+
+      Get_Env_Value_Ptr
+        (F_Name'Address, Env_Value_Length'Address, Env_Value_Ptr'Address);
+
+      if Env_Value_Ptr = System.Null_Address then
+         raise Constraint_Error;
+      end if;
+
+      if Env_Value_Length > 0 then
+         declare
+            Result : aliased String (1 .. Env_Value_Length);
+         begin
+            Strncpy (Result'Address, Env_Value_Ptr, Env_Value_Length);
+            return Result;
+         end;
+      else
+         return "";
+      end if;
+   end Value;
+
+end Ada.Environment_Variables;

gcc/ada/a-envvar.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT RUN-TIME COMPONENTS                         --
+--                                                                          --
+--              A D A . E N V I R O N M E N T _ V A R I A B L E S           --
+--                                                                          --
+--                                 S p e c                                  --
+--                                                                          --
+--          Copyright (C) 2005-2006, Free Software Foundation, Inc.         --
+--                                                                          --
+-- This specification is adapted from the Ada Reference Manual for use with --
+-- GNAT.  In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification,  provided that if you redistribute a --
+-- modified version,  any changes that you have made are clearly indicated. --
+---                                                                          --
+------------------------------------------------------------------------------
+
+package Ada.Environment_Variables is
+   pragma Preelaborate (Environment_Variables);
+
+   function Value (Name : String) return String;
+   --  If the external execution environment supports environment variables,
+   --  then Value returns the value of the environment variable with the given
+   --  name. If no environment variable with the given name exists, then
+   --  Constraint_Error is propagated. If the execution environment does not
+   --  support environment variables, then Program_Error is propagated.
+
+   function Exists (Name : String) return Boolean;
+   --  If the external execution environment supports environment variables and
+   --  an environment variable with the given name currently exists, then
+   --  Exists returns True; otherwise it returns False.
+
+   procedure Set (Name : String; Value : String);
+   --  If the external execution environment supports environment variables,
+   --  then Set first clears any existing environment variable with the given
+   --  name, and then defines a single new environment variable with the given
+   --  name and value. Otherwise Program_Error is propagated.
+   --  If implementation-defined circumstances prohibit the definition of an
+   --  environment variable with the given name and value, then
+   --  Constraint_Error is propagated.
+   --  It is implementation defined whether there exist values for which the
+   --  call Set(Name, Value) has the same effect as Clear (Name).
+
+   procedure Clear (Name : String);
+   --  If the external execution environment supports environment variables,
+   --  then Clear deletes all existing environment variables with the given
+   --  name. Otherwise Program_Error is propagated.
+
+   procedure Clear;
+   --  If the external execution environment supports environment variables,
+   --  then Clear deletes all existing environment variables. Otherwise
+   --  Program_Error is propagated.
+
+   procedure Iterate
+     (Process : not null access procedure (Name, Value : String));
+   --  If the external execution environment supports environment variables,
+   --  then Iterate calls the subprogram designated by Process for each
+   --  existing environment variable, passing the name and value of that
+   --  environment variable. Otherwise Program_Error is propagated.
+
+end Ada.Environment_Variables;

gcc/ada/a-rbtgso.adb

@@ -96,7 +96,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
    begin
       if Target'Address = Source'Address then
          if Target.Busy > 0 then
-            raise Program_Error;
+            raise Program_Error with
+              "attempt to tamper with cursors (container is busy)";
          end if;
 
          Clear (Target);
@@ -108,7 +109,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
       end if;
 
       if Target.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with cursors (container is busy)";
       end if;
 
       loop
@@ -222,7 +224,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
       end if;
 
       if Target.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with cursors (container is busy)";
       end if;
 
       if Source.Length = 0 then
@@ -400,7 +403,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
 
    begin
       if Target.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with cursors (container is busy)";
       end if;
 
       if Target'Address = Source'Address then
@@ -566,7 +570,8 @@ package body Ada.Containers.Red_Black_Trees.Generic_Set_Operations is
       end if;
 
       if Target.Busy > 0 then
-         raise Program_Error;
+         raise Program_Error with
+           "attempt to tamper with cursors (container is busy)";
       end if;
 
       Iterate (Source);

gcc/ada/a-stboha.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--             A D A . S T R I N G S . B O U N D E D . H A S H              --
+--                                                                          --
+--                                B o d y                                   --
+--                                                                          --
+--           Copyright (C) 2004-2006 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 --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, USA.                                              --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- This unit was originally developed by Matthew J Heaney.                  --
+------------------------------------------------------------------------------
+
+--  Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb)
+
+function Ada.Strings.Bounded.Hash (Key : Bounded.Bounded_String)
+  return Containers.Hash_Type
+is
+   use Ada.Containers;
+
+   function Rotate_Left
+     (Value  : Hash_Type;
+      Amount : Natural) return Hash_Type;
+   pragma Import (Intrinsic, Rotate_Left);
+
+   Tmp : Hash_Type;
+
+begin
+   Tmp := 0;
+   for J in 1 .. Bounded.Length (Key) loop
+      Tmp := Rotate_Left (Tmp, 3) + Character'Pos (Bounded.Element (Key, J));
+   end loop;
+
+   return Tmp;
+end Ada.Strings.Bounded.Hash;

gcc/ada/a-stboha.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--             A D A . S T R I N G S . B O U N D E D . H A S H              --
+--                                                                          --
+--                                S p e c                                   --
+--                                                                          --
+-- This specification is adapted from the Ada Reference Manual for use with --
+-- GNAT.  In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification,  provided that if you redistribute a --
+-- modified version,  any changes that you have made are clearly indicated. --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Containers;
+
+generic
+   with package Bounded is
+     new Ada.Strings.Bounded.Generic_Bounded_Length (<>);
+
+function Ada.Strings.Bounded.Hash (Key : Bounded.Bounded_String)
+    return Containers.Hash_Type;
+
+pragma Preelaborate (Ada.Strings.Bounded.Hash);

gcc/ada/a-stfiha.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--             A D A . S T R I N G S . F I X E D . H A S H                  --
+--                                                                          --
+--                                S p e c                                   --
+--                                                                          --
+-- This specification is adapted from the Ada Reference Manual for use with --
+-- GNAT.  In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification,  provided that if you redistribute a --
+-- modified version,  any changes that you have made are clearly indicated. --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Containers, Ada.Strings.Hash;
+
+function Ada.Strings.Fixed.Hash (Key : String) return Containers.Hash_Type
+   renames Ada.Strings.Hash;
+
+pragma Pure (Ada.Strings.Fixed.Hash);

gcc/ada/a-swbwha.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--   A D A . S T R I N G S . W I D E _ B O U N D E D . W I D E _ H A S H    --
+--                                                                          --
+--                                B o d y                                   --
+--                                                                          --
+--           Copyright (C) 2004-2006 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 --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, USA.                                              --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- This unit was originally developed by Matthew J Heaney.                  --
+------------------------------------------------------------------------------
+
+--  Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb)
+
+function Ada.Strings.Wide_Bounded.Wide_Hash
+  (Key : Bounded.Bounded_Wide_String)
+  return Containers.Hash_Type
+is
+   use Ada.Containers;
+
+   function Rotate_Left
+     (Value  : Hash_Type;
+      Amount : Natural) return Hash_Type;
+   pragma Import (Intrinsic, Rotate_Left);
+
+   Tmp : Hash_Type;
+
+begin
+   Tmp := 0;
+   for J in 1 .. Bounded.Length (Key) loop
+      Tmp := Rotate_Left (Tmp, 3) +
+               Wide_Character'Pos (Bounded.Element (Key, J));
+   end loop;
+
+   return Tmp;
+end Ada.Strings.Wide_Bounded.Wide_Hash;

gcc/ada/a-swbwha.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--   A D A . S T R I N G S . W I D E _ B O U N D E D . W I D E _ H A S H    --
+--                                                                          --
+--                                S p e c                                   --
+--                                                                          --
+-- This specification is adapted from the Ada Reference Manual for use with --
+-- GNAT.  In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification,  provided that if you redistribute a --
+-- modified version,  any changes that you have made are clearly indicated. --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Containers;
+
+generic
+   with package Bounded is
+     new Ada.Strings.Wide_Bounded.Generic_Bounded_Length (<>);
+
+function Ada.Strings.Wide_Bounded.Wide_Hash (Key : Bounded.Bounded_Wide_String)
+    return Containers.Hash_Type;
+
+pragma Preelaborate (Ada.Strings.Wide_Bounded.Wide_Hash);

gcc/ada/a-swfwha.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--    A D A . S T R I N G S . W I D E _ F I X E D . W I D E _ H A S H       --
+--                                                                          --
+--                                S p e c                                   --
+--                                                                          --
+-- This specification is adapted from the Ada Reference Manual for use with --
+-- GNAT.  In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification,  provided that if you redistribute a --
+-- modified version,  any changes that you have made are clearly indicated. --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Containers, Ada.Strings.Wide_Hash;
+
+function Ada.Strings.Wide_Fixed.Wide_Hash
+  (Key : Wide_String) return Containers.Hash_Type
+  renames Ada.Strings.Wide_Hash;
+
+pragma Pure (Ada.Strings.Wide_Fixed.Wide_Hash);

gcc/ada/a-szbzha.adb

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--        A D A . S T R I N G S . W I D E _ W I D E _ B O U N D E D .       --
+--                      W I D E _ W I D E _ H A S H                         --
+--                                                                          --
+--                                B o d y                                   --
+--                                                                          --
+--           Copyright (C) 2004-2006 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 --
+-- apply solely to the  contents of the part following the private keyword. --
+--                                                                          --
+-- GNAT is free software;  you can  redistribute it  and/or modify it under --
+-- terms of the  GNU General Public License as published  by the Free Soft- --
+-- ware  Foundation;  either version 2,  or (at your option) any later ver- --
+-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --
+-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --
+-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --
+-- for  more details.  You should have  received  a copy of the GNU General --
+-- Public License  distributed with GNAT;  see file COPYING.  If not, write --
+-- to  the  Free Software Foundation,  51  Franklin  Street,  Fifth  Floor, --
+-- Boston, MA 02110-1301, USA.                                              --
+--                                                                          --
+-- As a special exception,  if other files  instantiate  generics from this --
+-- unit, or you link  this unit with other files  to produce an executable, --
+-- this  unit  does not  by itself cause  the resulting  executable  to  be --
+-- covered  by the  GNU  General  Public  License.  This exception does not --
+-- however invalidate  any other reasons why  the executable file  might be --
+-- covered by the  GNU Public License.                                      --
+--                                                                          --
+-- This unit was originally developed by Matthew J Heaney.                  --
+------------------------------------------------------------------------------
+
+--  Note: source of this algorithm: GNAT.HTable.Hash (g-htable.adb)
+
+function Ada.Strings.Wide_Wide_Bounded.Wide_Wide_Hash
+  (Key : Bounded.Bounded_Wide_Wide_String)
+  return Containers.Hash_Type
+is
+   use Ada.Containers;
+
+   function Rotate_Left
+     (Value  : Hash_Type;
+      Amount : Natural) return Hash_Type;
+   pragma Import (Intrinsic, Rotate_Left);
+
+   Tmp : Hash_Type;
+
+begin
+   Tmp := 0;
+   for J in 1 .. Bounded.Length (Key) loop
+      Tmp := Rotate_Left (Tmp, 3) +
+               Wide_Wide_Character'Pos (Bounded.Element (Key, J));
+   end loop;
+
+   return Tmp;
+end Ada.Strings.Wide_Wide_Bounded.Wide_Wide_Hash;

gcc/ada/a-szbzha.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--        A D A . S T R I N G S . W I D E _ W I D E _ B O U N D E D .       --
+--                      W I D E _ W I D E _ H A S H                         --
+--                                                                          --
+--                                S p e c                                   --
+--                                                                          --
+-- This specification is adapted from the Ada Reference Manual for use with --
+-- GNAT.  In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification,  provided that if you redistribute a --
+-- modified version,  any changes that you have made are clearly indicated. --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Containers;
+
+generic
+   with package Bounded is
+     new Ada.Strings.Wide_Wide_Bounded.Generic_Bounded_Length (<>);
+
+function Ada.Strings.Wide_Wide_Bounded.Wide_Wide_Hash
+  (Key : Bounded.Bounded_Wide_Wide_String)
+  return Containers.Hash_Type;
+
+pragma Preelaborate (Ada.Strings.Wide_Wide_Bounded.Wide_Wide_Hash);

gcc/ada/a-szfzha.ads

+------------------------------------------------------------------------------
+--                                                                          --
+--                         GNAT LIBRARY COMPONENTS                          --
+--                                                                          --
+--        A D A . S T R I N G S . W I D E _ W I D E _ F I X E D .           --
+--                      W I D E _ W I D E _ H A S H                         --
+--                                                                          --
+--                                S p e c                                   --
+--                                                                          --
+-- This specification is adapted from the Ada Reference Manual for use with --
+-- GNAT.  In accordance with the copyright of that document, you can freely --
+-- copy and modify this specification,  provided that if you redistribute a --
+-- modified version,  any changes that you have made are clearly indicated. --
+--                                                                          --
+------------------------------------------------------------------------------
+
+with Ada.Containers, Ada.Strings.Wide_Wide_Hash;
+
+function Ada.Strings.Wide_Wide_Fixed.Wide_Wide_Hash
+  (Key : Wide_Wide_String) return Containers.Hash_Type
+  renames Ada.Strings.Wide_Wide_Hash;
+
+pragma Pure (Ada.Strings.Wide_Wide_Fixed.Wide_Wide_Hash);