X : Count_Type;
begin
+ TC_Check (Container.TC);
+
if Checks and then Position.Node = 0 then
raise Constraint_Error with
"Position cursor has no element";
return;
end if;
- TC_Check (Container.TC);
-
for Index in 1 .. Count loop
pragma Assert (Container.Length >= 2);
X : Count_Type;
begin
+ TC_Check (Container.TC);
+
if Count >= Container.Length then
Clear (Container);
return;
return;
end if;
- TC_Check (Container.TC);
-
for J in 1 .. Count loop
X := Container.First;
pragma Assert (N (N (X).Next).Prev = Container.First);
X : Count_Type;
begin
+ TC_Check (Container.TC);
+
if Count >= Container.Length then
Clear (Container);
return;
return;
end if;
- TC_Check (Container.TC);
-
for J in 1 .. Count loop
X := Container.Last;
pragma Assert (N (N (X).Prev).Next = Container.Last);
Source : in out List)
is
begin
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
-- The semantics of Merge changed slightly per AI05-0021. It was
-- originally the case that if Target and Source denoted the same
-- container object, then the GNAT implementation of Merge did
raise Capacity_Error with "new length exceeds target capacity";
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
New_Node : Count_Type;
begin
+ TC_Check (Container.TC);
+
if Before.Container /= null then
if Checks and then Before.Container /= Container'Unrestricted_Access
then
raise Capacity_Error with "capacity exceeded";
end if;
- TC_Check (Container.TC);
-
Allocate (Container, New_Item, New_Node);
First_Node := New_Node;
Insert_Internal (Container, Before.Node, New_Node);
X : Count_Type;
begin
+ TC_Check (Source.TC);
+
if Target'Address = Source'Address then
return;
end if;
raise Capacity_Error with "Source length exceeds Target capacity";
end if;
- TC_Check (Source.TC);
-
-- Clear target, note that this checks busy bits of Target
Clear (Target);
New_Item : Element_Type)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
"Position cursor designates wrong container";
end if;
- TE_Check (Container.TC);
-
pragma Assert (Vet (Position), "bad cursor in Replace_Element");
Container.Nodes (Position.Node).Element := New_Item;
Source : in out List)
is
begin
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
if Before.Container /= null then
if Checks and then Before.Container /= Target'Unrestricted_Access then
raise Program_Error with
raise Capacity_Error with "new length exceeds target capacity";
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
Splice_Internal (Target, Before.Node, Source);
end Splice;
N : Node_Array renames Container.Nodes;
begin
+ TC_Check (Container.TC);
+
if Before.Container /= null then
if Checks and then Before.Container /= Container'Unchecked_Access then
raise Program_Error with
pragma Assert (Container.Length >= 2);
- TC_Check (Container.TC);
-
if Before.Node = 0 then
pragma Assert (Position.Node /= Container.Last);
return;
end if;
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
if Before.Container /= null then
if Checks and then Before.Container /= Target'Unrestricted_Access then
raise Program_Error with
raise Capacity_Error with "Target is full";
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
Splice_Internal
(Target => Target,
Before => Before.Node,
I, J : Cursor)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then I.Node = 0 then
raise Constraint_Error with "I cursor has no element";
end if;
return;
end if;
- TE_Check (Container.TC);
-
pragma Assert (Vet (I), "bad I cursor in Swap");
pragma Assert (Vet (J), "bad J cursor in Swap");
I, J : Cursor)
is
begin
+ TC_Check (Container.TC);
+
if Checks and then I.Node = 0 then
raise Constraint_Error with "I cursor has no element";
end if;
return;
end if;
- TC_Check (Container.TC);
-
pragma Assert (Vet (I), "bad I cursor in Swap_Links");
pragma Assert (Vet (J), "bad J cursor in Swap_Links");
procedure Delete (Container : in out Map; Position : in out Cursor) is
begin
+ TC_Check (Container.TC);
+
if Checks and then Position.Node = 0 then
raise Constraint_Error with
"Position cursor of Delete equals No_Element";
"Position cursor of Delete designates wrong map";
end if;
- TC_Check (Container.TC);
-
pragma Assert (Vet (Position), "bad cursor in Delete");
HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
Node : constant Count_Type := Key_Ops.Find (Container, Key);
begin
+ TE_Check (Container.TC);
+
if Checks and then Node = 0 then
raise Constraint_Error with
"attempt to replace key not in map";
end if;
- TE_Check (Container.TC);
-
declare
N : Node_Type renames Container.Nodes (Node);
begin
New_Item : Element_Type)
is
begin
+ TE_Check (Position.Container.TC);
+
if Checks and then Position.Node = 0 then
raise Constraint_Error with
"Position cursor of Replace_Element equals No_Element";
"Position cursor of Replace_Element designates wrong map";
end if;
- TE_Check (Position.Container.TC);
-
pragma Assert (Vet (Position), "bad cursor in Replace_Element");
Container.Nodes (Position.Node).Element := New_Item;
Position : in out Cursor)
is
begin
+ TC_Check (Container.TC);
+
if Checks and then Position.Node = 0 then
raise Constraint_Error with "Position cursor equals No_Element";
end if;
raise Program_Error with "Position cursor designates wrong set";
end if;
- TC_Check (Container.TC);
-
pragma Assert (Vet (Position), "bad cursor in Delete");
HT_Ops.Delete_Node_Sans_Free (Container, Position.Node);
Node : constant Count_Type := Element_Keys.Find (Container, New_Item);
begin
+ TE_Check (Container.TC);
+
if Checks and then Node = 0 then
raise Constraint_Error with
"attempt to replace element not in set";
end if;
- TE_Check (Container.TC);
-
Container.Nodes (Node).Element := New_Item;
end Replace;
First, Last : Count_Type;
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
with "requested count exceeds available storage";
end if;
- TC_Check (Container.TC);
-
if Container.Count = 0 then
Initialize_Root (Container);
end if;
Count : Count_Type;
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
raise Program_Error with "Parent cursor not in container";
end if;
- TC_Check (Container.TC);
-
if Container.Count = 0 then
pragma Assert (Is_Root (Parent));
return;
X : Count_Type;
begin
+ TC_Check (Container.TC);
+
if Checks and then Position = No_Element then
raise Constraint_Error with "Position cursor has no element";
end if;
raise Constraint_Error with "Position cursor does not designate leaf";
end if;
- TC_Check (Container.TC);
-
X := Position.Node;
Position := No_Element;
Count : Count_Type;
begin
+ TC_Check (Container.TC);
+
if Checks and then Position = No_Element then
raise Constraint_Error with "Position cursor has no element";
end if;
raise Program_Error with "Position cursor designates root";
end if;
- TC_Check (Container.TC);
-
X := Position.Node;
Position := No_Element;
Last : Count_Type;
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
with "requested count exceeds available storage";
end if;
- TC_Check (Container.TC);
-
if Container.Count = 0 then
Initialize_Root (Container);
end if;
-- OK to reference, see below
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
with "requested count exceeds available storage";
end if;
- TC_Check (Container.TC);
-
if Container.Count = 0 then
Initialize_Root (Container);
end if;
First, Last : Count_Type;
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
with "requested count exceeds available storage";
end if;
- TC_Check (Container.TC);
-
if Container.Count = 0 then
Initialize_Root (Container);
end if;
New_Item : Element_Type)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then Position = No_Element then
raise Constraint_Error with "Position cursor has no element";
end if;
raise Program_Error with "Position cursor designates root";
end if;
- TE_Check (Container.TC);
-
Container.Elements (Position.Node) := New_Item;
end Replace_Element;
Source_Parent : Cursor)
is
begin
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
if Checks and then Target_Parent = No_Element then
raise Constraint_Error with "Target_Parent cursor has no element";
end if;
return;
end if;
- TC_Check (Target.TC);
-
if Checks and then Is_Reachable (Container => Target,
From => Target_Parent.Node,
To => Source_Parent.Node)
return;
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
if Target.Count = 0 then
Initialize_Root (Target);
end if;
Source_Parent : Cursor)
is
begin
+ TC_Check (Container.TC);
+
if Checks and then Target_Parent = No_Element then
raise Constraint_Error with "Target_Parent cursor has no element";
end if;
pragma Assert (Container.Count > 0);
- TC_Check (Container.TC);
-
if Checks and then Is_Reachable (Container => Container,
From => Target_Parent.Node,
To => Source_Parent.Node)
Position : in out Cursor)
is
begin
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
end if;
end if;
- TC_Check (Target.TC);
-
if Checks and then Is_Reachable (Container => Target,
From => Parent.Node,
To => Position.Node)
return;
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
if Target.Count = 0 then
Initialize_Root (Target);
end if;
Position : Cursor)
is
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
end if;
end if;
- TC_Check (Container.TC);
-
if Checks and then Is_Reachable (Container => Container,
From => Parent.Node,
To => Position.Node)
I, J : Cursor)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then I = No_Element then
raise Constraint_Error with "I cursor has no element";
end if;
raise Program_Error with "J cursor designates root";
end if;
- TE_Check (Container.TC);
-
declare
EE : Element_Array renames Container.Elements;
EI : constant Element_Type := EE (I.Node);
Node : constant Count_Type := Key_Ops.Find (Container, Key);
begin
+ TE_Check (Container.TC);
+
if Checks and then Node = 0 then
raise Constraint_Error with "key not in map";
end if;
- TE_Check (Container.TC);
-
declare
N : Node_Type renames Container.Nodes (Node);
New_Item : Element_Type)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then Position.Node = 0 then
raise Constraint_Error with
"Position cursor of Replace_Element equals No_Element";
"Position cursor of Replace_Element designates wrong map";
end if;
- TE_Check (Container.TC);
-
pragma Assert (Vet (Container, Position.Node),
"Position cursor of Replace_Element is bad");
procedure Delete (Container : in out Set; Position : in out Cursor) is
begin
+ TC_Check (Container.TC);
+
if Checks and then Position.Node = 0 then
raise Constraint_Error with "Position cursor equals No_Element";
end if;
raise Program_Error with "Position cursor designates wrong set";
end if;
- TC_Check (Container.TC);
-
pragma Assert (Vet (Container, Position.Node),
"bad cursor in Delete");
Node : constant Count_Type := Element_Keys.Find (Container, New_Item);
begin
+ TE_Check (Container.TC);
+
if Checks and then Node = 0 then
raise Constraint_Error with
"attempt to replace element not in set";
end if;
- TE_Check (Container.TC);
-
Container.Nodes (Node).Element := New_Item;
end Replace;
X : Node_Access;
begin
+ TC_Check (Container.TC);
+
if Checks and then Position.Node = null then
raise Constraint_Error with
"Position cursor has no element";
return;
end if;
- TC_Check (Container.TC);
-
for Index in 1 .. Count loop
X := Position.Node;
Container.Length := Container.Length - 1;
Source : in out List)
is
begin
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
-- The semantics of Merge changed slightly per AI05-0021. It was
-- originally the case that if Target and Source denoted the same
-- container object, then the GNAT implementation of Merge did
raise Constraint_Error with "new length exceeds maximum";
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
New_Node : Node_Access;
begin
+ TC_Check (Container.TC);
+
if Before.Container /= null then
if Checks and then Before.Container /= Container'Unrestricted_Access
then
raise Constraint_Error with "new length exceeds maximum";
end if;
- TC_Check (Container.TC);
-
New_Node := new Node_Type'(New_Item, null, null);
First_Node := New_Node;
Insert_Internal (Container, Before.Node, New_Node);
New_Node : Node_Access;
begin
+ TC_Check (Container.TC);
+
if Before.Container /= null then
if Checks and then Before.Container /= Container'Unrestricted_Access
then
raise Constraint_Error with "new length exceeds maximum";
end if;
- TC_Check (Container.TC);
-
New_Node := new Node_Type;
First_Node := New_Node;
Insert_Internal (Container, Before.Node, New_Node);
New_Item : Element_Type)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
"Position cursor designates wrong container";
end if;
- TE_Check (Container.TC);
-
pragma Assert (Vet (Position), "bad cursor in Replace_Element");
Position.Node.Element := New_Item;
Source : in out List)
is
begin
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
if Before.Container /= null then
if Checks and then Before.Container /= Target'Unrestricted_Access then
raise Program_Error with
raise Constraint_Error with "new length exceeds maximum";
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
Splice_Internal (Target, Before.Node, Source);
end Splice;
Position : Cursor)
is
begin
+ TC_Check (Container.TC);
+
if Before.Container /= null then
if Checks and then Before.Container /= Container'Unchecked_Access then
raise Program_Error with
pragma Assert (Container.Length >= 2);
- TC_Check (Container.TC);
-
if Before.Node = null then
pragma Assert (Position.Node /= Container.Last);
return;
end if;
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
if Before.Container /= null then
if Checks and then Before.Container /= Target'Unrestricted_Access then
raise Program_Error with
raise Constraint_Error with "Target is full";
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
Splice_Internal (Target, Before.Node, Source, Position.Node);
Position.Container := Target'Unchecked_Access;
end Splice;
I, J : Cursor)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then I.Node = null then
raise Constraint_Error with "I cursor has no element";
end if;
return;
end if;
- TE_Check (Container.TC);
-
pragma Assert (Vet (I), "bad I cursor in Swap");
pragma Assert (Vet (J), "bad J cursor in Swap");
I, J : Cursor)
is
begin
+ TC_Check (Container.TC);
+
if Checks and then I.Node = null then
raise Constraint_Error with "I cursor has no element";
end if;
return;
end if;
- TC_Check (Container.TC);
-
pragma Assert (Vet (I), "bad I cursor in Swap_Links");
pragma Assert (Vet (J), "bad J cursor in Swap_Links");
N, M : Count_Type;
begin
+ TC_Check (HT.TC);
+
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
-- hash table as this one, a key is mapped to exactly one node.)
if Checked_Equivalent_Keys (HT, Key, Node) then
- TE_Check (HT.TC);
-
-- The new Key value is mapped to this same Node, so Node
-- stays in the same bucket.
return;
end if;
- -- The node is a bucket different from the bucket implied by Key
-
- TC_Check (HT.TC);
-
+ -- The node is in a bucket different from the bucket implied by Key.
-- Do the assignment first, before moving the node, so that if Assign
-- propagates an exception, then the hash table will not have been
-- modified (except for any possible side-effect Assign had on Node).
end if;
if Checked_Equivalent_Keys (HT, Key, X) then
- TC_Check (HT.TC);
HT.Buckets (Indx) := Next (X);
HT.Length := HT.Length - 1;
return;
end if;
if Checked_Equivalent_Keys (HT, Key, X) then
- TC_Check (HT.TC);
Set_Next (Node => Prev, Next => Next (X));
HT.Length := HT.Length - 1;
return;
X : Node_Access;
begin
+ TC_Check (Container.TC);
+
if Checks and then Position.Node = null then
raise Constraint_Error with
"Position cursor has no element";
return;
end if;
- TC_Check (Container.TC);
-
for Index in 1 .. Count loop
X := Position.Node;
Container.Length := Container.Length - 1;
return;
end if;
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
if Checks and then Target'Address = Source'Address then
raise Program_Error with
"Target and Source denote same non-empty container";
raise Constraint_Error with "new length exceeds maximum";
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
declare
Lock_Target : With_Lock (Target.TC'Unchecked_Access);
Lock_Source : With_Lock (Source.TC'Unchecked_Access);
New_Node : Node_Access;
begin
+ TC_Check (Container.TC);
+
if Before.Container /= null then
if Checks and then Before.Container /= Container'Unrestricted_Access
then
raise Constraint_Error with "new length exceeds maximum";
end if;
- TC_Check (Container.TC);
-
declare
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
New_Item : Element_Type)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
"Position cursor designates wrong container";
end if;
- TE_Check (Container.TC);
-
if Checks and then Position.Node.Element = null then
raise Program_Error with
"Position cursor has no element";
Source : in out List)
is
begin
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
if Before.Container /= null then
if Checks and then Before.Container /= Target'Unrestricted_Access then
raise Program_Error with
raise Constraint_Error with "new length exceeds maximum";
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
Splice_Internal (Target, Before.Node, Source);
end Splice;
Position : Cursor)
is
begin
+ TC_Check (Container.TC);
+
if Before.Container /= null then
if Checks and then Before.Container /= Container'Unchecked_Access then
raise Program_Error with
pragma Assert (Container.Length >= 2);
- TC_Check (Container.TC);
-
if Before.Node = null then
pragma Assert (Position.Node /= Container.Last);
return;
end if;
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
if Before.Container /= null then
if Checks and then Before.Container /= Target'Unrestricted_Access then
raise Program_Error with
raise Constraint_Error with "Target is full";
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
Splice_Internal (Target, Before.Node, Source, Position.Node);
Position.Container := Target'Unchecked_Access;
end Splice;
I, J : Cursor)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then I.Node = null then
raise Constraint_Error with "I cursor has no element";
end if;
return;
end if;
- TE_Check (Container.TC);
-
pragma Assert (Vet (I), "bad I cursor in Swap");
pragma Assert (Vet (J), "bad J cursor in Swap");
I, J : Cursor)
is
begin
+ TC_Check (Container.TC);
+
if Checks and then I.Node = null then
raise Constraint_Error with "I cursor has no element";
end if;
return;
end if;
- TC_Check (Container.TC);
-
pragma Assert (Vet (I), "bad I cursor in Swap_Links");
pragma Assert (Vet (J), "bad J cursor in Swap_Links");
procedure Delete (Container : in out Map; Position : in out Cursor) is
begin
+ TC_Check (Container.HT.TC);
+
if Checks and then Position.Node = null then
raise Constraint_Error with
"Position cursor of Delete equals No_Element";
"Position cursor of Delete designates wrong map";
end if;
- TC_Check (Container.HT.TC);
-
pragma Assert (Vet (Position), "bad cursor in Delete");
HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
E : Element_Access;
begin
+ TE_Check (Container.HT.TC);
+
if Checks and then Node = null then
raise Constraint_Error with
"attempt to replace key not in map";
end if;
- TE_Check (Container.HT.TC);
-
K := Node.Key;
E := Node.Element;
New_Item : Element_Type)
is
begin
+ TE_Check (Position.Container.HT.TC);
+
if Checks and then Position.Node = null then
raise Constraint_Error with
"Position cursor of Replace_Element equals No_Element";
"Position cursor of Replace_Element designates wrong map";
end if;
- TE_Check (Position.Container.HT.TC);
-
pragma Assert (Vet (Position), "bad cursor in Replace_Element");
declare
Position : in out Cursor)
is
begin
+ TC_Check (Container.HT.TC);
+
if Checks and then Position.Node = null then
raise Constraint_Error with "Position cursor equals No_Element";
end if;
raise Program_Error with "Position cursor designates wrong set";
end if;
- TC_Check (Container.HT.TC);
-
pragma Assert (Vet (Position), "Position cursor is bad");
HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
pragma Warnings (Off, X);
begin
+ TE_Check (Container.HT.TC);
+
if Checks and then Node = null then
raise Constraint_Error with
"attempt to replace element not in set";
end if;
- TE_Check (Container.HT.TC);
-
X := Node.Element;
declare
Element : Element_Access;
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
return;
end if;
- TC_Check (Container.TC);
-
declare
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
Count : Count_Type;
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
raise Program_Error with "Parent cursor not in container";
end if;
- TC_Check (Container.TC);
-
-- Deallocate_Children returns a count of the number of nodes
-- that it deallocates, but it works by incrementing the
-- value that is passed in. We must therefore initialize
X : Tree_Node_Access;
begin
+ TC_Check (Container.TC);
+
if Checks and then Position = No_Element then
raise Constraint_Error with "Position cursor has no element";
end if;
raise Constraint_Error with "Position cursor does not designate leaf";
end if;
- TC_Check (Container.TC);
-
X := Position.Node;
Position := No_Element;
Count : Count_Type;
begin
+ TC_Check (Container.TC);
+
if Checks and then Position = No_Element then
raise Constraint_Error with "Position cursor has no element";
end if;
raise Program_Error with "Position cursor designates root";
end if;
- TC_Check (Container.TC);
-
X := Position.Node;
Position := No_Element;
Element : Element_Access;
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
return;
end if;
- TC_Check (Container.TC);
-
declare
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
Element : Element_Access;
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
return;
end if;
- TC_Check (Container.TC);
-
declare
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
E, X : Element_Access;
begin
+ TE_Check (Container.TC);
+
if Checks and then Position = No_Element then
raise Constraint_Error with "Position cursor has no element";
end if;
raise Program_Error with "Position cursor designates root";
end if;
- TE_Check (Container.TC);
-
declare
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
Count : Count_Type;
begin
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
if Checks and then Target_Parent = No_Element then
raise Constraint_Error with "Target_Parent cursor has no element";
end if;
return;
end if;
- TC_Check (Target.TC);
-
if Checks and then Is_Reachable (From => Target_Parent.Node,
To => Source_Parent.Node)
then
return;
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
-- We cache the count of the nodes we have allocated, so that operation
-- Node_Count can execute in O(1) time. But that means we must count the
-- nodes in the subtree we remove from Source and insert into Target, in
Source_Parent : Cursor)
is
begin
+ TC_Check (Container.TC);
+
if Checks and then Target_Parent = No_Element then
raise Constraint_Error with "Target_Parent cursor has no element";
end if;
return;
end if;
- TC_Check (Container.TC);
-
if Checks and then Is_Reachable (From => Target_Parent.Node,
To => Source_Parent.Node)
then
Subtree_Count : Count_Type;
begin
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
end if;
end if;
- TC_Check (Target.TC);
-
if Checks and then
Is_Reachable (From => Parent.Node, To => Position.Node)
then
return;
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
-- This is an unfortunate feature of this API: we must count the nodes
-- in the subtree that we remove from the source tree, which is an O(n)
-- operation. It would have been better if the Tree container did not
Position : Cursor)
is
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
end if;
end if;
- TC_Check (Container.TC);
-
if Checks and then
Is_Reachable (From => Parent.Node, To => Position.Node)
then
I, J : Cursor)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then I = No_Element then
raise Constraint_Error with "I cursor has no element";
end if;
raise Program_Error with "J cursor designates root";
end if;
- TE_Check (Container.TC);
-
declare
EI : constant Element_Access := I.Node.Element;
E : Element_Access;
begin
+ TE_Check (Container.Tree.TC);
+
if Checks and then Node = null then
raise Constraint_Error with "key not in map";
end if;
- TE_Check (Container.Tree.TC);
-
K := Node.Key;
E := Node.Element;
New_Item : Element_Type)
is
begin
+ TE_Check (Container.Tree.TC);
+
if Checks and then Position.Node = null then
raise Constraint_Error with
"Position cursor of Replace_Element equals No_Element";
"Position cursor of Replace_Element designates wrong map";
end if;
- TE_Check (Container.Tree.TC);
-
pragma Assert (Vet (Container.Tree, Position.Node),
"Position cursor of Replace_Element is bad");
pragma Warnings (Off, X);
begin
+ TE_Check (Container.Tree.TC);
+
if Checks and then Node = null then
raise Constraint_Error with "attempt to replace element not in set";
end if;
- TE_Check (Container.Tree.TC);
-
declare
-- The element allocator may need an accessibility check in the case
-- the actual type is class-wide or has access discriminants (see
Off : Count_Type'Base; -- Index expressed as offset from IT'First
begin
+ TC_Check (Container.TC);
+
-- Delete removes items from the vector, the number of which is the
-- minimum of the specified Count and the items (if any) that exist from
-- Index to Container.Last. There are no constraints on the specified
-- the count on exit. Delete checks the count to determine whether it is
-- being called while the associated callback procedure is executing.
- TC_Check (Container.TC);
-
-- We first calculate what's available for deletion starting at
-- Index. Here and elsewhere we use the wider of Index_Type'Base and
-- Count_Type'Base as the type for intermediate values. (See function
Count : Count_Type := 1)
is
begin
- -- It is not permitted to delete items while the container is busy (for
- -- example, we're in the middle of a passive iteration). However, we
- -- always treat deleting 0 items as a no-op, even when we're busy, so we
- -- simply return without checking.
-
- if Count = 0 then
- return;
- end if;
-
-- The tampering bits exist to prevent an item from being deleted (or
-- otherwise harmfully manipulated) while it is being visited. Query,
-- Update, and Iterate increment the busy count on entry, and decrement
TC_Check (Container.TC);
+ if Count = 0 then
+ return;
+ end if;
+
-- There is no restriction on how large Count can be when deleting
-- items. If it is equal or greater than the current length, then this
-- is equivalent to clearing the vector. (In particular, there's no need
return;
end if;
+ TC_Check (Source.TC);
+
if Checks and then Target'Address = Source'Address then
raise Program_Error with
"Target and Source denote same non-empty container";
return;
end if;
- TC_Check (Source.TC);
-
I := Target.Length;
Target.Set_Length (I + Source.Length);
J : Count_Type'Base; -- scratch
begin
+ -- The tampering bits exist to prevent an item from being harmfully
+ -- manipulated while it is being visited. Query, Update, and Iterate
+ -- increment the busy count on entry, and decrement the count on
+ -- exit. Insert checks the count to determine whether it is being called
+ -- while the associated callback procedure is executing.
+
+ TC_Check (Container.TC);
+
-- As a precondition on the generic actual Index_Type, the base type
-- must include Index_Type'Pred (Index_Type'First); this is the value
-- that Container.Last assumes when the vector is empty. However, we do
raise Constraint_Error with "Count is out of range";
end if;
- -- The tampering bits exist to prevent an item from being harmfully
- -- manipulated while it is being visited. Query, Update, and Iterate
- -- increment the busy count on entry, and decrement the count on
- -- exit. Insert checks the count to determine whether it is being called
- -- while the associated callback procedure is executing.
-
- TC_Check (Container.TC);
-
if Checks and then New_Length > Container.Capacity then
raise Capacity_Error with "New length is larger than capacity";
end if;
J : Count_Type'Base; -- scratch
begin
+ -- The tampering bits exist to prevent an item from being harmfully
+ -- manipulated while it is being visited. Query, Update, and Iterate
+ -- increment the busy count on entry, and decrement the count on
+ -- exit. Insert checks the count to determine whether it is being called
+ -- while the associated callback procedure is executing.
+
+ TC_Check (Container.TC);
+
-- As a precondition on the generic actual Index_Type, the base type
-- must include Index_Type'Pred (Index_Type'First); this is the value
-- that Container.Last assumes when the vector is empty. However, we do
raise Constraint_Error with "Count is out of range";
end if;
- -- The tampering bits exist to prevent an item from being harmfully
- -- manipulated while it is being visited. Query, Update, and Iterate
- -- increment the busy count on entry, and decrement the count on
- -- exit. Insert checks the count to determine whether it is being called
- -- while the associated callback procedure is executing.
-
- TC_Check (Container.TC);
-
-- An internal array has already been allocated, so we need to check
-- whether there is enough unused storage for the new items.
return;
end if;
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
if Checks and then Target.Capacity < Source.Length then
raise Capacity_Error -- ???
with "Target capacity is less than Source length";
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
-- Clear Target now, in case element assignment fails
Target.Last := No_Index;
New_Item : Element_Type)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then Index > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
- TE_Check (Container.TC);
-
Container.Elements (To_Array_Index (Index)) := New_Item;
end Replace_Element;
New_Item : Element_Type)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
raise Constraint_Error with "Position cursor is out of range";
end if;
- TE_Check (Container.TC);
-
Container.Elements (To_Array_Index (Position.Index)) := New_Item;
end Replace_Element;
E : Elements_Array renames Container.Elements;
begin
+ TE_Check (Container.TC);
+
if Checks and then I > Container.Last then
raise Constraint_Error with "I index is out of range";
end if;
return;
end if;
- TE_Check (Container.TC);
-
declare
EI_Copy : constant Element_Type := E (To_Array_Index (I));
begin
procedure Delete (Container : in out Map; Position : in out Cursor) is
begin
+ TC_Check (Container.HT.TC);
+
if Checks and then Position.Node = null then
raise Constraint_Error with
"Position cursor of Delete equals No_Element";
"Position cursor of Delete designates wrong map";
end if;
- TC_Check (Container.HT.TC);
-
pragma Assert (Vet (Position), "bad cursor in Delete");
HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
Node : constant Node_Access := Key_Ops.Find (Container.HT, Key);
begin
+ TE_Check (Container.HT.TC);
+
if Checks and then Node = null then
raise Constraint_Error with
"attempt to replace key not in map";
end if;
- TE_Check (Container.HT.TC);
-
Node.Key := Key;
Node.Element := New_Item;
end Replace;
New_Item : Element_Type)
is
begin
+ TE_Check (Position.Container.HT.TC);
+
if Checks and then Position.Node = null then
raise Constraint_Error with
"Position cursor of Replace_Element equals No_Element";
"Position cursor of Replace_Element designates wrong map";
end if;
- TE_Check (Position.Container.HT.TC);
-
pragma Assert (Vet (Position), "bad cursor in Replace_Element");
Position.Node.Element := New_Item;
Position : in out Cursor)
is
begin
+ TC_Check (Container.HT.TC);
+
if Checks and then Position.Node = null then
raise Constraint_Error with "Position cursor equals No_Element";
end if;
raise Program_Error with "Position cursor designates wrong set";
end if;
- TC_Check (Container.HT.TC);
-
pragma Assert (Vet (Position), "bad cursor in Delete");
HT_Ops.Delete_Node_Sans_Free (Container.HT, Position.Node);
Element_Keys.Find (Container.HT, New_Item);
begin
+ TE_Check (Container.HT.TC);
+
if Checks and then Node = null then
raise Constraint_Error with
"attempt to replace element not in set";
end if;
- TE_Check (Container.HT.TC);
-
Node.Element := New_Item;
end Replace;
J : Index_Type'Base; -- first index of items that slide down
begin
+ -- The tampering bits exist to prevent an item from being deleted (or
+ -- otherwise harmfully manipulated) while it is being visited. Query,
+ -- Update, and Iterate increment the busy count on entry, and decrement
+ -- the count on exit. Delete checks the count to determine whether it is
+ -- being called while the associated callback procedure is executing.
+
+ TC_Check (Container.TC);
+
-- Delete removes items from the vector, the number of which is the
-- minimum of the specified Count and the items (if any) that exist from
-- Index to Container.Last. There are no constraints on the specified
return;
end if;
- -- The tampering bits exist to prevent an item from being deleted (or
- -- otherwise harmfully manipulated) while it is being visited. Query,
- -- Update, and Iterate increment the busy count on entry, and decrement
- -- the count on exit. Delete checks the count to determine whether it is
- -- being called while the associated callback procedure is executing.
-
- TC_Check (Container.TC);
-
-- We first calculate what's available for deletion starting at
-- Index. Here and elsewhere we use the wider of Index_Type'Base and
-- Count_Type'Base as the type for intermediate values. (See function
I, J : Index_Type'Base;
begin
+ TC_Check (Source.TC);
+
-- The semantics of Merge changed slightly per AI05-0021. It was
-- originally the case that if Target and Source denoted the same
-- container object, then the GNAT implementation of Merge did
return;
end if;
- TC_Check (Source.TC);
-
I := Target.Last; -- original value (before Set_Length)
Target.Set_Length (Length (Target) + Length (Source));
Dst : Elements_Access; -- new, expanded internal array
begin
+ -- The tampering bits exist to prevent an item from being harmfully
+ -- manipulated while it is being visited. Query, Update, and Iterate
+ -- increment the busy count on entry, and decrement the count on
+ -- exit. Insert checks the count to determine whether it is being called
+ -- while the associated callback procedure is executing.
+
+ TC_Check (Container.TC);
+
if Checks then
-- As a precondition on the generic actual Index_Type, the base type
-- must include Index_Type'Pred (Index_Type'First); this is the value
return;
end if;
- -- The tampering bits exist to prevent an item from being harmfully
- -- manipulated while it is being visited. Query, Update, and Iterate
- -- increment the busy count on entry, and decrement the count on
- -- exit. Insert checks the count to determine whether it is being called
- -- while the associated callback procedure is executing.
-
- TC_Check (Container.TC);
-
if New_Length <= Container.Elements.EA'Length then
-- In this case, we're inserting elements into a vector that has
Dst : Elements_Access; -- new, expanded internal array
begin
+ -- The tampering bits exist to prevent an item from being harmfully
+ -- manipulated while it is being visited. Query, Update, and Iterate
+ -- increment the busy count on entry, and decrement the count on exit.
+ -- Insert checks the count to determine whether it is being called while
+ -- the associated callback procedure is executing.
+
+ TC_Check (Container.TC);
+
if Checks then
-- As a precondition on the generic actual Index_Type, the base type
-- must include Index_Type'Pred (Index_Type'First); this is the value
return;
end if;
- -- The tampering bits exist to prevent an item from being harmfully
- -- manipulated while it is being visited. Query, Update, and Iterate
- -- increment the busy count on entry, and decrement the count on exit.
- -- Insert checks the count to determine whether it is being called while
- -- the associated callback procedure is executing.
-
- TC_Check (Container.TC);
-
if New_Length <= Container.Elements.EA'Length then
-- In this case, we are inserting elements into a vector that has
New_Item : Element_Type)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then Index > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
- TE_Check (Container.TC);
-
declare
X : Element_Access := Container.Elements.EA (Index);
New_Item : Element_Type)
is
begin
+ TE_Check (Container.TC);
+
if Checks then
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
end if;
- TE_Check (Container.TC);
-
declare
X : Element_Access := Container.Elements.EA (Position.Index);
procedure Swap (Container : in out Vector; I, J : Index_Type) is
begin
+ TE_Check (Container.TC);
+
if Checks then
if I > Container.Last then
raise Constraint_Error with "I index is out of range";
return;
end if;
- TE_Check (Container.TC);
-
declare
EI : Element_Access renames Container.Elements.EA (I);
EJ : Element_Access renames Container.Elements.EA (J);
Last : Tree_Node_Access;
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
return;
end if;
- TC_Check (Container.TC);
-
First := new Tree_Node_Type'(Parent => Parent.Node,
Element => New_Item,
others => <>);
Count : Count_Type;
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
raise Program_Error with "Parent cursor not in container";
end if;
- TC_Check (Container.TC);
-
-- Deallocate_Children returns a count of the number of nodes that it
-- deallocates, but it works by incrementing the value that is passed
-- in. We must therefore initialize the count value before calling
X : Tree_Node_Access;
begin
+ TC_Check (Container.TC);
+
if Checks and then Position = No_Element then
raise Constraint_Error with "Position cursor has no element";
end if;
raise Constraint_Error with "Position cursor does not designate leaf";
end if;
- TC_Check (Container.TC);
-
X := Position.Node;
Position := No_Element;
Count : Count_Type;
begin
+ TC_Check (Container.TC);
+
if Checks and then Position = No_Element then
raise Constraint_Error with "Position cursor has no element";
end if;
raise Program_Error with "Position cursor designates root";
end if;
- TC_Check (Container.TC);
-
X := Position.Node;
Position := No_Element;
Last : Tree_Node_Access;
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
return;
end if;
- TC_Check (Container.TC);
-
First := new Tree_Node_Type'(Parent => Parent.Node,
Element => New_Item,
others => <>);
Last : Tree_Node_Access;
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
return;
end if;
- TC_Check (Container.TC);
-
First := new Tree_Node_Type'(Parent => Parent.Node,
Element => <>,
others => <>);
First, Last : Tree_Node_Access;
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
return;
end if;
- TC_Check (Container.TC);
-
First := new Tree_Node_Type'(Parent => Parent.Node,
Element => New_Item,
others => <>);
New_Item : Element_Type)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then Position = No_Element then
raise Constraint_Error with "Position cursor has no element";
end if;
raise Program_Error with "Position cursor designates root";
end if;
- TE_Check (Container.TC);
-
Position.Node.Element := New_Item;
end Replace_Element;
Count : Count_Type;
begin
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
if Checks and then Target_Parent = No_Element then
raise Constraint_Error with "Target_Parent cursor has no element";
end if;
return;
end if;
- TC_Check (Target.TC);
-
if Checks and then Is_Reachable (From => Target_Parent.Node,
To => Source_Parent.Node)
then
return;
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
-- We cache the count of the nodes we have allocated, so that operation
-- Node_Count can execute in O(1) time. But that means we must count the
-- nodes in the subtree we remove from Source and insert into Target, in
Source_Parent : Cursor)
is
begin
+ TC_Check (Container.TC);
+
if Checks and then Target_Parent = No_Element then
raise Constraint_Error with "Target_Parent cursor has no element";
end if;
return;
end if;
- TC_Check (Container.TC);
-
if Checks and then Is_Reachable (From => Target_Parent.Node,
To => Source_Parent.Node)
then
Subtree_Count : Count_Type;
begin
+ TC_Check (Target.TC);
+ TC_Check (Source.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
end if;
end if;
- TC_Check (Target.TC);
-
if Checks and then
Is_Reachable (From => Parent.Node, To => Position.Node)
then
return;
end if;
- TC_Check (Target.TC);
- TC_Check (Source.TC);
-
-- This is an unfortunate feature of this API: we must count the nodes
-- in the subtree that we remove from the source tree, which is an O(n)
-- operation. It would have been better if the Tree container did not
Position : Cursor)
is
begin
+ TC_Check (Container.TC);
+
if Checks and then Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
end if;
end if;
end if;
- TC_Check (Container.TC);
-
if Checks and then
Is_Reachable (From => Parent.Node, To => Position.Node)
then
I, J : Cursor)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then I = No_Element then
raise Constraint_Error with "I cursor has no element";
end if;
raise Program_Error with "J cursor designates root";
end if;
- TE_Check (Container.TC);
-
declare
EI : constant Element_Type := I.Node.Element;
J : Index_Type'Base; -- first index of items that slide down
begin
+ -- The tampering bits exist to prevent an item from being deleted (or
+ -- otherwise harmfully manipulated) while it is being visited. Query,
+ -- Update, and Iterate increment the busy count on entry, and decrement
+ -- the count on exit. Delete checks the count to determine whether it is
+ -- being called while the associated callback procedure is executing.
+
+ TC_Check (Container.TC);
+
-- Delete removes items from the vector, the number of which is the
-- minimum of the specified Count and the items (if any) that exist from
-- Index to Container.Last. There are no constraints on the specified
return;
end if;
- -- The tampering bits exist to prevent an item from being deleted (or
- -- otherwise harmfully manipulated) while it is being visited. Query,
- -- Update, and Iterate increment the busy count on entry, and decrement
- -- the count on exit. Delete checks the count to determine whether it is
- -- being called while the associated callback procedure is executing.
-
- TC_Check (Container.TC);
-
-- We first calculate what's available for deletion starting at
-- Index. Here and elsewhere we use the wider of Index_Type'Base and
-- Count_Type'Base as the type for intermediate values. (See function
J : Index_Type'Base;
begin
+ TC_Check (Source.TC);
+
-- The semantics of Merge changed slightly per AI05-0021. It was
-- originally the case that if Target and Source denoted the same
-- container object, then the GNAT implementation of Merge did
return;
end if;
- TC_Check (Source.TC);
-
Target.Set_Length (Length (Target) + Length (Source));
-- Per AI05-0022, the container implementation is required to detect
"<" => "<");
begin
- if Container.Last <= Index_Type'First then
- return;
- end if;
-
-- The exception behavior for the vector container must match that
-- for the list container, so we check for cursor tampering here
-- (which will catch more things) instead of for element tampering
TC_Check (Container.TC);
+ if Container.Last <= Index_Type'First then
+ return;
+ end if;
+
-- Per AI05-0022, the container implementation is required to detect
-- element tampering by a generic actual subprogram.
Dst : Elements_Access; -- new, expanded internal array
begin
+ -- The tampering bits exist to prevent an item from being harmfully
+ -- manipulated while it is being visited. Query, Update, and Iterate
+ -- increment the busy count on entry, and decrement the count on
+ -- exit. Insert checks the count to determine whether it is being called
+ -- while the associated callback procedure is executing.
+
+ TC_Check (Container.TC);
+
if Checks then
-- As a precondition on the generic actual Index_Type, the base type
-- must include Index_Type'Pred (Index_Type'First); this is the value
return;
end if;
- -- The tampering bits exist to prevent an item from being harmfully
- -- manipulated while it is being visited. Query, Update, and Iterate
- -- increment the busy count on entry, and decrement the count on
- -- exit. Insert checks the count to determine whether it is being called
- -- while the associated callback procedure is executing.
-
- TC_Check (Container.TC);
-
-- An internal array has already been allocated, so we must determine
-- whether there is enough unused storage for the new items.
Dst : Elements_Access; -- new, expanded internal array
begin
+ -- The tampering bits exist to prevent an item from being harmfully
+ -- manipulated while it is being visited. Query, Update, and Iterate
+ -- increment the busy count on entry, and decrement the count on
+ -- exit. Insert checks the count to determine whether it is being called
+ -- while the associated callback procedure is executing.
+
+ TC_Check (Container.TC);
+
if Checks then
-- As a precondition on the generic actual Index_Type, the base type
-- must include Index_Type'Pred (Index_Type'First); this is the value
return;
end if;
- -- The tampering bits exist to prevent an item from being harmfully
- -- manipulated while it is being visited. Query, Update, and Iterate
- -- increment the busy count on entry, and decrement the count on
- -- exit. Insert checks the count to determine whether it is being called
- -- while the associated callback procedure is executing.
-
- TC_Check (Container.TC);
-
-- An internal array has already been allocated, so we must determine
-- whether there is enough unused storage for the new items.
New_Item : Element_Type)
is
begin
+ TE_Check (Container.TC);
+
if Checks and then Index > Container.Last then
raise Constraint_Error with "Index is out of range";
end if;
- TE_Check (Container.TC);
Container.Elements.EA (Index) := New_Item;
end Replace_Element;
New_Item : Element_Type)
is
begin
+ TE_Check (Container.TC);
+
if Checks then
if Position.Container = null then
raise Constraint_Error with "Position cursor has no element";
end if;
end if;
- TE_Check (Container.TC);
Container.Elements.EA (Position.Index) := New_Item;
end Replace_Element;
procedure Swap (Container : in out Vector; I, J : Index_Type) is
begin
+ TE_Check (Container.TC);
+
if Checks then
if I > Container.Last then
raise Constraint_Error with "I index is out of range";
return;
end if;
- TE_Check (Container.TC);
-
declare
EI_Copy : constant Element_Type := Container.Elements.EA (I);
begin
Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
begin
+ TE_Check (Container.Tree.TC);
+
if Checks and then Node = null then
raise Constraint_Error with "key not in map";
end if;
- TE_Check (Container.Tree.TC);
-
Node.Key := Key;
Node.Element := New_Item;
end Replace;
New_Item : Element_Type)
is
begin
+ TE_Check (Container.Tree.TC);
+
if Checks and then Position.Node = null then
raise Constraint_Error with
"Position cursor of Replace_Element equals No_Element";
"Position cursor of Replace_Element designates wrong map";
end if;
- TE_Check (Container.Tree.TC);
-
pragma Assert (Vet (Container.Tree, Position.Node),
"Position cursor of Replace_Element is bad");
Element_Keys.Find (Container.Tree, New_Item);
begin
+ TE_Check (Container.Tree.TC);
+
if Checks and then Node = null then
raise Constraint_Error with
"attempt to replace element not in set";
end if;
- TE_Check (Container.Tree.TC);
-
Node.Element := New_Item;
end Replace;
Z : out Node_Access)
is
begin
+ TC_Check (Tree.TC);
+
if Checks and then Tree.Length = Count_Type'Last then
raise Constraint_Error with "too many elements";
end if;
- TC_Check (Tree.TC);
-
Z := New_Node;
pragma Assert (Z /= null);
pragma Assert (Ops.Color (Z) = Red);
procedure Generic_Move (Target, Source : in out Tree_Type) is
begin
+ TC_Check (Source.TC);
+
if Target'Address = Source'Address then
return;
end if;
- TC_Check (Source.TC);
-
Clear (Target);
Target := Source;
Compare : Integer;
begin
- if Target'Address = Source'Address then
- TC_Check (Target.TC);
+ TC_Check (Target.TC);
+ if Target'Address = Source'Address then
Clear (Target);
return;
end if;
return;
end if;
- TC_Check (Target.TC);
-
Tgt := Target.First;
Src := Source.First;
loop
projects / gcc.git / commitdiff