-- --
-- 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 --
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
-----------------------
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);
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);
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
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;
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);
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;
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;
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;
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
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);
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;
Item : out Cursor)
is
begin
- raise Program_Error;
+ raise Program_Error with "attempt to stream set cursor";
end Read;
---------------
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;
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
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);
null;
end Reinsert_Old_Element;
- raise Program_Error;
+ raise Program_Error with "attempt to replace existing element";
end Replace_Element;
procedure Replace_Element
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;
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
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
Item : Cursor)
is
begin
- raise Program_Error;
+ raise Program_Error with "attempt to stream set cursor";
end Write;
----------------
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);
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;
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;
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);
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
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
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;
Free (X);
end;
- raise Program_Error;
+ raise Program_Error with "key was modified";
end Update_Element_Preserving_Key;
end Generic_Keys;
OSDN Git Service
