[multiple changes]
2011-10-06 Robert Dewar <dewar@adacore.com> * a-ciorse.adb, a-cihase.adb, a-cihase.ads, a-coorse.adb, a-cborse.adb, a-comutr.adb, a-ciorma.adb, a-cbmutr.adb, a-cbmutr.ads, a-cbhase.adb, a-cbhase.ads: Minor reformatting and code reorganization (use conditional expressions). 2011-10-06 Robert Dewar <dewar@adacore.com> * sem_res.adb (Resolve_Arithmetic_Op): Fix bad warning for floating divide by zero. 2011-10-06 Ed Schonberg <schonberg@adacore.com> * sem_ch6.adb: Limited interfaces that are not immutably limited are OK in return statements. From-SVN: r179629
This commit is contained in:
parent
908e19d0d0
commit
ce72a9a305
|
@ -1,3 +1,20 @@
|
||||||
|
2011-10-06 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* a-ciorse.adb, a-cihase.adb, a-cihase.ads, a-coorse.adb,
|
||||||
|
a-cborse.adb, a-comutr.adb, a-ciorma.adb, a-cbmutr.adb,
|
||||||
|
a-cbmutr.ads, a-cbhase.adb, a-cbhase.ads: Minor reformatting and code
|
||||||
|
reorganization (use conditional expressions).
|
||||||
|
|
||||||
|
2011-10-06 Robert Dewar <dewar@adacore.com>
|
||||||
|
|
||||||
|
* sem_res.adb (Resolve_Arithmetic_Op): Fix bad warning for
|
||||||
|
floating divide by zero.
|
||||||
|
|
||||||
|
2011-10-06 Ed Schonberg <schonberg@adacore.com>
|
||||||
|
|
||||||
|
* sem_ch6.adb: Limited interfaces that are not immutably limited
|
||||||
|
are OK in return statements.
|
||||||
|
|
||||||
2011-09-30 Iain Sandoe <iains@gcc.gnu.org>
|
2011-09-30 Iain Sandoe <iains@gcc.gnu.org>
|
||||||
|
|
||||||
* gcc-interface/Makefile.in (Darwin): Partial reversion of previous
|
* gcc-interface/Makefile.in (Darwin): Partial reversion of previous
|
||||||
|
|
|
@ -47,7 +47,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
overriding function First (Object : Iterator) return Cursor;
|
overriding function First (Object : Iterator) return Cursor;
|
||||||
|
|
||||||
overriding function Next
|
overriding function Next
|
||||||
(Object : Iterator;
|
(Object : Iterator;
|
||||||
Position : Cursor) return Cursor;
|
Position : Cursor) return Cursor;
|
||||||
|
|
||||||
-----------------------
|
-----------------------
|
||||||
|
@ -68,9 +68,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
Node : out Count_Type;
|
Node : out Count_Type;
|
||||||
Inserted : out Boolean);
|
Inserted : out Boolean);
|
||||||
|
|
||||||
function Is_In
|
function Is_In (HT : Set; Key : Node_Type) return Boolean;
|
||||||
(HT : Set;
|
|
||||||
Key : Node_Type) return Boolean;
|
|
||||||
pragma Inline (Is_In);
|
pragma Inline (Is_In);
|
||||||
|
|
||||||
procedure Set_Element (Node : in out Node_Type; Item : Element_Type);
|
procedure Set_Element (Node : in out Node_Type; Item : Element_Type);
|
||||||
|
@ -169,7 +167,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
N : Node_Type renames Source.Nodes (Source_Node);
|
N : Node_Type renames Source.Nodes (Source_Node);
|
||||||
X : Count_Type;
|
X : Count_Type;
|
||||||
B : Boolean;
|
B : Boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Insert (Target, N.Element, X, B);
|
Insert (Target, N.Element, X, B);
|
||||||
pragma Assert (B);
|
pragma Assert (B);
|
||||||
|
@ -233,10 +230,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
begin
|
begin
|
||||||
if Capacity = 0 then
|
if Capacity = 0 then
|
||||||
C := Source.Length;
|
C := Source.Length;
|
||||||
|
|
||||||
elsif Capacity >= Source.Length then
|
elsif Capacity >= Source.Length then
|
||||||
C := Capacity;
|
C := Capacity;
|
||||||
|
|
||||||
else
|
else
|
||||||
raise Capacity_Error with "Capacity value too small";
|
raise Capacity_Error with "Capacity value too small";
|
||||||
end if;
|
end if;
|
||||||
|
@ -396,7 +391,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
N : Node_Type renames Left.Nodes (L_Node);
|
N : Node_Type renames Left.Nodes (L_Node);
|
||||||
X : Count_Type;
|
X : Count_Type;
|
||||||
B : Boolean;
|
B : Boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if not Is_In (Right, N) then
|
if not Is_In (Right, N) then
|
||||||
Insert (Result, N.Element, X, B); -- optimize this ???
|
Insert (Result, N.Element, X, B); -- optimize this ???
|
||||||
|
@ -428,7 +422,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
declare
|
declare
|
||||||
S : Set renames Position.Container.all;
|
S : Set renames Position.Container.all;
|
||||||
N : Node_Type renames S.Nodes (Position.Node);
|
N : Node_Type renames S.Nodes (Position.Node);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
return N.Element;
|
return N.Element;
|
||||||
end;
|
end;
|
||||||
|
@ -488,6 +481,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
|
|
||||||
function Equivalent_Elements (Left, Right : Cursor)
|
function Equivalent_Elements (Left, Right : Cursor)
|
||||||
return Boolean is
|
return Boolean is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Left.Node = 0 then
|
if Left.Node = 0 then
|
||||||
raise Constraint_Error with
|
raise Constraint_Error with
|
||||||
|
@ -505,14 +499,15 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
declare
|
declare
|
||||||
LN : Node_Type renames Left.Container.Nodes (Left.Node);
|
LN : Node_Type renames Left.Container.Nodes (Left.Node);
|
||||||
RN : Node_Type renames Right.Container.Nodes (Right.Node);
|
RN : Node_Type renames Right.Container.Nodes (Right.Node);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
return Equivalent_Elements (LN.Element, RN.Element);
|
return Equivalent_Elements (LN.Element, RN.Element);
|
||||||
end;
|
end;
|
||||||
end Equivalent_Elements;
|
end Equivalent_Elements;
|
||||||
|
|
||||||
function Equivalent_Elements (Left : Cursor; Right : Element_Type)
|
function Equivalent_Elements
|
||||||
return Boolean is
|
(Left : Cursor;
|
||||||
|
Right : Element_Type) return Boolean
|
||||||
|
is
|
||||||
begin
|
begin
|
||||||
if Left.Node = 0 then
|
if Left.Node = 0 then
|
||||||
raise Constraint_Error with
|
raise Constraint_Error with
|
||||||
|
@ -528,8 +523,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
end;
|
end;
|
||||||
end Equivalent_Elements;
|
end Equivalent_Elements;
|
||||||
|
|
||||||
function Equivalent_Elements (Left : Element_Type; Right : Cursor)
|
function Equivalent_Elements
|
||||||
return Boolean is
|
(Left : Element_Type;
|
||||||
|
Right : Cursor) return Boolean
|
||||||
|
is
|
||||||
begin
|
begin
|
||||||
if Right.Node = 0 then
|
if Right.Node = 0 then
|
||||||
raise Constraint_Error with
|
raise Constraint_Error with
|
||||||
|
@ -551,8 +548,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
-- Equivalent_Keys --
|
-- Equivalent_Keys --
|
||||||
---------------------
|
---------------------
|
||||||
|
|
||||||
function Equivalent_Keys (Key : Element_Type; Node : Node_Type)
|
function Equivalent_Keys
|
||||||
return Boolean is
|
(Key : Element_Type;
|
||||||
|
Node : Node_Type) return Boolean
|
||||||
|
is
|
||||||
begin
|
begin
|
||||||
return Equivalent_Elements (Key, Node.Element);
|
return Equivalent_Elements (Key, Node.Element);
|
||||||
end Equivalent_Keys;
|
end Equivalent_Keys;
|
||||||
|
@ -580,13 +579,9 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
Item : Element_Type) return Cursor
|
Item : Element_Type) return Cursor
|
||||||
is
|
is
|
||||||
Node : constant Count_Type := Element_Keys.Find (Container, Item);
|
Node : constant Count_Type := Element_Keys.Find (Container, Item);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = 0 then
|
return (if Node = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Find;
|
end Find;
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
|
@ -595,23 +590,16 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
|
|
||||||
function First (Container : Set) return Cursor is
|
function First (Container : Set) return Cursor is
|
||||||
Node : constant Count_Type := HT_Ops.First (Container);
|
Node : constant Count_Type := HT_Ops.First (Container);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = 0 then
|
return (if Node = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end First;
|
end First;
|
||||||
|
|
||||||
overriding function First (Object : Iterator) return Cursor is
|
overriding function First (Object : Iterator) return Cursor is
|
||||||
Node : constant Count_Type := HT_Ops.First (Object.Container.all);
|
Node : constant Count_Type := HT_Ops.First (Object.Container.all);
|
||||||
begin
|
begin
|
||||||
if Node = 0 then
|
return (if Node = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Object.Container, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Object.Container, Node);
|
|
||||||
end First;
|
end First;
|
||||||
|
|
||||||
-----------------
|
-----------------
|
||||||
|
@ -999,11 +987,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
"Position cursor designates wrong set";
|
"Position cursor designates wrong set";
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Position.Node = 0 then
|
return (if Position.Node = 0 then No_Element else Next (Position));
|
||||||
return No_Element;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
return Next (Position);
|
|
||||||
end Next;
|
end Next;
|
||||||
|
|
||||||
-------------
|
-------------
|
||||||
|
@ -1143,12 +1127,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
(Container : aliased Set;
|
(Container : aliased Set;
|
||||||
Position : Cursor) return Constant_Reference_Type
|
Position : Cursor) return Constant_Reference_Type
|
||||||
is
|
is
|
||||||
|
pragma Unreferenced (Container);
|
||||||
S : Set renames Position.Container.all;
|
S : Set renames Position.Container.all;
|
||||||
N : Node_Type renames S.Nodes (Position.Node);
|
N : Node_Type renames S.Nodes (Position.Node);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
pragma Unreferenced (Container);
|
|
||||||
|
|
||||||
return (Element => N.Element'Unrestricted_Access);
|
return (Element => N.Element'Unrestricted_Access);
|
||||||
end Constant_Reference;
|
end Constant_Reference;
|
||||||
|
|
||||||
|
@ -1316,7 +1298,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
N : Node_Type renames Left.Nodes (L_Node);
|
N : Node_Type renames Left.Nodes (L_Node);
|
||||||
X : Count_Type;
|
X : Count_Type;
|
||||||
B : Boolean;
|
B : Boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if not Is_In (Right, N) then
|
if not Is_In (Right, N) then
|
||||||
Insert (Result, N.Element, X, B);
|
Insert (Result, N.Element, X, B);
|
||||||
|
@ -1344,7 +1325,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
N : Node_Type renames Right.Nodes (R_Node);
|
N : Node_Type renames Right.Nodes (R_Node);
|
||||||
X : Count_Type;
|
X : Count_Type;
|
||||||
B : Boolean;
|
B : Boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if not Is_In (Left, N) then
|
if not Is_In (Left, N) then
|
||||||
Insert (Result, N.Element, X, B);
|
Insert (Result, N.Element, X, B);
|
||||||
|
@ -1367,7 +1347,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
function To_Set (New_Item : Element_Type) return Set is
|
function To_Set (New_Item : Element_Type) return Set is
|
||||||
X : Count_Type;
|
X : Count_Type;
|
||||||
B : Boolean;
|
B : Boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
return Result : Set (1, 1) do
|
return Result : Set (1, 1) do
|
||||||
Insert (Result, New_Item, X, B);
|
Insert (Result, New_Item, X, B);
|
||||||
|
@ -1396,7 +1375,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
N : Node_Type renames Source.Nodes (Src_Node);
|
N : Node_Type renames Source.Nodes (Src_Node);
|
||||||
X : Count_Type;
|
X : Count_Type;
|
||||||
B : Boolean;
|
B : Boolean;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Insert (Target, N.Element, X, B);
|
Insert (Target, N.Element, X, B);
|
||||||
end Process;
|
end Process;
|
||||||
|
@ -1413,7 +1391,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
"attempt to tamper with cursors (set is busy)";
|
"attempt to tamper with cursors (set is busy)";
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- ???
|
-- ??? why is this code commented out ???
|
||||||
-- declare
|
-- declare
|
||||||
-- N : constant Count_Type := Target.Length + Source.Length;
|
-- N : constant Count_Type := Target.Length + Source.Length;
|
||||||
-- begin
|
-- begin
|
||||||
|
@ -1661,15 +1639,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
(Container : Set;
|
(Container : Set;
|
||||||
Key : Key_Type) return Cursor
|
Key : Key_Type) return Cursor
|
||||||
is
|
is
|
||||||
Node : constant Count_Type :=
|
Node : constant Count_Type := Key_Keys.Find (Container, Key);
|
||||||
Key_Keys.Find (Container, Key);
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = 0 then
|
return (if Node = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Find;
|
end Find;
|
||||||
|
|
||||||
---------
|
---------
|
||||||
|
@ -1684,7 +1657,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
pragma Assert (Vet (Position), "bad cursor in function Key");
|
pragma Assert (Vet (Position), "bad cursor in function Key");
|
||||||
|
|
||||||
return Key (Position.Container.Nodes (Position.Node).Element);
|
return Key (Position.Container.Nodes (Position.Node).Element);
|
||||||
end Key;
|
end Key;
|
||||||
|
|
||||||
|
@ -1697,8 +1669,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
Key : Key_Type;
|
Key : Key_Type;
|
||||||
New_Item : Element_Type)
|
New_Item : Element_Type)
|
||||||
is
|
is
|
||||||
Node : constant Count_Type :=
|
Node : constant Count_Type := Key_Keys.Find (Container, Key);
|
||||||
Key_Keys.Find (Container, Key);
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = 0 then
|
if Node = 0 then
|
||||||
|
@ -1733,7 +1704,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
"Position cursor designates wrong set";
|
"Position cursor designates wrong set";
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
-- ???
|
-- ??? why is this code commented out ???
|
||||||
-- if HT.Buckets = null
|
-- if HT.Buckets = null
|
||||||
-- or else HT.Buckets'Length = 0
|
-- or else HT.Buckets'Length = 0
|
||||||
-- or else HT.Length = 0
|
-- or else HT.Length = 0
|
||||||
|
@ -1747,7 +1718,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
(Vet (Position),
|
(Vet (Position),
|
||||||
"bad cursor in Update_Element_Preserving_Key");
|
"bad cursor in Update_Element_Preserving_Key");
|
||||||
|
|
||||||
-- Record bucket now, in case key is changed.
|
-- Record bucket now, in case key is changed
|
||||||
|
|
||||||
Indx := HT_Ops.Index (Container.Buckets, N (Position.Node));
|
Indx := HT_Ops.Index (Container.Buckets, N (Position.Node));
|
||||||
|
|
||||||
declare
|
declare
|
||||||
|
@ -1823,10 +1795,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is
|
||||||
|
|
||||||
function Reference_Preserving_Key
|
function Reference_Preserving_Key
|
||||||
(Container : aliased in out Set;
|
(Container : aliased in out Set;
|
||||||
Key : Key_Type) return Reference_Type
|
Key : Key_Type) return Reference_Type
|
||||||
is
|
is
|
||||||
Position : constant Cursor := Find (Container, Key);
|
Position : constant Cursor := Find (Container, Key);
|
||||||
N : Node_Type renames Container.Nodes (Position.Node);
|
N : Node_Type renames Container.Nodes (Position.Node);
|
||||||
begin
|
begin
|
||||||
return (Element => N.Element'Unrestricted_Access);
|
return (Element => N.Element'Unrestricted_Access);
|
||||||
end Reference_Preserving_Key;
|
end Reference_Preserving_Key;
|
||||||
|
|
|
@ -148,8 +148,7 @@ package Ada.Containers.Bounded_Hashed_Sets is
|
||||||
|
|
||||||
function Constant_Reference
|
function Constant_Reference
|
||||||
(Container : aliased Set;
|
(Container : aliased Set;
|
||||||
Position : Cursor)
|
Position : Cursor) return Constant_Reference_Type;
|
||||||
return Constant_Reference_Type;
|
|
||||||
|
|
||||||
procedure Assign (Target : in out Set; Source : Set);
|
procedure Assign (Target : in out Set; Source : Set);
|
||||||
-- If Target denotes the same object as Source, then the operation has no
|
-- If Target denotes the same object as Source, then the operation has no
|
||||||
|
@ -355,8 +354,9 @@ package Ada.Containers.Bounded_Hashed_Sets is
|
||||||
Process : not null access procedure (Position : Cursor));
|
Process : not null access procedure (Position : Cursor));
|
||||||
-- Calls Process for each node in the set
|
-- Calls Process for each node in the set
|
||||||
|
|
||||||
function Iterate (Container : Set)
|
function Iterate
|
||||||
return Set_Iterator_Interfaces.Forward_Iterator'Class;
|
(Container : Set)
|
||||||
|
return Set_Iterator_Interfaces.Forward_Iterator'Class;
|
||||||
|
|
||||||
generic
|
generic
|
||||||
type Key_Type (<>) is private;
|
type Key_Type (<>) is private;
|
||||||
|
@ -431,13 +431,11 @@ package Ada.Containers.Bounded_Hashed_Sets is
|
||||||
|
|
||||||
function Reference_Preserving_Key
|
function Reference_Preserving_Key
|
||||||
(Container : aliased in out Set;
|
(Container : aliased in out Set;
|
||||||
Position : Cursor)
|
Position : Cursor) return Reference_Type;
|
||||||
return Reference_Type;
|
|
||||||
|
|
||||||
function Reference_Preserving_Key
|
function Reference_Preserving_Key
|
||||||
(Container : aliased in out Set;
|
(Container : aliased in out Set;
|
||||||
Key : Key_Type)
|
Key : Key_Type) return Reference_Type;
|
||||||
return Reference_Type;
|
|
||||||
|
|
||||||
private
|
private
|
||||||
type Reference_Type (Element : not null access Element_Type)
|
type Reference_Type (Element : not null access Element_Type)
|
||||||
|
@ -446,7 +444,6 @@ package Ada.Containers.Bounded_Hashed_Sets is
|
||||||
end Generic_Keys;
|
end Generic_Keys;
|
||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
pragma Inline (Next);
|
pragma Inline (Next);
|
||||||
|
|
||||||
type Node_Type is record
|
type Node_Type is record
|
||||||
|
@ -519,6 +516,6 @@ private
|
||||||
for Constant_Reference_Type'Write use Write;
|
for Constant_Reference_Type'Write use Write;
|
||||||
|
|
||||||
Empty_Set : constant Set :=
|
Empty_Set : constant Set :=
|
||||||
(Hash_Table_Type with Capacity => 0, Modulus => 0);
|
(Hash_Table_Type with Capacity => 0, Modulus => 0);
|
||||||
|
|
||||||
end Ada.Containers.Bounded_Hashed_Sets;
|
end Ada.Containers.Bounded_Hashed_Sets;
|
||||||
|
|
|
@ -54,11 +54,11 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
||||||
overriding function First (Object : Child_Iterator) return Cursor;
|
overriding function First (Object : Child_Iterator) return Cursor;
|
||||||
|
|
||||||
overriding function Next
|
overriding function Next
|
||||||
(Object : Child_Iterator;
|
(Object : Child_Iterator;
|
||||||
Position : Cursor) return Cursor;
|
Position : Cursor) return Cursor;
|
||||||
|
|
||||||
overriding function Previous
|
overriding function Previous
|
||||||
(Object : Child_Iterator;
|
(Object : Child_Iterator;
|
||||||
Position : Cursor) return Cursor;
|
Position : Cursor) return Cursor;
|
||||||
|
|
||||||
overriding function Last (Object : Child_Iterator) return Cursor;
|
overriding function Last (Object : Child_Iterator) return Cursor;
|
||||||
|
@ -599,10 +599,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
||||||
begin
|
begin
|
||||||
if Capacity = 0 then
|
if Capacity = 0 then
|
||||||
C := Source.Count;
|
C := Source.Count;
|
||||||
|
|
||||||
elsif Capacity >= Source.Count then
|
elsif Capacity >= Source.Count then
|
||||||
C := Capacity;
|
C := Capacity;
|
||||||
|
|
||||||
else
|
else
|
||||||
raise Capacity_Error with "Capacity value too small";
|
raise Capacity_Error with "Capacity value too small";
|
||||||
end if;
|
end if;
|
||||||
|
@ -841,12 +839,12 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
||||||
-- nodes that contain elements that have been inserted onto the tree,
|
-- nodes that contain elements that have been inserted onto the tree,
|
||||||
-- and another for the "inactive" nodes of the free store, from which
|
-- and another for the "inactive" nodes of the free store, from which
|
||||||
-- nodes are allocated when a new child is inserted in the tree.
|
-- nodes are allocated when a new child is inserted in the tree.
|
||||||
--
|
|
||||||
-- We desire that merely declaring a tree object should have only
|
-- We desire that merely declaring a tree object should have only
|
||||||
-- minimal cost; specially, we want to avoid having to initialize the
|
-- minimal cost; specially, we want to avoid having to initialize the
|
||||||
-- free store (to fill in the links), especially if the capacity of the
|
-- free store (to fill in the links), especially if the capacity of the
|
||||||
-- tree object is large.
|
-- tree object is large.
|
||||||
--
|
|
||||||
-- The head of the free list is indicated by Container.Free. If its
|
-- The head of the free list is indicated by Container.Free. If its
|
||||||
-- value is non-negative, then the free store has been initialized in
|
-- value is non-negative, then the free store has been initialized in
|
||||||
-- the "normal" way: Container.Free points to the head of the list of
|
-- the "normal" way: Container.Free points to the head of the list of
|
||||||
|
@ -854,20 +852,20 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
||||||
-- empty. Each node on the free list has been initialized to point to
|
-- empty. Each node on the free list has been initialized to point to
|
||||||
-- the next free node (via its Next component), and the value 0 means
|
-- the next free node (via its Next component), and the value 0 means
|
||||||
-- that this is the last node of the free list.
|
-- that this is the last node of the free list.
|
||||||
--
|
|
||||||
-- If Container.Free is negative, then the links on the free store have
|
-- If Container.Free is negative, then the links on the free store have
|
||||||
-- not been initialized. In this case the link values are implied: the
|
-- not been initialized. In this case the link values are implied: the
|
||||||
-- free store comprises the components of the node array started with
|
-- free store comprises the components of the node array started with
|
||||||
-- the absolute value of Container.Free, and continuing until the end of
|
-- the absolute value of Container.Free, and continuing until the end of
|
||||||
-- the array (Nodes'Last).
|
-- the array (Nodes'Last).
|
||||||
--
|
|
||||||
-- We prefer to lazy-init the free store (in fact, we would prefer to
|
-- We prefer to lazy-init the free store (in fact, we would prefer to
|
||||||
-- not initialize it at all, because such initialization is an O(n)
|
-- not initialize it at all, because such initialization is an O(n)
|
||||||
-- operation). The time when we need to actually initialize the nodes in
|
-- operation). The time when we need to actually initialize the nodes in
|
||||||
-- the free store is when the node that becomes inactive is not at the
|
-- the free store is when the node that becomes inactive is not at the
|
||||||
-- end of the active list. The free store would then be discontigous and
|
-- end of the active list. The free store would then be discontigous and
|
||||||
-- so its nodes would need to be linked in the traditional way.
|
-- so its nodes would need to be linked in the traditional way.
|
||||||
--
|
|
||||||
-- It might be possible to perform an optimization here. Suppose that
|
-- It might be possible to perform an optimization here. Suppose that
|
||||||
-- the free store can be represented as having two parts: one comprising
|
-- the free store can be represented as having two parts: one comprising
|
||||||
-- the non-contiguous inactive nodes linked together in the normal way,
|
-- the non-contiguous inactive nodes linked together in the normal way,
|
||||||
|
@ -1218,8 +1216,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
||||||
Right_Subtree : Count_Type) return Boolean
|
Right_Subtree : Count_Type) return Boolean
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
if Left_Tree.Elements (Left_Subtree)
|
if Left_Tree.Elements (Left_Subtree) /=
|
||||||
/= Right_Tree.Elements (Right_Subtree)
|
Right_Tree.Elements (Right_Subtree)
|
||||||
then
|
then
|
||||||
return False;
|
return False;
|
||||||
end if;
|
end if;
|
||||||
|
@ -1262,7 +1260,6 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
||||||
|
|
||||||
function First (Object : Child_Iterator) return Cursor is
|
function First (Object : Child_Iterator) return Cursor is
|
||||||
Node : Count_Type'Base;
|
Node : Count_Type'Base;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Node := Object.Container.Nodes (Object.Position.Node).Children.First;
|
Node := Object.Container.Nodes (Object.Position.Node).Children.First;
|
||||||
return (Object.Container, Node);
|
return (Object.Container, Node);
|
||||||
|
@ -1722,11 +1719,9 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
||||||
|
|
||||||
function Is_Root (Position : Cursor) return Boolean is
|
function Is_Root (Position : Cursor) return Boolean is
|
||||||
begin
|
begin
|
||||||
if Position.Container = null then
|
return
|
||||||
return False;
|
(if Position.Container = null then False
|
||||||
end if;
|
else Position.Node = Root_Node (Position.Container.all));
|
||||||
|
|
||||||
return Position.Node = Root_Node (Position.Container.all);
|
|
||||||
end Is_Root;
|
end Is_Root;
|
||||||
|
|
||||||
-------------
|
-------------
|
||||||
|
@ -1839,7 +1834,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
||||||
function Iterate_Children
|
function Iterate_Children
|
||||||
(Container : Tree;
|
(Container : Tree;
|
||||||
Parent : Cursor)
|
Parent : Cursor)
|
||||||
return Tree_Iterator_Interfaces.Reversible_Iterator'Class
|
return Tree_Iterator_Interfaces.Reversible_Iterator'Class
|
||||||
is
|
is
|
||||||
pragma Unreferenced (Container);
|
pragma Unreferenced (Container);
|
||||||
begin
|
begin
|
||||||
|
@ -2039,10 +2034,9 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
||||||
end Next;
|
end Next;
|
||||||
|
|
||||||
function Next
|
function Next
|
||||||
(Object : Child_Iterator;
|
(Object : Child_Iterator;
|
||||||
Position : Cursor) return Cursor
|
Position : Cursor) return Cursor
|
||||||
is
|
is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Object.Container /= Position.Container then
|
if Object.Container /= Position.Container then
|
||||||
raise Program_Error;
|
raise Program_Error;
|
||||||
|
@ -2201,7 +2195,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is
|
||||||
--------------
|
--------------
|
||||||
|
|
||||||
overriding function Previous
|
overriding function Previous
|
||||||
(Object : Child_Iterator;
|
(Object : Child_Iterator;
|
||||||
Position : Cursor) return Cursor
|
Position : Cursor) return Cursor
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
|
|
|
@ -182,7 +182,7 @@ package Ada.Containers.Bounded_Multiway_Trees is
|
||||||
function Iterate_Children
|
function Iterate_Children
|
||||||
(Container : Tree;
|
(Container : Tree;
|
||||||
Parent : Cursor)
|
Parent : Cursor)
|
||||||
return Tree_Iterator_Interfaces.Reversible_Iterator'Class;
|
return Tree_Iterator_Interfaces.Reversible_Iterator'Class;
|
||||||
|
|
||||||
function Child_Count (Parent : Cursor) return Count_Type;
|
function Child_Count (Parent : Cursor) return Count_Type;
|
||||||
|
|
||||||
|
|
|
@ -326,7 +326,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
function New_Node return Count_Type is
|
function New_Node return Count_Type is
|
||||||
Result : Count_Type;
|
Result : Count_Type;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Allocate (Target, Result);
|
Allocate (Target, Result);
|
||||||
return Result;
|
return Result;
|
||||||
|
@ -376,13 +375,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
function Ceiling (Container : Set; Item : Element_Type) return Cursor is
|
function Ceiling (Container : Set; Item : Element_Type) return Cursor is
|
||||||
Node : constant Count_Type :=
|
Node : constant Count_Type :=
|
||||||
Element_Keys.Ceiling (Container, Item);
|
Element_Keys.Ceiling (Container, Item);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = 0 then
|
return (if Node = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Ceiling;
|
end Ceiling;
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
|
@ -425,10 +420,8 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
begin
|
begin
|
||||||
if Capacity = 0 then
|
if Capacity = 0 then
|
||||||
C := Source.Length;
|
C := Source.Length;
|
||||||
|
|
||||||
elsif Capacity >= Source.Length then
|
elsif Capacity >= Source.Length then
|
||||||
C := Capacity;
|
C := Capacity;
|
||||||
|
|
||||||
else
|
else
|
||||||
raise Capacity_Error with "Capacity value too small";
|
raise Capacity_Error with "Capacity value too small";
|
||||||
end if;
|
end if;
|
||||||
|
@ -479,7 +472,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
procedure Delete_First (Container : in out Set) is
|
procedure Delete_First (Container : in out Set) is
|
||||||
X : constant Count_Type := Container.First;
|
X : constant Count_Type := Container.First;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= 0 then
|
if X /= 0 then
|
||||||
Tree_Operations.Delete_Node_Sans_Free (Container, X);
|
Tree_Operations.Delete_Node_Sans_Free (Container, X);
|
||||||
|
@ -493,7 +485,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
procedure Delete_Last (Container : in out Set) is
|
procedure Delete_Last (Container : in out Set) is
|
||||||
X : constant Count_Type := Container.Last;
|
X : constant Count_Type := Container.Last;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= 0 then
|
if X /= 0 then
|
||||||
Tree_Operations.Delete_Node_Sans_Free (Container, X);
|
Tree_Operations.Delete_Node_Sans_Free (Container, X);
|
||||||
|
@ -533,13 +524,7 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
|
function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
|
||||||
begin
|
begin
|
||||||
if Left < Right
|
return (if Left < Right or else Right < Left then False else True);
|
||||||
or else Right < Left
|
|
||||||
then
|
|
||||||
return False;
|
|
||||||
else
|
|
||||||
return True;
|
|
||||||
end if;
|
|
||||||
end Equivalent_Elements;
|
end Equivalent_Elements;
|
||||||
|
|
||||||
---------------------
|
---------------------
|
||||||
|
@ -559,13 +544,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
function Is_Equivalent_Node_Node (L, R : Node_Type) return Boolean is
|
function Is_Equivalent_Node_Node (L, R : Node_Type) return Boolean is
|
||||||
begin
|
begin
|
||||||
if L.Element < R.Element then
|
return (if L.Element < R.Element then False
|
||||||
return False;
|
elsif R.Element < L.Element then False
|
||||||
elsif R.Element < L.Element then
|
else True);
|
||||||
return False;
|
|
||||||
else
|
|
||||||
return True;
|
|
||||||
end if;
|
|
||||||
end Is_Equivalent_Node_Node;
|
end Is_Equivalent_Node_Node;
|
||||||
|
|
||||||
-- Start of processing for Equivalent_Sets
|
-- Start of processing for Equivalent_Sets
|
||||||
|
@ -580,7 +561,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
procedure Exclude (Container : in out Set; Item : Element_Type) is
|
procedure Exclude (Container : in out Set; Item : Element_Type) is
|
||||||
X : constant Count_Type := Element_Keys.Find (Container, Item);
|
X : constant Count_Type := Element_Keys.Find (Container, Item);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= 0 then
|
if X /= 0 then
|
||||||
Tree_Operations.Delete_Node_Sans_Free (Container, X);
|
Tree_Operations.Delete_Node_Sans_Free (Container, X);
|
||||||
|
@ -594,13 +574,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
function Find (Container : Set; Item : Element_Type) return Cursor is
|
function Find (Container : Set; Item : Element_Type) return Cursor is
|
||||||
Node : constant Count_Type := Element_Keys.Find (Container, Item);
|
Node : constant Count_Type := Element_Keys.Find (Container, Item);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = 0 then
|
return (if Node = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Find;
|
end Find;
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
|
@ -609,23 +585,15 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
function First (Container : Set) return Cursor is
|
function First (Container : Set) return Cursor is
|
||||||
begin
|
begin
|
||||||
if Container.First = 0 then
|
return (if Container.First = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Container.First));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Container.First);
|
|
||||||
end First;
|
end First;
|
||||||
|
|
||||||
function First (Object : Iterator) return Cursor is
|
function First (Object : Iterator) return Cursor is
|
||||||
begin
|
begin
|
||||||
if Object.Container.First = 0 then
|
return (if Object.Container.First = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Object.Container.all'Unrestricted_Access,
|
||||||
else
|
Object.Container.First));
|
||||||
return
|
|
||||||
Cursor'(
|
|
||||||
Object.Container.all'Unrestricted_Access,
|
|
||||||
Object.Container.First);
|
|
||||||
end if;
|
|
||||||
end First;
|
end First;
|
||||||
|
|
||||||
-------------------
|
-------------------
|
||||||
|
@ -647,13 +615,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
function Floor (Container : Set; Item : Element_Type) return Cursor is
|
function Floor (Container : Set; Item : Element_Type) return Cursor is
|
||||||
Node : constant Count_Type := Element_Keys.Floor (Container, Item);
|
Node : constant Count_Type := Element_Keys.Floor (Container, Item);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = 0 then
|
return (if Node = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Floor;
|
end Floor;
|
||||||
|
|
||||||
------------------
|
------------------
|
||||||
|
@ -694,13 +658,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
|
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
|
||||||
Node : constant Count_Type :=
|
Node : constant Count_Type :=
|
||||||
Key_Keys.Ceiling (Container, Key);
|
Key_Keys.Ceiling (Container, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = 0 then
|
return (if Node = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Ceiling;
|
end Ceiling;
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
|
@ -749,13 +709,7 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
|
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
|
||||||
begin
|
begin
|
||||||
if Left < Right
|
return (if Left < Right or else Right < Left then False else True);
|
||||||
or else Right < Left
|
|
||||||
then
|
|
||||||
return False;
|
|
||||||
else
|
|
||||||
return True;
|
|
||||||
end if;
|
|
||||||
end Equivalent_Keys;
|
end Equivalent_Keys;
|
||||||
|
|
||||||
-------------
|
-------------
|
||||||
|
@ -764,7 +718,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
procedure Exclude (Container : in out Set; Key : Key_Type) is
|
procedure Exclude (Container : in out Set; Key : Key_Type) is
|
||||||
X : constant Count_Type := Key_Keys.Find (Container, Key);
|
X : constant Count_Type := Key_Keys.Find (Container, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= 0 then
|
if X /= 0 then
|
||||||
Tree_Operations.Delete_Node_Sans_Free (Container, X);
|
Tree_Operations.Delete_Node_Sans_Free (Container, X);
|
||||||
|
@ -778,13 +731,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
function Find (Container : Set; Key : Key_Type) return Cursor is
|
function Find (Container : Set; Key : Key_Type) return Cursor is
|
||||||
Node : constant Count_Type := Key_Keys.Find (Container, Key);
|
Node : constant Count_Type := Key_Keys.Find (Container, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = 0 then
|
return (if Node = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Find;
|
end Find;
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
|
@ -793,13 +742,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
function Floor (Container : Set; Key : Key_Type) return Cursor is
|
function Floor (Container : Set; Key : Key_Type) return Cursor is
|
||||||
Node : constant Count_Type := Key_Keys.Floor (Container, Key);
|
Node : constant Count_Type := Key_Keys.Floor (Container, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = 0 then
|
return (if Node = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Floor;
|
end Floor;
|
||||||
|
|
||||||
-------------------------
|
-------------------------
|
||||||
|
@ -1069,7 +1014,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
function New_Node return Count_Type is
|
function New_Node return Count_Type is
|
||||||
Result : Count_Type;
|
Result : Count_Type;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Allocate (Container, Result);
|
Allocate (Container, Result);
|
||||||
return Result;
|
return Result;
|
||||||
|
@ -1133,7 +1077,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
function New_Node return Count_Type is
|
function New_Node return Count_Type is
|
||||||
Result : Count_Type;
|
Result : Count_Type;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Allocate (Dst_Set, Result);
|
Allocate (Dst_Set, Result);
|
||||||
return Result;
|
return Result;
|
||||||
|
@ -1287,22 +1230,15 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
function Last (Container : Set) return Cursor is
|
function Last (Container : Set) return Cursor is
|
||||||
begin
|
begin
|
||||||
if Container.Last = 0 then
|
return (if Container.Last = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Container.Last));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Container.Last);
|
|
||||||
end Last;
|
end Last;
|
||||||
|
|
||||||
function Last (Object : Iterator) return Cursor is
|
function Last (Object : Iterator) return Cursor is
|
||||||
begin
|
begin
|
||||||
if Object.Container.Last = 0 then
|
return (if Object.Container.Last = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Object.Container.all'Unrestricted_Access,
|
||||||
else
|
Object.Container.Last));
|
||||||
return Cursor'(
|
|
||||||
Object.Container.all'Unrestricted_Access,
|
|
||||||
Object.Container.Last);
|
|
||||||
end if;
|
|
||||||
end Last;
|
end Last;
|
||||||
|
|
||||||
------------------
|
------------------
|
||||||
|
@ -1388,7 +1324,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
function Next (Object : Iterator; Position : Cursor) return Cursor is
|
function Next (Object : Iterator; Position : Cursor) return Cursor is
|
||||||
pragma Unreferenced (Object);
|
pragma Unreferenced (Object);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
return Next (Position);
|
return Next (Position);
|
||||||
end Next;
|
end Next;
|
||||||
|
@ -1427,13 +1362,9 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
Tree_Operations.Previous
|
Tree_Operations.Previous
|
||||||
(Position.Container.all,
|
(Position.Container.all,
|
||||||
Position.Node);
|
Position.Node);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = 0 then
|
return (if Node = 0 then No_Element
|
||||||
return No_Element;
|
else Cursor'(Position.Container, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Position.Container, Node);
|
|
||||||
end;
|
end;
|
||||||
end Previous;
|
end Previous;
|
||||||
|
|
||||||
|
@ -1466,7 +1397,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
|
|
||||||
declare
|
declare
|
||||||
S : Set renames Position.Container.all;
|
S : Set renames Position.Container.all;
|
||||||
|
|
||||||
B : Natural renames S.Busy;
|
B : Natural renames S.Busy;
|
||||||
L : Natural renames S.Lock;
|
L : Natural renames S.Lock;
|
||||||
|
|
||||||
|
@ -1608,11 +1538,10 @@ package body Ada.Containers.Bounded_Ordered_Sets is
|
||||||
function New_Node return Count_Type is
|
function New_Node return Count_Type is
|
||||||
begin
|
begin
|
||||||
Node.Element := Item;
|
Node.Element := Item;
|
||||||
Node.Color := Red_Black_Trees.Red;
|
Node.Color := Red_Black_Trees.Red;
|
||||||
Node.Parent := 0;
|
Node.Parent := 0;
|
||||||
Node.Right := 0;
|
Node.Right := 0;
|
||||||
Node.Left := 0;
|
Node.Left := 0;
|
||||||
|
|
||||||
return Index;
|
return Index;
|
||||||
end New_Node;
|
end New_Node;
|
||||||
|
|
||||||
|
|
|
@ -49,7 +49,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
overriding function First (Object : Iterator) return Cursor;
|
overriding function First (Object : Iterator) return Cursor;
|
||||||
|
|
||||||
overriding function Next
|
overriding function Next
|
||||||
(Object : Iterator;
|
(Object : Iterator;
|
||||||
Position : Cursor) return Cursor;
|
Position : Cursor) return Cursor;
|
||||||
|
|
||||||
-----------------------
|
-----------------------
|
||||||
|
@ -426,8 +426,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
-- Equivalent_Elements --
|
-- Equivalent_Elements --
|
||||||
-------------------------
|
-------------------------
|
||||||
|
|
||||||
function Equivalent_Elements (Left, Right : Cursor)
|
function Equivalent_Elements (Left, Right : Cursor) return Boolean is
|
||||||
return Boolean is
|
|
||||||
begin
|
begin
|
||||||
if Left.Node = null then
|
if Left.Node = null then
|
||||||
raise Constraint_Error with
|
raise Constraint_Error with
|
||||||
|
@ -457,8 +456,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
Right.Node.Element.all);
|
Right.Node.Element.all);
|
||||||
end Equivalent_Elements;
|
end Equivalent_Elements;
|
||||||
|
|
||||||
function Equivalent_Elements (Left : Cursor; Right : Element_Type)
|
function Equivalent_Elements
|
||||||
return Boolean is
|
(Left : Cursor;
|
||||||
|
Right : Element_Type) return Boolean
|
||||||
|
is
|
||||||
begin
|
begin
|
||||||
if Left.Node = null then
|
if Left.Node = null then
|
||||||
raise Constraint_Error with
|
raise Constraint_Error with
|
||||||
|
@ -475,8 +476,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
return Equivalent_Elements (Left.Node.Element.all, Right);
|
return Equivalent_Elements (Left.Node.Element.all, Right);
|
||||||
end Equivalent_Elements;
|
end Equivalent_Elements;
|
||||||
|
|
||||||
function Equivalent_Elements (Left : Element_Type; Right : Cursor)
|
function Equivalent_Elements
|
||||||
return Boolean is
|
(Left : Element_Type;
|
||||||
|
Right : Cursor) return Boolean
|
||||||
|
is
|
||||||
begin
|
begin
|
||||||
if Right.Node = null then
|
if Right.Node = null then
|
||||||
raise Constraint_Error with
|
raise Constraint_Error with
|
||||||
|
@ -497,8 +500,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
-- Equivalent_Keys --
|
-- Equivalent_Keys --
|
||||||
---------------------
|
---------------------
|
||||||
|
|
||||||
function Equivalent_Keys (Key : Element_Type; Node : Node_Access)
|
function Equivalent_Keys
|
||||||
return Boolean is
|
(Key : Element_Type;
|
||||||
|
Node : Node_Access) return Boolean
|
||||||
|
is
|
||||||
begin
|
begin
|
||||||
return Equivalent_Elements (Key, Node.Element.all);
|
return Equivalent_Elements (Key, Node.Element.all);
|
||||||
end Equivalent_Keys;
|
end Equivalent_Keys;
|
||||||
|
@ -535,13 +540,9 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
Item : Element_Type) return Cursor
|
Item : Element_Type) return Cursor
|
||||||
is
|
is
|
||||||
Node : constant Node_Access := Element_Keys.Find (Container.HT, Item);
|
Node : constant Node_Access := Element_Keys.Find (Container.HT, Item);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Find;
|
end Find;
|
||||||
|
|
||||||
--------------------
|
--------------------
|
||||||
|
@ -604,23 +605,16 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
|
|
||||||
function First (Container : Set) return Cursor is
|
function First (Container : Set) return Cursor is
|
||||||
Node : constant Node_Access := HT_Ops.First (Container.HT);
|
Node : constant Node_Access := HT_Ops.First (Container.HT);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end First;
|
end First;
|
||||||
|
|
||||||
function First (Object : Iterator) return Cursor is
|
function First (Object : Iterator) return Cursor is
|
||||||
Node : constant Node_Access := HT_Ops.First (Object.Container.HT);
|
Node : constant Node_Access := HT_Ops.First (Object.Container.HT);
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Object.Container, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Object.Container, Node);
|
|
||||||
end First;
|
end First;
|
||||||
|
|
||||||
----------
|
----------
|
||||||
|
@ -750,7 +744,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
|
|
||||||
function New_Node (Next : Node_Access) return Node_Access is
|
function New_Node (Next : Node_Access) return Node_Access is
|
||||||
Element : Element_Access := new Element_Type'(New_Item);
|
Element : Element_Access := new Element_Type'(New_Item);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
return new Node_Type'(Element, Next);
|
return new Node_Type'(Element, Next);
|
||||||
exception
|
exception
|
||||||
|
@ -1025,13 +1018,9 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
declare
|
declare
|
||||||
HT : Hash_Table_Type renames Position.Container.HT;
|
HT : Hash_Table_Type renames Position.Container.HT;
|
||||||
Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
|
Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Position.Container, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Position.Container, Node);
|
|
||||||
end;
|
end;
|
||||||
end Next;
|
end Next;
|
||||||
|
|
||||||
|
@ -1041,7 +1030,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
end Next;
|
end Next;
|
||||||
|
|
||||||
function Next
|
function Next
|
||||||
(Object : Iterator;
|
(Object : Iterator;
|
||||||
Position : Cursor) return Cursor
|
Position : Cursor) return Cursor
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
|
@ -1050,11 +1039,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
"Position cursor designates wrong set";
|
"Position cursor designates wrong set";
|
||||||
end if;
|
end if;
|
||||||
|
|
||||||
if Position.Node = null then
|
return (if Position.Node = null then No_Element else Next (Position));
|
||||||
return No_Element;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
return Next (Position);
|
|
||||||
end Next;
|
end Next;
|
||||||
|
|
||||||
-------------
|
-------------
|
||||||
|
@ -1166,7 +1151,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
(Stream : not null access Root_Stream_Type'Class) return Node_Access
|
(Stream : not null access Root_Stream_Type'Class) return Node_Access
|
||||||
is
|
is
|
||||||
X : Element_Access := new Element_Type'(Element_Type'Input (Stream));
|
X : Element_Access := new Element_Type'(Element_Type'Input (Stream));
|
||||||
|
|
||||||
begin
|
begin
|
||||||
return new Node_Type'(X, null);
|
return new Node_Type'(X, null);
|
||||||
exception
|
exception
|
||||||
|
@ -1183,9 +1167,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
(Container : aliased Set;
|
(Container : aliased Set;
|
||||||
Position : Cursor) return Constant_Reference_Type
|
Position : Cursor) return Constant_Reference_Type
|
||||||
is
|
is
|
||||||
begin
|
|
||||||
pragma Unreferenced (Container);
|
pragma Unreferenced (Container);
|
||||||
|
begin
|
||||||
return (Element => Position.Node.Element);
|
return (Element => Position.Node.Element);
|
||||||
end Constant_Reference;
|
end Constant_Reference;
|
||||||
|
|
||||||
|
@ -1301,8 +1284,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
Iterate_Source_When_Empty_Target : declare
|
Iterate_Source_When_Empty_Target : declare
|
||||||
procedure Process (Src_Node : Node_Access);
|
procedure Process (Src_Node : Node_Access);
|
||||||
|
|
||||||
procedure Iterate is
|
procedure Iterate is new HT_Ops.Generic_Iteration (Process);
|
||||||
new HT_Ops.Generic_Iteration (Process);
|
|
||||||
|
|
||||||
-------------
|
-------------
|
||||||
-- Process --
|
-- Process --
|
||||||
|
@ -1535,12 +1517,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
------------
|
------------
|
||||||
|
|
||||||
function To_Set (New_Item : Element_Type) return Set is
|
function To_Set (New_Item : Element_Type) return Set is
|
||||||
HT : Hash_Table_Type;
|
HT : Hash_Table_Type;
|
||||||
|
|
||||||
Node : Node_Access;
|
Node : Node_Access;
|
||||||
Inserted : Boolean;
|
Inserted : Boolean;
|
||||||
pragma Unreferenced (Node, Inserted);
|
pragma Unreferenced (Node, Inserted);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Insert (HT, New_Item, Node, Inserted);
|
Insert (HT, New_Item, Node, Inserted);
|
||||||
return Set'(Controlled with HT);
|
return Set'(Controlled with HT);
|
||||||
|
@ -1578,7 +1558,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
|
|
||||||
function New_Node (Next : Node_Access) return Node_Access is
|
function New_Node (Next : Node_Access) return Node_Access is
|
||||||
Tgt : Element_Access := new Element_Type'(Src);
|
Tgt : Element_Access := new Element_Type'(Src);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
return new Node_Type'(Tgt, Next);
|
return new Node_Type'(Tgt, Next);
|
||||||
exception
|
exception
|
||||||
|
@ -1655,14 +1634,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
-------------
|
-------------
|
||||||
|
|
||||||
procedure Process (L_Node : Node_Access) is
|
procedure Process (L_Node : Node_Access) is
|
||||||
Src : Element_Type renames L_Node.Element.all;
|
Src : Element_Type renames L_Node.Element.all;
|
||||||
|
J : constant Hash_Type := Hash (Src) mod Buckets'Length;
|
||||||
J : constant Hash_Type := Hash (Src) mod Buckets'Length;
|
|
||||||
|
|
||||||
Bucket : Node_Access renames Buckets (J);
|
Bucket : Node_Access renames Buckets (J);
|
||||||
|
Tgt : Element_Access := new Element_Type'(Src);
|
||||||
Tgt : Element_Access := new Element_Type'(Src);
|
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Bucket := new Node_Type'(Tgt, Bucket);
|
Bucket := new Node_Type'(Tgt, Bucket);
|
||||||
exception
|
exception
|
||||||
|
@ -1940,13 +1915,9 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
Key : Key_Type) return Cursor
|
Key : Key_Type) return Cursor
|
||||||
is
|
is
|
||||||
Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
|
Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Find;
|
end Find;
|
||||||
|
|
||||||
---------
|
---------
|
||||||
|
@ -2106,7 +2077,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
|
|
||||||
function Reference_Preserving_Key
|
function Reference_Preserving_Key
|
||||||
(Container : aliased in out Set;
|
(Container : aliased in out Set;
|
||||||
Key : Key_Type) return Reference_Type
|
Key : Key_Type) return Reference_Type
|
||||||
is
|
is
|
||||||
Position : constant Cursor := Find (Container, Key);
|
Position : constant Cursor := Find (Container, Key);
|
||||||
begin
|
begin
|
||||||
|
|
|
@ -414,13 +414,11 @@ package Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
|
|
||||||
function Reference_Preserving_Key
|
function Reference_Preserving_Key
|
||||||
(Container : aliased in out Set;
|
(Container : aliased in out Set;
|
||||||
Position : Cursor)
|
Position : Cursor) return Reference_Type;
|
||||||
return Reference_Type;
|
|
||||||
|
|
||||||
function Reference_Preserving_Key
|
function Reference_Preserving_Key
|
||||||
(Container : aliased in out Set;
|
(Container : aliased in out Set;
|
||||||
Key : Key_Type)
|
Key : Key_Type) return Reference_Type;
|
||||||
return Reference_Type;
|
|
||||||
|
|
||||||
private
|
private
|
||||||
type Reference_Type (Element : not null access Element_Type)
|
type Reference_Type (Element : not null access Element_Type)
|
||||||
|
@ -428,7 +426,6 @@ package Ada.Containers.Indefinite_Hashed_Sets is
|
||||||
end Generic_Keys;
|
end Generic_Keys;
|
||||||
|
|
||||||
private
|
private
|
||||||
|
|
||||||
pragma Inline (Next);
|
pragma Inline (Next);
|
||||||
|
|
||||||
type Node_Type;
|
type Node_Type;
|
||||||
|
|
|
@ -279,8 +279,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
-- Adjust --
|
-- Adjust --
|
||||||
------------
|
------------
|
||||||
|
|
||||||
procedure Adjust is
|
procedure Adjust is new Tree_Operations.Generic_Adjust (Copy_Tree);
|
||||||
new Tree_Operations.Generic_Adjust (Copy_Tree);
|
|
||||||
|
|
||||||
procedure Adjust (Container : in out Map) is
|
procedure Adjust (Container : in out Map) is
|
||||||
begin
|
begin
|
||||||
|
@ -293,21 +292,16 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
|
|
||||||
function Ceiling (Container : Map; Key : Key_Type) return Cursor is
|
function Ceiling (Container : Map; Key : Key_Type) return Cursor is
|
||||||
Node : constant Node_Access := Key_Ops.Ceiling (Container.Tree, Key);
|
Node : constant Node_Access := Key_Ops.Ceiling (Container.Tree, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Ceiling;
|
end Ceiling;
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
-- Clear --
|
-- Clear --
|
||||||
-----------
|
-----------
|
||||||
|
|
||||||
procedure Clear is
|
procedure Clear is new Tree_Operations.Generic_Clear (Delete_Tree);
|
||||||
new Tree_Operations.Generic_Clear (Delete_Tree);
|
|
||||||
|
|
||||||
procedure Clear (Container : in out Map) is
|
procedure Clear (Container : in out Map) is
|
||||||
begin
|
begin
|
||||||
|
@ -331,7 +325,8 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
(Container : Map;
|
(Container : Map;
|
||||||
Key : Key_Type) return Constant_Reference_Type
|
Key : Key_Type) return Constant_Reference_Type
|
||||||
is
|
is
|
||||||
begin return (Element => Container.Element (Key)'Unrestricted_Access);
|
begin
|
||||||
|
return (Element => Container.Element (Key)'Unrestricted_Access);
|
||||||
end Constant_Reference;
|
end Constant_Reference;
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
|
@ -350,6 +345,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
function Copy_Node (Source : Node_Access) return Node_Access is
|
function Copy_Node (Source : Node_Access) return Node_Access is
|
||||||
K : Key_Access := new Key_Type'(Source.Key.all);
|
K : Key_Access := new Key_Type'(Source.Key.all);
|
||||||
E : Element_Access;
|
E : Element_Access;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
E := new Element_Type'(Source.Element.all);
|
E := new Element_Type'(Source.Element.all);
|
||||||
|
|
||||||
|
@ -418,7 +414,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
|
|
||||||
procedure Delete_First (Container : in out Map) is
|
procedure Delete_First (Container : in out Map) is
|
||||||
X : Node_Access := Container.Tree.First;
|
X : Node_Access := Container.Tree.First;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= null then
|
if X /= null then
|
||||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
||||||
|
@ -432,7 +427,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
|
|
||||||
procedure Delete_Last (Container : in out Map) is
|
procedure Delete_Last (Container : in out Map) is
|
||||||
X : Node_Access := Container.Tree.Last;
|
X : Node_Access := Container.Tree.Last;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= null then
|
if X /= null then
|
||||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
||||||
|
@ -479,13 +473,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
|
|
||||||
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
|
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
|
||||||
begin
|
begin
|
||||||
if Left < Right
|
return (if Left < Right or else Right < Left then False else True);
|
||||||
or else Right < Left
|
|
||||||
then
|
|
||||||
return False;
|
|
||||||
else
|
|
||||||
return True;
|
|
||||||
end if;
|
|
||||||
end Equivalent_Keys;
|
end Equivalent_Keys;
|
||||||
|
|
||||||
-------------
|
-------------
|
||||||
|
@ -494,7 +482,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
|
|
||||||
procedure Exclude (Container : in out Map; Key : Key_Type) is
|
procedure Exclude (Container : in out Map; Key : Key_Type) is
|
||||||
X : Node_Access := Key_Ops.Find (Container.Tree, Key);
|
X : Node_Access := Key_Ops.Find (Container.Tree, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= null then
|
if X /= null then
|
||||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
||||||
|
@ -508,13 +495,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
|
|
||||||
function Find (Container : Map; Key : Key_Type) return Cursor is
|
function Find (Container : Map; Key : Key_Type) return Cursor is
|
||||||
Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
|
Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Find;
|
end Find;
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
|
@ -523,25 +506,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
|
|
||||||
function First (Container : Map) return Cursor is
|
function First (Container : Map) return Cursor is
|
||||||
T : Tree_Type renames Container.Tree;
|
T : Tree_Type renames Container.Tree;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if T.First = null then
|
return (if T.First = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, T.First));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, T.First);
|
|
||||||
end First;
|
end First;
|
||||||
|
|
||||||
function First (Object : Iterator) return Cursor is
|
function First (Object : Iterator) return Cursor is
|
||||||
M : constant Map_Access := Object.Container;
|
M : constant Map_Access := Object.Container;
|
||||||
N : constant Node_Access := M.Tree.First;
|
N : constant Node_Access := M.Tree.First;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if N = null then
|
return (if N = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Object.Container.all'Unchecked_Access, N));
|
||||||
else
|
|
||||||
return Cursor'(Object.Container.all'Unchecked_Access, N);
|
|
||||||
end if;
|
|
||||||
end First;
|
end First;
|
||||||
|
|
||||||
-------------------
|
-------------------
|
||||||
|
@ -580,13 +555,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
|
|
||||||
function Floor (Container : Map; Key : Key_Type) return Cursor is
|
function Floor (Container : Map; Key : Key_Type) return Cursor is
|
||||||
Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key);
|
Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Floor;
|
end Floor;
|
||||||
|
|
||||||
----------
|
----------
|
||||||
|
@ -608,6 +579,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Free_Key (X.Key);
|
Free_Key (X.Key);
|
||||||
|
|
||||||
exception
|
exception
|
||||||
when others =>
|
when others =>
|
||||||
X.Key := null;
|
X.Key := null;
|
||||||
|
@ -625,6 +597,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Free_Element (X.Element);
|
Free_Element (X.Element);
|
||||||
|
|
||||||
exception
|
exception
|
||||||
when others =>
|
when others =>
|
||||||
X.Element := null;
|
X.Element := null;
|
||||||
|
@ -771,18 +744,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
-- Is_Equal_Node_Node --
|
-- Is_Equal_Node_Node --
|
||||||
------------------------
|
------------------------
|
||||||
|
|
||||||
function Is_Equal_Node_Node
|
function Is_Equal_Node_Node (L, R : Node_Access) return Boolean is
|
||||||
(L, R : Node_Access) return Boolean is
|
|
||||||
begin
|
begin
|
||||||
if L.Key.all < R.Key.all then
|
return (if L.Key.all < R.Key.all then False
|
||||||
return False;
|
elsif R.Key.all < L.Key.all then False
|
||||||
|
else L.Element.all = R.Element.all);
|
||||||
elsif R.Key.all < L.Key.all then
|
|
||||||
return False;
|
|
||||||
|
|
||||||
else
|
|
||||||
return L.Element.all = R.Element.all;
|
|
||||||
end if;
|
|
||||||
end Is_Equal_Node_Node;
|
end Is_Equal_Node_Node;
|
||||||
|
|
||||||
-------------------------
|
-------------------------
|
||||||
|
@ -856,12 +822,13 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
is
|
is
|
||||||
Node : constant Node_Access := Container.Tree.First;
|
Node : constant Node_Access := Container.Tree.First;
|
||||||
It : constant Iterator := (Container'Unrestricted_Access, Node);
|
It : constant Iterator := (Container'Unrestricted_Access, Node);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
return It;
|
return It;
|
||||||
end Iterate;
|
end Iterate;
|
||||||
|
|
||||||
function Iterate (Container : Map; Start : Cursor)
|
function Iterate
|
||||||
|
(Container : Map;
|
||||||
|
Start : Cursor)
|
||||||
return Map_Iterator_Interfaces.Reversible_Iterator'class
|
return Map_Iterator_Interfaces.Reversible_Iterator'class
|
||||||
is
|
is
|
||||||
It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
|
It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
|
||||||
|
@ -897,24 +864,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
|
|
||||||
function Last (Container : Map) return Cursor is
|
function Last (Container : Map) return Cursor is
|
||||||
T : Tree_Type renames Container.Tree;
|
T : Tree_Type renames Container.Tree;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if T.Last = null then
|
return (if T.Last = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, T.Last));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, T.Last);
|
|
||||||
end Last;
|
end Last;
|
||||||
|
|
||||||
function Last (Object : Iterator) return Cursor is
|
function Last (Object : Iterator) return Cursor is
|
||||||
M : constant Map_Access := Object.Container;
|
M : constant Map_Access := Object.Container;
|
||||||
N : constant Node_Access := M.Tree.Last;
|
N : constant Node_Access := M.Tree.Last;
|
||||||
begin
|
begin
|
||||||
if N = null then
|
return (if N = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Object.Container.all'Unchecked_Access, N));
|
||||||
else
|
|
||||||
return Cursor'(Object.Container.all'Unchecked_Access, N);
|
|
||||||
end if;
|
|
||||||
end Last;
|
end Last;
|
||||||
|
|
||||||
------------------
|
------------------
|
||||||
|
@ -969,8 +929,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
-- Move --
|
-- Move --
|
||||||
----------
|
----------
|
||||||
|
|
||||||
procedure Move is
|
procedure Move is new Tree_Operations.Generic_Move (Clear);
|
||||||
new Tree_Operations.Generic_Move (Clear);
|
|
||||||
|
|
||||||
procedure Move (Target : in out Map; Source : in out Map) is
|
procedure Move (Target : in out Map; Source : in out Map) is
|
||||||
begin
|
begin
|
||||||
|
@ -996,13 +955,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
declare
|
declare
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Tree_Operations.Next (Position.Node);
|
Tree_Operations.Next (Position.Node);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Position.Container, Node));
|
||||||
else
|
|
||||||
return Cursor'(Position.Container, Node);
|
|
||||||
end if;
|
|
||||||
end;
|
end;
|
||||||
end Next;
|
end Next;
|
||||||
|
|
||||||
|
@ -1016,11 +971,8 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
Position : Cursor) return Cursor
|
Position : Cursor) return Cursor
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
if Position.Node = null then
|
return (if Position.Node = null then No_Element
|
||||||
return No_Element;
|
else (Object.Container, Tree_Operations.Next (Position.Node)));
|
||||||
else
|
|
||||||
return (Object.Container, Tree_Operations.Next (Position.Node));
|
|
||||||
end if;
|
|
||||||
end Next;
|
end Next;
|
||||||
|
|
||||||
------------
|
------------
|
||||||
|
@ -1051,13 +1003,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
declare
|
declare
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Tree_Operations.Previous (Position.Node);
|
Tree_Operations.Previous (Position.Node);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Position.Container, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Position.Container, Node);
|
|
||||||
end;
|
end;
|
||||||
end Previous;
|
end Previous;
|
||||||
|
|
||||||
|
@ -1071,11 +1019,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
|
||||||
Position : Cursor) return Cursor
|
Position : Cursor) return Cursor
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
if Position.Node = null then
|
return
|
||||||
return No_Element;
|
(if Position.Node = null then No_Element
|
||||||
else
|
else (Object.Container, Tree_Operations.Previous (Position.Node)));
|
||||||
return (Object.Container, Tree_Operations.Previous (Position.Node));
|
|
||||||
end if;
|
|
||||||
end Previous;
|
end Previous;
|
||||||
|
|
||||||
-------------------
|
-------------------
|
||||||
|
|
|
@ -314,8 +314,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
-- Adjust --
|
-- Adjust --
|
||||||
------------
|
------------
|
||||||
|
|
||||||
procedure Adjust is
|
procedure Adjust is new Tree_Operations.Generic_Adjust (Copy_Tree);
|
||||||
new Tree_Operations.Generic_Adjust (Copy_Tree);
|
|
||||||
|
|
||||||
procedure Adjust (Container : in out Set) is
|
procedure Adjust (Container : in out Set) is
|
||||||
begin
|
begin
|
||||||
|
@ -329,13 +328,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
function Ceiling (Container : Set; Item : Element_Type) return Cursor is
|
function Ceiling (Container : Set; Item : Element_Type) return Cursor is
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Element_Keys.Ceiling (Container.Tree, Item);
|
Element_Keys.Ceiling (Container.Tree, Item);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Ceiling;
|
end Ceiling;
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
|
@ -433,7 +428,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
procedure Delete_First (Container : in out Set) is
|
procedure Delete_First (Container : in out Set) is
|
||||||
Tree : Tree_Type renames Container.Tree;
|
Tree : Tree_Type renames Container.Tree;
|
||||||
X : Node_Access := Tree.First;
|
X : Node_Access := Tree.First;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= null then
|
if X /= null then
|
||||||
Tree_Operations.Delete_Node_Sans_Free (Tree, X);
|
Tree_Operations.Delete_Node_Sans_Free (Tree, X);
|
||||||
|
@ -448,7 +442,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
procedure Delete_Last (Container : in out Set) is
|
procedure Delete_Last (Container : in out Set) is
|
||||||
Tree : Tree_Type renames Container.Tree;
|
Tree : Tree_Type renames Container.Tree;
|
||||||
X : Node_Access := Tree.Last;
|
X : Node_Access := Tree.Last;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= null then
|
if X /= null then
|
||||||
Tree_Operations.Delete_Node_Sans_Free (Tree, X);
|
Tree_Operations.Delete_Node_Sans_Free (Tree, X);
|
||||||
|
@ -466,8 +459,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
end Difference;
|
end Difference;
|
||||||
|
|
||||||
function Difference (Left, Right : Set) return Set is
|
function Difference (Left, Right : Set) return Set is
|
||||||
Tree : constant Tree_Type :=
|
Tree : constant Tree_Type := Set_Ops.Difference (Left.Tree, Right.Tree);
|
||||||
Set_Ops.Difference (Left.Tree, Right.Tree);
|
|
||||||
begin
|
begin
|
||||||
return Set'(Controlled with Tree);
|
return Set'(Controlled with Tree);
|
||||||
end Difference;
|
end Difference;
|
||||||
|
@ -498,9 +490,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
|
|
||||||
function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
|
function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
|
||||||
begin
|
begin
|
||||||
if Left < Right
|
if Left < Right or else Right < Left then
|
||||||
or else Right < Left
|
|
||||||
then
|
|
||||||
return False;
|
return False;
|
||||||
else
|
else
|
||||||
return True;
|
return True;
|
||||||
|
@ -547,7 +537,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
procedure Exclude (Container : in out Set; Item : Element_Type) is
|
procedure Exclude (Container : in out Set; Item : Element_Type) is
|
||||||
X : Node_Access :=
|
X : Node_Access :=
|
||||||
Element_Keys.Find (Container.Tree, Item);
|
Element_Keys.Find (Container.Tree, Item);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= null then
|
if X /= null then
|
||||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
||||||
|
@ -577,11 +566,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
|
|
||||||
function First (Container : Set) return Cursor is
|
function First (Container : Set) return Cursor is
|
||||||
begin
|
begin
|
||||||
if Container.Tree.First = null then
|
return
|
||||||
return No_Element;
|
(if Container.Tree.First = null then No_Element
|
||||||
end if;
|
else Cursor'(Container'Unrestricted_Access, Container.Tree.First));
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
|
|
||||||
end First;
|
end First;
|
||||||
|
|
||||||
function First (Object : Iterator) return Cursor is
|
function First (Object : Iterator) return Cursor is
|
||||||
|
@ -611,11 +598,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Element_Keys.Floor (Container.Tree, Item);
|
Element_Keys.Floor (Container.Tree, Item);
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
else
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end if;
|
|
||||||
end Floor;
|
end Floor;
|
||||||
|
|
||||||
----------
|
----------
|
||||||
|
@ -685,13 +669,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
|
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Key_Keys.Ceiling (Container.Tree, Key);
|
Key_Keys.Ceiling (Container.Tree, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Ceiling;
|
end Ceiling;
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
|
@ -741,9 +721,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
|
|
||||||
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
|
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
|
||||||
begin
|
begin
|
||||||
if Left < Right
|
if Left < Right or else Right < Left then
|
||||||
or else Right < Left
|
|
||||||
then
|
|
||||||
return False;
|
return False;
|
||||||
else
|
else
|
||||||
return True;
|
return True;
|
||||||
|
@ -756,7 +734,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
|
|
||||||
procedure Exclude (Container : in out Set; Key : Key_Type) is
|
procedure Exclude (Container : in out Set; Key : Key_Type) is
|
||||||
X : Node_Access := Key_Keys.Find (Container.Tree, Key);
|
X : Node_Access := Key_Keys.Find (Container.Tree, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= null then
|
if X /= null then
|
||||||
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
|
||||||
|
@ -771,13 +748,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
function Find (Container : Set; Key : Key_Type) return Cursor is
|
function Find (Container : Set; Key : Key_Type) return Cursor is
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Key_Keys.Find (Container.Tree, Key);
|
Key_Keys.Find (Container.Tree, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Find;
|
end Find;
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
|
@ -787,13 +760,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
function Floor (Container : Set; Key : Key_Type) return Cursor is
|
function Floor (Container : Set; Key : Key_Type) return Cursor is
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Key_Keys.Floor (Container.Tree, Key);
|
Key_Keys.Floor (Container.Tree, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Floor;
|
end Floor;
|
||||||
|
|
||||||
-------------------------
|
-------------------------
|
||||||
|
@ -802,7 +771,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
|
|
||||||
function Is_Greater_Key_Node
|
function Is_Greater_Key_Node
|
||||||
(Left : Key_Type;
|
(Left : Key_Type;
|
||||||
Right : Node_Access) return Boolean is
|
Right : Node_Access) return Boolean
|
||||||
|
is
|
||||||
begin
|
begin
|
||||||
return Key (Right.Element.all) < Left;
|
return Key (Right.Element.all) < Left;
|
||||||
end Is_Greater_Key_Node;
|
end Is_Greater_Key_Node;
|
||||||
|
@ -813,7 +783,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
|
|
||||||
function Is_Less_Key_Node
|
function Is_Less_Key_Node
|
||||||
(Left : Key_Type;
|
(Left : Key_Type;
|
||||||
Right : Node_Access) return Boolean is
|
Right : Node_Access) return Boolean
|
||||||
|
is
|
||||||
begin
|
begin
|
||||||
return Left < Key (Right.Element.all);
|
return Left < Key (Right.Element.all);
|
||||||
end Is_Less_Key_Node;
|
end Is_Less_Key_Node;
|
||||||
|
@ -1179,7 +1150,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
|
|
||||||
function Is_Greater_Element_Node
|
function Is_Greater_Element_Node
|
||||||
(Left : Element_Type;
|
(Left : Element_Type;
|
||||||
Right : Node_Access) return Boolean is
|
Right : Node_Access) return Boolean
|
||||||
|
is
|
||||||
begin
|
begin
|
||||||
-- e > node same as node < e
|
-- e > node same as node < e
|
||||||
|
|
||||||
|
@ -1192,7 +1164,8 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
|
|
||||||
function Is_Less_Element_Node
|
function Is_Less_Element_Node
|
||||||
(Left : Element_Type;
|
(Left : Element_Type;
|
||||||
Right : Node_Access) return Boolean is
|
Right : Node_Access) return Boolean
|
||||||
|
is
|
||||||
begin
|
begin
|
||||||
return Left < Right.Element.all;
|
return Left < Right.Element.all;
|
||||||
end Is_Less_Element_Node;
|
end Is_Less_Element_Node;
|
||||||
|
@ -1283,22 +1256,16 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
|
|
||||||
function Last (Container : Set) return Cursor is
|
function Last (Container : Set) return Cursor is
|
||||||
begin
|
begin
|
||||||
if Container.Tree.Last = null then
|
return
|
||||||
return No_Element;
|
(if Container.Tree.Last = null then No_Element
|
||||||
else
|
else Cursor'(Container'Unrestricted_Access, Container.Tree.Last));
|
||||||
return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
|
|
||||||
end if;
|
|
||||||
end Last;
|
end Last;
|
||||||
|
|
||||||
function Last (Object : Iterator) return Cursor is
|
function Last (Object : Iterator) return Cursor is
|
||||||
begin
|
begin
|
||||||
if Object.Container.Tree.Last = null then
|
return (if Object.Container.Tree.Last = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Object.Container.all'Unrestricted_Access,
|
||||||
else
|
Object.Container.Tree.Last));
|
||||||
return Cursor'(
|
|
||||||
Object.Container.all'Unrestricted_Access,
|
|
||||||
Object.Container.Tree.Last);
|
|
||||||
end if;
|
|
||||||
end Last;
|
end Last;
|
||||||
|
|
||||||
------------------
|
------------------
|
||||||
|
@ -1336,8 +1303,7 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
-- Move --
|
-- Move --
|
||||||
----------
|
----------
|
||||||
|
|
||||||
procedure Move is
|
procedure Move is new Tree_Operations.Generic_Move (Clear);
|
||||||
new Tree_Operations.Generic_Move (Clear);
|
|
||||||
|
|
||||||
procedure Move (Target : in out Set; Source : in out Set) is
|
procedure Move (Target : in out Set; Source : in out Set) is
|
||||||
begin
|
begin
|
||||||
|
@ -1369,13 +1335,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
declare
|
declare
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Tree_Operations.Next (Position.Node);
|
Tree_Operations.Next (Position.Node);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Position.Container, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Position.Container, Node);
|
|
||||||
end;
|
end;
|
||||||
end Next;
|
end Next;
|
||||||
|
|
||||||
|
@ -1431,13 +1393,9 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
declare
|
declare
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Tree_Operations.Previous (Position.Node);
|
Tree_Operations.Previous (Position.Node);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Position.Container, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Position.Container, Node);
|
|
||||||
end;
|
end;
|
||||||
end Previous;
|
end Previous;
|
||||||
|
|
||||||
|
@ -1608,15 +1566,15 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
pragma Inline (New_Node);
|
pragma Inline (New_Node);
|
||||||
|
|
||||||
procedure Local_Insert_Post is
|
procedure Local_Insert_Post is
|
||||||
new Element_Keys.Generic_Insert_Post (New_Node);
|
new Element_Keys.Generic_Insert_Post (New_Node);
|
||||||
|
|
||||||
procedure Local_Insert_Sans_Hint is
|
procedure Local_Insert_Sans_Hint is
|
||||||
new Element_Keys.Generic_Conditional_Insert (Local_Insert_Post);
|
new Element_Keys.Generic_Conditional_Insert (Local_Insert_Post);
|
||||||
|
|
||||||
procedure Local_Insert_With_Hint is
|
procedure Local_Insert_With_Hint is
|
||||||
new Element_Keys.Generic_Conditional_Insert_With_Hint
|
new Element_Keys.Generic_Conditional_Insert_With_Hint
|
||||||
(Local_Insert_Post,
|
(Local_Insert_Post,
|
||||||
Local_Insert_Sans_Hint);
|
Local_Insert_Sans_Hint);
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
-- New_Node --
|
-- New_Node --
|
||||||
|
@ -1629,7 +1587,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
Node.Parent := null;
|
Node.Parent := null;
|
||||||
Node.Right := null;
|
Node.Right := null;
|
||||||
Node.Left := null;
|
Node.Left := null;
|
||||||
|
|
||||||
return Node;
|
return Node;
|
||||||
end New_Node;
|
end New_Node;
|
||||||
|
|
||||||
|
@ -1829,12 +1786,10 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
|
||||||
------------
|
------------
|
||||||
|
|
||||||
function To_Set (New_Item : Element_Type) return Set is
|
function To_Set (New_Item : Element_Type) return Set is
|
||||||
Tree : Tree_Type;
|
Tree : Tree_Type;
|
||||||
|
|
||||||
Node : Node_Access;
|
Node : Node_Access;
|
||||||
Inserted : Boolean;
|
Inserted : Boolean;
|
||||||
pragma Unreferenced (Node, Inserted);
|
pragma Unreferenced (Node, Inserted);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Insert_Sans_Hint (Tree, New_Item, Node, Inserted);
|
Insert_Sans_Hint (Tree, New_Item, Node, Inserted);
|
||||||
return Set'(Controlled with Tree);
|
return Set'(Controlled with Tree);
|
||||||
|
|
|
@ -48,16 +48,16 @@ package body Ada.Containers.Multiway_Trees is
|
||||||
|
|
||||||
overriding function First (Object : Iterator) return Cursor;
|
overriding function First (Object : Iterator) return Cursor;
|
||||||
overriding function Next
|
overriding function Next
|
||||||
(Object : Iterator;
|
(Object : Iterator;
|
||||||
Position : Cursor) return Cursor;
|
Position : Cursor) return Cursor;
|
||||||
|
|
||||||
overriding function First (Object : Child_Iterator) return Cursor;
|
overriding function First (Object : Child_Iterator) return Cursor;
|
||||||
overriding function Next
|
overriding function Next
|
||||||
(Object : Child_Iterator;
|
(Object : Child_Iterator;
|
||||||
Position : Cursor) return Cursor;
|
Position : Cursor) return Cursor;
|
||||||
|
|
||||||
overriding function Previous
|
overriding function Previous
|
||||||
(Object : Child_Iterator;
|
(Object : Child_Iterator;
|
||||||
Position : Cursor) return Cursor;
|
Position : Cursor) return Cursor;
|
||||||
|
|
||||||
overriding function Last (Object : Child_Iterator) return Cursor;
|
overriding function Last (Object : Child_Iterator) return Cursor;
|
||||||
|
@ -327,11 +327,8 @@ package body Ada.Containers.Multiway_Trees is
|
||||||
|
|
||||||
function Child_Count (Parent : Cursor) return Count_Type is
|
function Child_Count (Parent : Cursor) return Count_Type is
|
||||||
begin
|
begin
|
||||||
if Parent = No_Element then
|
return (if Parent = No_Element
|
||||||
return 0;
|
then 0 else Child_Count (Parent.Node.Children));
|
||||||
else
|
|
||||||
return Child_Count (Parent.Node.Children);
|
|
||||||
end if;
|
|
||||||
end Child_Count;
|
end Child_Count;
|
||||||
|
|
||||||
function Child_Count (Children : Children_Type) return Count_Type is
|
function Child_Count (Children : Children_Type) return Count_Type is
|
||||||
|
@ -1010,12 +1007,10 @@ package body Ada.Containers.Multiway_Trees is
|
||||||
-- raise Program_Error with "Position cursor not in container";
|
-- raise Program_Error with "Position cursor not in container";
|
||||||
-- end if;
|
-- end if;
|
||||||
|
|
||||||
if Is_Root (Position) then
|
Result :=
|
||||||
Result := Find_In_Children (Position.Node, Item);
|
(if Is_Root (Position)
|
||||||
|
then Find_In_Children (Position.Node, Item)
|
||||||
else
|
else Find_In_Subtree (Position.Node, Item));
|
||||||
Result := Find_In_Subtree (Position.Node, Item);
|
|
||||||
end if;
|
|
||||||
|
|
||||||
if Result = null then
|
if Result = null then
|
||||||
return No_Element;
|
return No_Element;
|
||||||
|
@ -1437,7 +1432,7 @@ package body Ada.Containers.Multiway_Trees is
|
||||||
function Iterate_Children
|
function Iterate_Children
|
||||||
(Container : Tree;
|
(Container : Tree;
|
||||||
Parent : Cursor)
|
Parent : Cursor)
|
||||||
return Tree_Iterator_Interfaces.Reversible_Iterator'Class
|
return Tree_Iterator_Interfaces.Reversible_Iterator'Class
|
||||||
is
|
is
|
||||||
pragma Unreferenced (Container);
|
pragma Unreferenced (Container);
|
||||||
begin
|
begin
|
||||||
|
@ -1457,8 +1452,8 @@ package body Ada.Containers.Multiway_Trees is
|
||||||
end Iterate_Subtree;
|
end Iterate_Subtree;
|
||||||
|
|
||||||
procedure Iterate_Subtree
|
procedure Iterate_Subtree
|
||||||
(Position : Cursor;
|
(Position : Cursor;
|
||||||
Process : not null access procedure (Position : Cursor))
|
Process : not null access procedure (Position : Cursor))
|
||||||
is
|
is
|
||||||
begin
|
begin
|
||||||
if Position = No_Element then
|
if Position = No_Element then
|
||||||
|
@ -1515,6 +1510,7 @@ package body Ada.Containers.Multiway_Trees is
|
||||||
|
|
||||||
function Last_Child (Parent : Cursor) return Cursor is
|
function Last_Child (Parent : Cursor) return Cursor is
|
||||||
Node : Tree_Node_Access;
|
Node : Tree_Node_Access;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Parent = No_Element then
|
if Parent = No_Element then
|
||||||
raise Constraint_Error with "Parent cursor has no element";
|
raise Constraint_Error with "Parent cursor has no element";
|
||||||
|
@ -1575,7 +1571,7 @@ package body Ada.Containers.Multiway_Trees is
|
||||||
----------
|
----------
|
||||||
|
|
||||||
function Next
|
function Next
|
||||||
(Object : Iterator;
|
(Object : Iterator;
|
||||||
Position : Cursor) return Cursor
|
Position : Cursor) return Cursor
|
||||||
is
|
is
|
||||||
T : Tree renames Position.Container.all;
|
T : Tree renames Position.Container.all;
|
||||||
|
@ -1635,18 +1631,12 @@ package body Ada.Containers.Multiway_Trees is
|
||||||
end Next;
|
end Next;
|
||||||
|
|
||||||
function Next
|
function Next
|
||||||
(Object : Child_Iterator;
|
(Object : Child_Iterator;
|
||||||
Position : Cursor) return Cursor
|
Position : Cursor) return Cursor
|
||||||
is
|
is
|
||||||
C : constant Tree_Node_Access := Position.Node.Next;
|
C : constant Tree_Node_Access := Position.Node.Next;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if C = null then
|
return (if C = null then No_Element else (Object.Container, C));
|
||||||
return No_Element;
|
|
||||||
|
|
||||||
else
|
|
||||||
return (Object.Container, C);
|
|
||||||
end if;
|
|
||||||
end Next;
|
end Next;
|
||||||
|
|
||||||
------------------
|
------------------
|
||||||
|
@ -1773,18 +1763,12 @@ package body Ada.Containers.Multiway_Trees is
|
||||||
--------------
|
--------------
|
||||||
|
|
||||||
overriding function Previous
|
overriding function Previous
|
||||||
(Object : Child_Iterator;
|
(Object : Child_Iterator;
|
||||||
Position : Cursor) return Cursor
|
Position : Cursor) return Cursor
|
||||||
is
|
is
|
||||||
C : constant Tree_Node_Access := Position.Node.Prev;
|
C : constant Tree_Node_Access := Position.Node.Prev;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if C = null then
|
return (if C = null then No_Element else (Object.Container, C));
|
||||||
return No_Element;
|
|
||||||
|
|
||||||
else
|
|
||||||
return (Object.Container, C);
|
|
||||||
end if;
|
|
||||||
end Previous;
|
end Previous;
|
||||||
|
|
||||||
----------------------
|
----------------------
|
||||||
|
@ -1793,15 +1777,10 @@ package body Ada.Containers.Multiway_Trees is
|
||||||
|
|
||||||
function Previous_Sibling (Position : Cursor) return Cursor is
|
function Previous_Sibling (Position : Cursor) return Cursor is
|
||||||
begin
|
begin
|
||||||
if Position = No_Element then
|
return
|
||||||
return No_Element;
|
(if Position = No_Element then No_Element
|
||||||
end if;
|
elsif Position.Node.Prev = null then No_Element
|
||||||
|
else Cursor'(Position.Container, Position.Node.Prev));
|
||||||
if Position.Node.Prev = null then
|
|
||||||
return No_Element;
|
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Position.Container, Position.Node.Prev);
|
|
||||||
end Previous_Sibling;
|
end Previous_Sibling;
|
||||||
|
|
||||||
procedure Previous_Sibling (Position : in out Cursor) is
|
procedure Previous_Sibling (Position : in out Cursor) is
|
||||||
|
|
|
@ -288,13 +288,9 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
function Ceiling (Container : Set; Item : Element_Type) return Cursor is
|
function Ceiling (Container : Set; Item : Element_Type) return Cursor is
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Element_Keys.Ceiling (Container.Tree, Item);
|
Element_Keys.Ceiling (Container.Tree, Item);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Ceiling;
|
end Ceiling;
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
|
@ -385,7 +381,6 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
procedure Delete_First (Container : in out Set) is
|
procedure Delete_First (Container : in out Set) is
|
||||||
Tree : Tree_Type renames Container.Tree;
|
Tree : Tree_Type renames Container.Tree;
|
||||||
X : Node_Access := Tree.First;
|
X : Node_Access := Tree.First;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= null then
|
if X /= null then
|
||||||
Tree_Operations.Delete_Node_Sans_Free (Tree, X);
|
Tree_Operations.Delete_Node_Sans_Free (Tree, X);
|
||||||
|
@ -400,7 +395,6 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
procedure Delete_Last (Container : in out Set) is
|
procedure Delete_Last (Container : in out Set) is
|
||||||
Tree : Tree_Type renames Container.Tree;
|
Tree : Tree_Type renames Container.Tree;
|
||||||
X : Node_Access := Tree.Last;
|
X : Node_Access := Tree.Last;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= null then
|
if X /= null then
|
||||||
Tree_Operations.Delete_Node_Sans_Free (Tree, X);
|
Tree_Operations.Delete_Node_Sans_Free (Tree, X);
|
||||||
|
@ -446,13 +440,7 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
|
|
||||||
function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
|
function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
|
||||||
begin
|
begin
|
||||||
if Left < Right
|
return (if Left < Right or else Right < Left then False else True);
|
||||||
or else Right < Left
|
|
||||||
then
|
|
||||||
return False;
|
|
||||||
else
|
|
||||||
return True;
|
|
||||||
end if;
|
|
||||||
end Equivalent_Elements;
|
end Equivalent_Elements;
|
||||||
|
|
||||||
---------------------
|
---------------------
|
||||||
|
@ -472,13 +460,9 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
|
|
||||||
function Is_Equivalent_Node_Node (L, R : Node_Access) return Boolean is
|
function Is_Equivalent_Node_Node (L, R : Node_Access) return Boolean is
|
||||||
begin
|
begin
|
||||||
if L.Element < R.Element then
|
return (if L.Element < R.Element then False
|
||||||
return False;
|
elsif R.Element < L.Element then False
|
||||||
elsif R.Element < L.Element then
|
else True);
|
||||||
return False;
|
|
||||||
else
|
|
||||||
return True;
|
|
||||||
end if;
|
|
||||||
end Is_Equivalent_Node_Node;
|
end Is_Equivalent_Node_Node;
|
||||||
|
|
||||||
-- Start of processing for Equivalent_Sets
|
-- Start of processing for Equivalent_Sets
|
||||||
|
@ -508,13 +492,9 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
function Find (Container : Set; Item : Element_Type) return Cursor is
|
function Find (Container : Set; Item : Element_Type) return Cursor is
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Element_Keys.Find (Container.Tree, Item);
|
Element_Keys.Find (Container.Tree, Item);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Find;
|
end Find;
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
|
@ -523,23 +503,16 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
|
|
||||||
function First (Container : Set) return Cursor is
|
function First (Container : Set) return Cursor is
|
||||||
begin
|
begin
|
||||||
if Container.Tree.First = null then
|
return
|
||||||
return No_Element;
|
(if Container.Tree.First = null then No_Element
|
||||||
end if;
|
else Cursor'(Container'Unrestricted_Access, Container.Tree.First));
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
|
|
||||||
end First;
|
end First;
|
||||||
|
|
||||||
function First (Object : Iterator) return Cursor is
|
function First (Object : Iterator) return Cursor is
|
||||||
begin
|
begin
|
||||||
if Object.Container = null then
|
return (if Object.Container = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Object.Container.all'Unrestricted_Access,
|
||||||
else
|
Object.Container.Tree.First));
|
||||||
return
|
|
||||||
Cursor'(
|
|
||||||
Object.Container.all'Unrestricted_Access,
|
|
||||||
Object.Container.Tree.First);
|
|
||||||
end if;
|
|
||||||
end First;
|
end First;
|
||||||
|
|
||||||
-------------------
|
-------------------
|
||||||
|
@ -562,13 +535,9 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
function Floor (Container : Set; Item : Element_Type) return Cursor is
|
function Floor (Container : Set; Item : Element_Type) return Cursor is
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Element_Keys.Floor (Container.Tree, Item);
|
Element_Keys.Floor (Container.Tree, Item);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Floor;
|
end Floor;
|
||||||
|
|
||||||
----------
|
----------
|
||||||
|
@ -578,13 +547,11 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
procedure Free (X : in out Node_Access) is
|
procedure Free (X : in out Node_Access) is
|
||||||
procedure Deallocate is
|
procedure Deallocate is
|
||||||
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
|
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= null then
|
if X /= null then
|
||||||
X.Parent := X;
|
X.Parent := X;
|
||||||
X.Left := X;
|
X.Left := X;
|
||||||
X.Right := X;
|
X.Right := X;
|
||||||
|
|
||||||
Deallocate (X);
|
Deallocate (X);
|
||||||
end if;
|
end if;
|
||||||
end Free;
|
end Free;
|
||||||
|
@ -627,13 +594,9 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
|
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Key_Keys.Ceiling (Container.Tree, Key);
|
Key_Keys.Ceiling (Container.Tree, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Ceiling;
|
end Ceiling;
|
||||||
|
|
||||||
--------------
|
--------------
|
||||||
|
@ -683,13 +646,7 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
|
|
||||||
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
|
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
|
||||||
begin
|
begin
|
||||||
if Left < Right
|
return (if Left < Right or else Right < Left then False else True);
|
||||||
or else Right < Left
|
|
||||||
then
|
|
||||||
return False;
|
|
||||||
else
|
|
||||||
return True;
|
|
||||||
end if;
|
|
||||||
end Equivalent_Keys;
|
end Equivalent_Keys;
|
||||||
|
|
||||||
-------------
|
-------------
|
||||||
|
@ -698,7 +655,6 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
|
|
||||||
procedure Exclude (Container : in out Set; Key : Key_Type) is
|
procedure Exclude (Container : in out Set; Key : Key_Type) is
|
||||||
X : Node_Access := Key_Keys.Find (Container.Tree, Key);
|
X : Node_Access := Key_Keys.Find (Container.Tree, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if X /= null then
|
if X /= null then
|
||||||
Delete_Node_Sans_Free (Container.Tree, X);
|
Delete_Node_Sans_Free (Container.Tree, X);
|
||||||
|
@ -712,13 +668,9 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
|
|
||||||
function Find (Container : Set; Key : Key_Type) return Cursor is
|
function Find (Container : Set; Key : Key_Type) return Cursor is
|
||||||
Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
|
Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Find;
|
end Find;
|
||||||
|
|
||||||
-----------
|
-----------
|
||||||
|
@ -727,13 +679,9 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
|
|
||||||
function Floor (Container : Set; Key : Key_Type) return Cursor is
|
function Floor (Container : Set; Key : Key_Type) return Cursor is
|
||||||
Node : constant Node_Access := Key_Keys.Floor (Container.Tree, Key);
|
Node : constant Node_Access := Key_Keys.Floor (Container.Tree, Key);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Container'Unrestricted_Access, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Container'Unrestricted_Access, Node);
|
|
||||||
end Floor;
|
end Floor;
|
||||||
|
|
||||||
-------------------------
|
-------------------------
|
||||||
|
@ -1214,22 +1162,16 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
|
|
||||||
function Last (Container : Set) return Cursor is
|
function Last (Container : Set) return Cursor is
|
||||||
begin
|
begin
|
||||||
if Container.Tree.Last = null then
|
return
|
||||||
return No_Element;
|
(if Container.Tree.Last = null then No_Element
|
||||||
else
|
else Cursor'(Container'Unrestricted_Access, Container.Tree.Last));
|
||||||
return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
|
|
||||||
end if;
|
|
||||||
end Last;
|
end Last;
|
||||||
|
|
||||||
function Last (Object : Iterator) return Cursor is
|
function Last (Object : Iterator) return Cursor is
|
||||||
begin
|
begin
|
||||||
if Object.Container = null then
|
return (if Object.Container = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Object.Container.all'Unrestricted_Access,
|
||||||
else
|
Object.Container.Tree.Last));
|
||||||
return Cursor'(
|
|
||||||
Object.Container.all'Unrestricted_Access,
|
|
||||||
Object.Container.Tree.Last);
|
|
||||||
end if;
|
|
||||||
end Last;
|
end Last;
|
||||||
|
|
||||||
------------------
|
------------------
|
||||||
|
@ -1267,8 +1209,7 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
-- Move --
|
-- Move --
|
||||||
----------
|
----------
|
||||||
|
|
||||||
procedure Move is
|
procedure Move is new Tree_Operations.Generic_Move (Clear);
|
||||||
new Tree_Operations.Generic_Move (Clear);
|
|
||||||
|
|
||||||
procedure Move (Target : in out Set; Source : in out Set) is
|
procedure Move (Target : in out Set; Source : in out Set) is
|
||||||
begin
|
begin
|
||||||
|
@ -1291,13 +1232,9 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
declare
|
declare
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Tree_Operations.Next (Position.Node);
|
Tree_Operations.Next (Position.Node);
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Position.Container, Node));
|
||||||
end if;
|
|
||||||
|
|
||||||
return Cursor'(Position.Container, Node);
|
|
||||||
end;
|
end;
|
||||||
end Next;
|
end Next;
|
||||||
|
|
||||||
|
@ -1347,11 +1284,8 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
Node : constant Node_Access :=
|
Node : constant Node_Access :=
|
||||||
Tree_Operations.Previous (Position.Node);
|
Tree_Operations.Previous (Position.Node);
|
||||||
begin
|
begin
|
||||||
if Node = null then
|
return (if Node = null then No_Element
|
||||||
return No_Element;
|
else Cursor'(Position.Container, Node));
|
||||||
else
|
|
||||||
return Cursor'(Position.Container, Node);
|
|
||||||
end if;
|
|
||||||
end;
|
end;
|
||||||
end Previous;
|
end Previous;
|
||||||
|
|
||||||
|
@ -1429,11 +1363,9 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
(Stream : not null access Root_Stream_Type'Class) return Node_Access
|
(Stream : not null access Root_Stream_Type'Class) return Node_Access
|
||||||
is
|
is
|
||||||
Node : Node_Access := new Node_Type;
|
Node : Node_Access := new Node_Type;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
Element_Type'Read (Stream, Node.Element);
|
Element_Type'Read (Stream, Node.Element);
|
||||||
return Node;
|
return Node;
|
||||||
|
|
||||||
exception
|
exception
|
||||||
when others =>
|
when others =>
|
||||||
Free (Node);
|
Free (Node);
|
||||||
|
@ -1532,11 +1464,10 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
function New_Node return Node_Access is
|
function New_Node return Node_Access is
|
||||||
begin
|
begin
|
||||||
Node.Element := Item;
|
Node.Element := Item;
|
||||||
Node.Color := Red;
|
Node.Color := Red;
|
||||||
Node.Parent := null;
|
Node.Parent := null;
|
||||||
Node.Right := null;
|
Node.Right := null;
|
||||||
Node.Left := null;
|
Node.Left := null;
|
||||||
|
|
||||||
return Node;
|
return Node;
|
||||||
end New_Node;
|
end New_Node;
|
||||||
|
|
||||||
|
@ -1547,9 +1478,7 @@ package body Ada.Containers.Ordered_Sets is
|
||||||
-- Start of processing for Replace_Element
|
-- Start of processing for Replace_Element
|
||||||
|
|
||||||
begin
|
begin
|
||||||
if Item < Node.Element
|
if Item < Node.Element or else Node.Element < Item then
|
||||||
or else Node.Element < Item
|
|
||||||
then
|
|
||||||
null;
|
null;
|
||||||
|
|
||||||
else
|
else
|
||||||
|
|
|
@ -452,7 +452,18 @@ package body Sem_Ch6 is
|
||||||
-- incompatibility with Ada 95. Not clear whether this should be
|
-- incompatibility with Ada 95. Not clear whether this should be
|
||||||
-- enforced yet or perhaps controllable with special switch. ???
|
-- enforced yet or perhaps controllable with special switch. ???
|
||||||
|
|
||||||
if Is_Limited_Type (R_Type)
|
-- A limited interface that is not immutably limited is OK.
|
||||||
|
|
||||||
|
if Is_Limited_Interface (R_Type)
|
||||||
|
and then
|
||||||
|
not (Is_Task_Interface (R_Type)
|
||||||
|
or else Is_Protected_Interface (R_Type)
|
||||||
|
or else Is_Synchronized_Interface (R_Type))
|
||||||
|
then
|
||||||
|
null;
|
||||||
|
|
||||||
|
elsif Is_Limited_Type (R_Type)
|
||||||
|
and then not Is_Interface (R_Type)
|
||||||
and then Comes_From_Source (N)
|
and then Comes_From_Source (N)
|
||||||
and then not In_Instance_Body
|
and then not In_Instance_Body
|
||||||
and then not OK_For_Limited_Init_In_05 (R_Type, Expr)
|
and then not OK_For_Limited_Init_In_05 (R_Type, Expr)
|
||||||
|
|
|
@ -64,6 +64,7 @@ with Sem_Elab; use Sem_Elab;
|
||||||
with Sem_Eval; use Sem_Eval;
|
with Sem_Eval; use Sem_Eval;
|
||||||
with Sem_Intr; use Sem_Intr;
|
with Sem_Intr; use Sem_Intr;
|
||||||
with Sem_Util; use Sem_Util;
|
with Sem_Util; use Sem_Util;
|
||||||
|
with Targparm; use Targparm;
|
||||||
with Sem_Type; use Sem_Type;
|
with Sem_Type; use Sem_Type;
|
||||||
with Sem_Warn; use Sem_Warn;
|
with Sem_Warn; use Sem_Warn;
|
||||||
with Sinfo; use Sinfo;
|
with Sinfo; use Sinfo;
|
||||||
|
@ -4874,13 +4875,33 @@ package body Sem_Res is
|
||||||
(Is_Real_Type (Etype (Rop))
|
(Is_Real_Type (Etype (Rop))
|
||||||
and then Expr_Value_R (Rop) = Ureal_0))
|
and then Expr_Value_R (Rop) = Ureal_0))
|
||||||
then
|
then
|
||||||
-- Specialize the warning message according to the operation
|
-- Specialize the warning message according to the operation.
|
||||||
|
-- The following warnings are for the case
|
||||||
|
|
||||||
case Nkind (N) is
|
case Nkind (N) is
|
||||||
when N_Op_Divide =>
|
when N_Op_Divide =>
|
||||||
Apply_Compile_Time_Constraint_Error
|
|
||||||
(N, "division by zero?", CE_Divide_By_Zero,
|
-- For division, we have two cases, for float division
|
||||||
Loc => Sloc (Right_Opnd (N)));
|
-- of an unconstrained float type, on a machine where
|
||||||
|
-- Machine_Overflows is false, we don't get an exception
|
||||||
|
-- at run-time, but rather an infinity or Nan. The Nan
|
||||||
|
-- case is pretty obscure, so just warn about infinities.
|
||||||
|
|
||||||
|
if Is_Floating_Point_Type (Typ)
|
||||||
|
and then not Is_Constrained (Typ)
|
||||||
|
and then not Machine_Overflows_On_Target
|
||||||
|
then
|
||||||
|
Error_Msg_N
|
||||||
|
("float division by zero, " &
|
||||||
|
"may generate '+'/'- infinity?", Right_Opnd (N));
|
||||||
|
|
||||||
|
-- For all other cases, we get a Constraint_Error
|
||||||
|
|
||||||
|
else
|
||||||
|
Apply_Compile_Time_Constraint_Error
|
||||||
|
(N, "division by zero?", CE_Divide_By_Zero,
|
||||||
|
Loc => Sloc (Right_Opnd (N)));
|
||||||
|
end if;
|
||||||
|
|
||||||
when N_Op_Rem =>
|
when N_Op_Rem =>
|
||||||
Apply_Compile_Time_Constraint_Error
|
Apply_Compile_Time_Constraint_Error
|
||||||
|
|
Loading…
Reference in New Issue