function Ceiling (Container : Set; Item : Element_Type) return Cursor is
Node : constant Node_Access :=
- Element_Keys.Ceiling (Container.Tree, Item);
+ Element_Keys.Ceiling (Container.Tree, Item);
begin
return (if Node = null then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
L : Natural renames Tree.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Position.Node.Element.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Position.Node.Element.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
end Delete;
procedure Delete (Container : in out Set; Item : Element_Type) is
- X : Node_Access :=
- Element_Keys.Find (Container.Tree, Item);
+ X : Node_Access := Element_Keys.Find (Container.Tree, Item);
begin
if X = null then
-------------
procedure Exclude (Container : in out Set; Item : Element_Type) is
- X : Node_Access :=
- Element_Keys.Find (Container.Tree, Item);
+ X : Node_Access := Element_Keys.Find (Container.Tree, Item);
begin
if X /= null then
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
----------
function Find (Container : Set; Item : Element_Type) return Cursor is
- Node : constant Node_Access :=
- Element_Keys.Find (Container.Tree, Item);
+ Node : constant Node_Access := Element_Keys.Find (Container.Tree, Item);
begin
if Node = null then
return No_Element;
-----------
function Floor (Container : Set; Item : Element_Type) return Cursor is
- Node : constant Node_Access :=
- Element_Keys.Floor (Container.Tree, Item);
+ Node : constant Node_Access := Element_Keys.Floor (Container.Tree, Item);
begin
return (if Node = null then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
-------------
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
- Node : constant Node_Access :=
- Key_Keys.Ceiling (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Ceiling (Container.Tree, Key);
begin
return (if Node = null then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
(Container : aliased Set;
Key : Key_Type) return Constant_Reference_Type
is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
L : Natural renames Tree.Lock;
begin
return R : constant Constant_Reference_Type :=
- (Element => Node.Element.all'Access,
- Control =>
- (Controlled with Container'Unrestricted_Access))
+ (Element => Node.Element.all'Access,
+ Control => (Controlled with Container'Unrestricted_Access))
do
B := B + 1;
L := L + 1;
-------------
function Element (Container : Set; Key : Key_Type) return Element_Type is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
raise Constraint_Error with "key not in set";
----------
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
return (if Node = null then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
-----------
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
return (if Node = null then No_Element
else Cursor'(Container'Unrestricted_Access, Node));
(Container : aliased in out Set;
Key : Key_Type) return Reference_Type
is
- Node : constant Node_Access :=
- Key_Keys.Find (Container.Tree, Key);
+ Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
begin
if Node = null then
"attempt to tamper with elements (set is locked)";
end if;
- X := Position.Node.Element;
- Position.Node.Element := new Element_Type'(New_Item);
- Free_Element (X);
+ declare
+ -- The element allocator may need an accessibility check in the
+ -- case the actual type is class-wide or has access discriminants
+ -- (see RM 4.8(10.1) and AI12-0035).
+
+ pragma Unsuppress (Accessibility_Check);
+
+ begin
+ X := Position.Node.Element;
+ Position.Node.Element := new Element_Type'(New_Item);
+ Free_Element (X);
+ end;
end if;
end Include;
--------------
function New_Node return Node_Access is
+ -- The element allocator may need an accessibility check in the case
+ -- the actual type is class-wide or has access discriminants (see
+ -- RM 4.8(10.1) and AI12-0035).
+
+ pragma Unsuppress (Accessibility_Check);
+
Element : Element_Access := new Element_Type'(New_Item);
begin
Right => null,
Color => Red_Black_Trees.Red,
Element => Element);
+
exception
when others =>
Free_Element (Element);
--------------
function New_Node return Node_Access is
- Element : Element_Access :=
- new Element_Type'(Src_Node.Element.all);
+ Element : Element_Access := new Element_Type'(Src_Node.Element.all);
Node : Node_Access;
begin
function Intersection (Left, Right : Set) return Set is
Tree : constant Tree_Type :=
- Set_Ops.Intersection (Left.Tree, Right.Tree);
+ Set_Ops.Intersection (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Intersection;
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator :=
- Iterator'(Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => null)
+ Iterator'(Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => null)
do
B := B + 1;
end return;
-- a forward or reverse iteration.
return It : constant Iterator :=
- (Limited_Controlled with
- Container => Container'Unrestricted_Access,
- Node => Start.Node)
+ (Limited_Controlled with
+ Container => Container'Unrestricted_Access,
+ Node => Start.Node)
do
B := B + 1;
end return;
"bad cursor in Next");
declare
- Node : constant Node_Access :=
- Tree_Operations.Next (Position.Node);
+ Node : constant Node_Access := Tree_Operations.Next (Position.Node);
begin
return (if Node = null then No_Element
else Cursor'(Position.Container, Node));
declare
Node : constant Node_Access :=
- Tree_Operations.Previous (Position.Node);
+ Tree_Operations.Previous (Position.Node);
begin
return (if Node = null then No_Element
else Cursor'(Position.Container, Node));
procedure Replace (Container : in out Set; New_Item : Element_Type) is
Node : constant Node_Access :=
- Element_Keys.Find (Container.Tree, New_Item);
+ Element_Keys.Find (Container.Tree, New_Item);
X : Element_Access;
pragma Warnings (Off, X);
"attempt to tamper with elements (set is locked)";
end if;
- X := Node.Element;
- Node.Element := new Element_Type'(New_Item);
- Free_Element (X);
+ declare
+ -- The element allocator may need an accessibility check in the case
+ -- the actual type is class-wide or has access discriminants (see
+ -- RM 4.8(10.1) and AI12-0035).
+
+ pragma Unsuppress (Accessibility_Check);
+
+ begin
+ X := Node.Element;
+ Node.Element := new Element_Type'(New_Item);
+ Free_Element (X);
+ end;
end Replace;
---------------------
--------------
function New_Node return Node_Access is
+
+ -- The element allocator may need an accessibility check in the case
+ -- the actual type is class-wide or has access discriminants (see
+ -- RM 4.8(10.1) and AI12-0035).
+
+ pragma Unsuppress (Accessibility_Check);
+
begin
Node.Element := new Element_Type'(Item); -- OK if fails
Node.Color := Red;
-- Start of processing for Replace_Element
begin
- if Item < Node.Element.all
- or else Node.Element.all < Item
- then
+ if Item < Node.Element.all or else Node.Element.all < Item then
null;
else
"attempt to tamper with elements (set is locked)";
end if;
- Node.Element := new Element_Type'(Item);
- Free_Element (X);
+ declare
+ -- The element allocator may need an accessibility check in the
+ -- case the actual type is class-wide or has access discriminants
+ -- (see RM 4.8(10.1) and AI12-0035).
+
+ pragma Unsuppress (Accessibility_Check);
+
+ begin
+ Node.Element := new Element_Type'(Item);
+ Free_Element (X);
+ end;
return;
end if;
"attempt to tamper with elements (set is locked)";
end if;
- Node.Element := new Element_Type'(Item);
- Free_Element (X);
+ declare
+ -- The element allocator may need an accessibility check in the
+ -- case actual type is class-wide or has access discriminants
+ -- (see RM 4.8(10.1) and AI12-0035).
+
+ pragma Unsuppress (Accessibility_Check);
+
+ begin
+ Node.Element := new Element_Type'(Item);
+ Free_Element (X);
+ end;
return;
end if;
function Symmetric_Difference (Left, Right : Set) return Set is
Tree : constant Tree_Type :=
- Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
+ Set_Ops.Symmetric_Difference (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Symmetric_Difference;
end Union;
function Union (Left, Right : Set) return Set is
- Tree : constant Tree_Type :=
- Set_Ops.Union (Left.Tree, Right.Tree);
+ Tree : constant Tree_Type := Set_Ops.Union (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Union;
projects / platform / upstream / gcc48.git / blobdiff