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
This commit is contained in:
Matthew Heaney
Arnaud Charlet
parent
738819cdce
commit
ffabcde5e1
|
|
@ -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
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error with
|
||||
"Left cursor of Equivalent_Keys equals No_Element";
|
||||
end if;
|
||||
|
||||
if Right.Node = null then
|
||||
raise Constraint_Error with
|
||||
"Right cursor of Equivalent_Keys equals No_Element";
|
||||
end if;
|
||||
|
||||
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");
|
||||
|
||||
if Left.Node = null
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
end if;
|
||||
|
||||
if Left.Node.Key = null
|
||||
or else Right.Node.Key = null
|
||||
then
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
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;
|
||||
|
||||
----------------
|
||||
|
|
|
|||
|
|
@ -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
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error with
|
||||
"Left 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 Right.Node = null then
|
||||
raise Constraint_Error with
|
||||
"Right cursor of Equivalent_Elements equals No_Element";
|
||||
end if;
|
||||
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
begin
|
||||
Tree_Operations.Delete_Node_Sans_Free (Tree, X);
|
||||
Free (X);
|
||||
end;
|
||||
-- Delete_Node checks busy-bit
|
||||
|
||||
raise Program_Error;
|
||||
end Update_Element_Preserving_Key;
|
||||
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
|
||||
Unconditional_Insert
|
||||
(Tree => Tree,
|
||||
Key => Node.Element.all,
|
||||
Node => Result);
|
||||
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error with
|
||||
"Left cursor of Equivalent_Keys equals No_Element";
|
||||
end if;
|
||||
|
||||
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;
|
||||
|
||||
----------------
|
||||
|
|
|
|||
|
|
@ -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
|
||||
or else Right.Node = null
|
||||
then
|
||||
raise Constraint_Error;
|
||||
if Left.Node = null then
|
||||
raise Constraint_Error with
|
||||
"Left cursor of Equivalent_Elements equals No_Element";
|
||||
end if;
|
||||
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
begin
|
||||
Tree_Operations.Delete_Node_Sans_Free (Tree, X);
|
||||
Free (X);
|
||||
end;
|
||||
-- Delete_Node checks busy-bit
|
||||
|
||||
raise Program_Error;
|
||||
end Update_Element_Preserving_Key;
|
||||
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
|
||||
Unconditional_Insert
|
||||
(Tree => Tree,
|
||||
Key => Node.Element,
|
||||
Node => Result);
|
||||
|
||||
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;
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
||||
-----------------------
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -0,0 +1,228 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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;
|
||||
|
|
@ -0,0 +1,61 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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;
|
||||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -0,0 +1,57 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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;
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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);
|
||||
|
|
@ -0,0 +1,21 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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);
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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;
|
||||
|
|
@ -0,0 +1,25 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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);
|
||||
|
|
@ -0,0 +1,22 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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);
|
||||
|
|
@ -0,0 +1,60 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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;
|
||||
|
|
@ -0,0 +1,27 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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);
|
||||
|
|
@ -0,0 +1,23 @@
|
|||
------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- 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);
|
||||
Loading…
Reference in New Issue