+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>
* gcc-interface/Makefile.in (Darwin): Partial reversion of previous
overriding function First (Object : Iterator) return Cursor;
overriding function Next
- (Object : Iterator;
+ (Object : Iterator;
Position : Cursor) return Cursor;
-----------------------
Node : out Count_Type;
Inserted : out Boolean);
- function Is_In
- (HT : Set;
- Key : Node_Type) return Boolean;
+ function Is_In (HT : Set; Key : Node_Type) return Boolean;
pragma Inline (Is_In);
procedure Set_Element (Node : in out Node_Type; Item : Element_Type);
N : Node_Type renames Source.Nodes (Source_Node);
X : Count_Type;
B : Boolean;
-
begin
Insert (Target, N.Element, X, B);
pragma Assert (B);
begin
if Capacity = 0 then
C := Source.Length;
-
elsif Capacity >= Source.Length then
C := Capacity;
-
else
raise Capacity_Error with "Capacity value too small";
end if;
N : Node_Type renames Left.Nodes (L_Node);
X : Count_Type;
B : Boolean;
-
begin
if not Is_In (Right, N) then
Insert (Result, N.Element, X, B); -- optimize this ???
declare
S : Set renames Position.Container.all;
N : Node_Type renames S.Nodes (Position.Node);
-
begin
return N.Element;
end;
function Equivalent_Elements (Left, Right : Cursor)
return Boolean is
+
begin
if Left.Node = 0 then
raise Constraint_Error with
declare
LN : Node_Type renames Left.Container.Nodes (Left.Node);
RN : Node_Type renames Right.Container.Nodes (Right.Node);
-
begin
return Equivalent_Elements (LN.Element, RN.Element);
end;
end Equivalent_Elements;
- function Equivalent_Elements (Left : Cursor; Right : Element_Type)
- return Boolean is
+ function Equivalent_Elements
+ (Left : Cursor;
+ Right : Element_Type) return Boolean
+ is
begin
if Left.Node = 0 then
raise Constraint_Error with
end;
end Equivalent_Elements;
- function Equivalent_Elements (Left : Element_Type; Right : Cursor)
- return Boolean is
+ function Equivalent_Elements
+ (Left : Element_Type;
+ Right : Cursor) return Boolean
+ is
begin
if Right.Node = 0 then
raise Constraint_Error with
-- Equivalent_Keys --
---------------------
- function Equivalent_Keys (Key : Element_Type; Node : Node_Type)
- return Boolean is
+ function Equivalent_Keys
+ (Key : Element_Type;
+ Node : Node_Type) return Boolean
+ is
begin
return Equivalent_Elements (Key, Node.Element);
end Equivalent_Keys;
Item : Element_Type) return Cursor
is
Node : constant Count_Type := Element_Keys.Find (Container, Item);
-
begin
- if Node = 0 then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = 0 then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Find;
-----------
function First (Container : Set) return Cursor is
Node : constant Count_Type := HT_Ops.First (Container);
-
begin
- if Node = 0 then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = 0 then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end First;
overriding function First (Object : Iterator) return Cursor is
Node : constant Count_Type := HT_Ops.First (Object.Container.all);
begin
- if Node = 0 then
- return No_Element;
- end if;
-
- return Cursor'(Object.Container, Node);
+ return (if Node = 0 then No_Element
+ else Cursor'(Object.Container, Node));
end First;
-----------------
"Position cursor designates wrong set";
end if;
- if Position.Node = 0 then
- return No_Element;
- end if;
-
- return Next (Position);
+ return (if Position.Node = 0 then No_Element else Next (Position));
end Next;
-------------
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type
is
+ pragma Unreferenced (Container);
S : Set renames Position.Container.all;
N : Node_Type renames S.Nodes (Position.Node);
-
begin
- pragma Unreferenced (Container);
-
return (Element => N.Element'Unrestricted_Access);
end Constant_Reference;
N : Node_Type renames Left.Nodes (L_Node);
X : Count_Type;
B : Boolean;
-
begin
if not Is_In (Right, N) then
Insert (Result, N.Element, X, B);
N : Node_Type renames Right.Nodes (R_Node);
X : Count_Type;
B : Boolean;
-
begin
if not Is_In (Left, N) then
Insert (Result, N.Element, X, B);
function To_Set (New_Item : Element_Type) return Set is
X : Count_Type;
B : Boolean;
-
begin
return Result : Set (1, 1) do
Insert (Result, New_Item, X, B);
N : Node_Type renames Source.Nodes (Src_Node);
X : Count_Type;
B : Boolean;
-
begin
Insert (Target, N.Element, X, B);
end Process;
"attempt to tamper with cursors (set is busy)";
end if;
- -- ???
+ -- ??? why is this code commented out ???
-- declare
-- N : constant Count_Type := Target.Length + Source.Length;
-- begin
(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
- if Node = 0 then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = 0 then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Find;
---------
end if;
pragma Assert (Vet (Position), "bad cursor in function Key");
-
return Key (Position.Container.Nodes (Position.Node).Element);
end Key;
Key : Key_Type;
New_Item : Element_Type)
is
- Node : constant Count_Type :=
- Key_Keys.Find (Container, Key);
+ Node : constant Count_Type := Key_Keys.Find (Container, Key);
begin
if Node = 0 then
"Position cursor designates wrong set";
end if;
- -- ???
+ -- ??? why is this code commented out ???
-- if HT.Buckets = null
-- or else HT.Buckets'Length = 0
-- or else HT.Length = 0
(Vet (Position),
"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));
declare
function Reference_Preserving_Key
(Container : aliased in out Set;
- Key : Key_Type) return Reference_Type
+ Key : Key_Type) return Reference_Type
is
Position : constant Cursor := Find (Container, Key);
- N : Node_Type renames Container.Nodes (Position.Node);
+ N : Node_Type renames Container.Nodes (Position.Node);
begin
return (Element => N.Element'Unrestricted_Access);
end Reference_Preserving_Key;
function Constant_Reference
(Container : aliased Set;
- Position : Cursor)
- return Constant_Reference_Type;
+ Position : Cursor) return Constant_Reference_Type;
procedure Assign (Target : in out Set; Source : Set);
-- If Target denotes the same object as Source, then the operation has no
Process : not null access procedure (Position : Cursor));
-- Calls Process for each node in the set
- function Iterate (Container : Set)
- return Set_Iterator_Interfaces.Forward_Iterator'Class;
+ function Iterate
+ (Container : Set)
+ return Set_Iterator_Interfaces.Forward_Iterator'Class;
generic
type Key_Type (<>) is private;
function Reference_Preserving_Key
(Container : aliased in out Set;
- Position : Cursor)
- return Reference_Type;
+ Position : Cursor) return Reference_Type;
function Reference_Preserving_Key
(Container : aliased in out Set;
- Key : Key_Type)
- return Reference_Type;
+ Key : Key_Type) return Reference_Type;
private
type Reference_Type (Element : not null access Element_Type)
end Generic_Keys;
private
-
pragma Inline (Next);
type Node_Type is record
for Constant_Reference_Type'Write use Write;
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;
overriding function First (Object : Child_Iterator) return Cursor;
overriding function Next
- (Object : Child_Iterator;
+ (Object : Child_Iterator;
Position : Cursor) return Cursor;
overriding function Previous
- (Object : Child_Iterator;
+ (Object : Child_Iterator;
Position : Cursor) return Cursor;
overriding function Last (Object : Child_Iterator) return Cursor;
begin
if Capacity = 0 then
C := Source.Count;
-
elsif Capacity >= Source.Count then
C := Capacity;
-
else
raise Capacity_Error with "Capacity value too small";
end if;
-- nodes that contain elements that have been inserted onto the tree,
-- and another for the "inactive" nodes of the free store, from which
-- nodes are allocated when a new child is inserted in the tree.
- --
+
-- We desire that merely declaring a tree object should have only
-- minimal cost; specially, we want to avoid having to initialize the
-- free store (to fill in the links), especially if the capacity of the
-- tree object is large.
- --
+
-- 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
-- the "normal" way: Container.Free points to the head of the list of
-- 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
-- that this is the last node of the free list.
- --
+
-- 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
-- free store comprises the components of the node array started with
-- the absolute value of Container.Free, and continuing until the end of
-- the array (Nodes'Last).
- --
+
-- 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)
-- 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
-- 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.
- --
+
-- It might be possible to perform an optimization here. Suppose that
-- the free store can be represented as having two parts: one comprising
-- the non-contiguous inactive nodes linked together in the normal way,
Right_Subtree : Count_Type) return Boolean
is
begin
- if Left_Tree.Elements (Left_Subtree)
- /= Right_Tree.Elements (Right_Subtree)
+ if Left_Tree.Elements (Left_Subtree) /=
+ Right_Tree.Elements (Right_Subtree)
then
return False;
end if;
function First (Object : Child_Iterator) return Cursor is
Node : Count_Type'Base;
-
begin
Node := Object.Container.Nodes (Object.Position.Node).Children.First;
return (Object.Container, Node);
function Is_Root (Position : Cursor) return Boolean is
begin
- if Position.Container = null then
- return False;
- end if;
-
- return Position.Node = Root_Node (Position.Container.all);
+ return
+ (if Position.Container = null then False
+ else Position.Node = Root_Node (Position.Container.all));
end Is_Root;
-------------
function Iterate_Children
(Container : Tree;
Parent : Cursor)
- return Tree_Iterator_Interfaces.Reversible_Iterator'Class
+ return Tree_Iterator_Interfaces.Reversible_Iterator'Class
is
pragma Unreferenced (Container);
begin
end Next;
function Next
- (Object : Child_Iterator;
+ (Object : Child_Iterator;
Position : Cursor) return Cursor
is
-
begin
if Object.Container /= Position.Container then
raise Program_Error;
--------------
overriding function Previous
- (Object : Child_Iterator;
+ (Object : Child_Iterator;
Position : Cursor) return Cursor
is
begin
function Iterate_Children
(Container : Tree;
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 New_Node return Count_Type is
Result : Count_Type;
-
begin
Allocate (Target, Result);
return Result;
function Ceiling (Container : Set; Item : Element_Type) return Cursor is
Node : constant Count_Type :=
Element_Keys.Ceiling (Container, Item);
-
begin
- if Node = 0 then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = 0 then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Ceiling;
-----------
begin
if Capacity = 0 then
C := Source.Length;
-
elsif Capacity >= Source.Length then
C := Capacity;
-
else
raise Capacity_Error with "Capacity value too small";
end if;
procedure Delete_First (Container : in out Set) is
X : constant Count_Type := Container.First;
-
begin
if X /= 0 then
Tree_Operations.Delete_Node_Sans_Free (Container, X);
procedure Delete_Last (Container : in out Set) is
X : constant Count_Type := Container.Last;
-
begin
if X /= 0 then
Tree_Operations.Delete_Node_Sans_Free (Container, X);
function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
begin
- if Left < Right
- or else Right < Left
- then
- return False;
- else
- return True;
- end if;
+ return (if Left < Right or else Right < Left then False else True);
end Equivalent_Elements;
---------------------
function Is_Equivalent_Node_Node (L, R : Node_Type) return Boolean is
begin
- if L.Element < R.Element then
- return False;
- elsif R.Element < L.Element then
- return False;
- else
- return True;
- end if;
+ return (if L.Element < R.Element then False
+ elsif R.Element < L.Element then False
+ else True);
end Is_Equivalent_Node_Node;
-- Start of processing for Equivalent_Sets
procedure Exclude (Container : in out Set; Item : Element_Type) is
X : constant Count_Type := Element_Keys.Find (Container, Item);
-
begin
if X /= 0 then
Tree_Operations.Delete_Node_Sans_Free (Container, X);
function Find (Container : Set; Item : Element_Type) return Cursor is
Node : constant Count_Type := Element_Keys.Find (Container, Item);
-
begin
- if Node = 0 then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = 0 then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Find;
-----------
function First (Container : Set) return Cursor is
begin
- if Container.First = 0 then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Container.First);
+ return (if Container.First = 0 then No_Element
+ else Cursor'(Container'Unrestricted_Access, Container.First));
end First;
function First (Object : Iterator) return Cursor is
begin
- if Object.Container.First = 0 then
- return No_Element;
- else
- return
- Cursor'(
- Object.Container.all'Unrestricted_Access,
- Object.Container.First);
- end if;
+ return (if Object.Container.First = 0 then No_Element
+ else Cursor'(Object.Container.all'Unrestricted_Access,
+ Object.Container.First));
end First;
-------------------
function Floor (Container : Set; Item : Element_Type) return Cursor is
Node : constant Count_Type := Element_Keys.Floor (Container, Item);
-
begin
- if Node = 0 then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = 0 then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Floor;
------------------
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
Node : constant Count_Type :=
Key_Keys.Ceiling (Container, Key);
-
begin
- if Node = 0 then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = 0 then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Ceiling;
--------------
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
begin
- if Left < Right
- or else Right < Left
- then
- return False;
- else
- return True;
- end if;
+ return (if Left < Right or else Right < Left then False else True);
end Equivalent_Keys;
-------------
procedure Exclude (Container : in out Set; Key : Key_Type) is
X : constant Count_Type := Key_Keys.Find (Container, Key);
-
begin
if X /= 0 then
Tree_Operations.Delete_Node_Sans_Free (Container, X);
function Find (Container : Set; Key : Key_Type) return Cursor is
Node : constant Count_Type := Key_Keys.Find (Container, Key);
-
begin
- if Node = 0 then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = 0 then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Find;
-----------
function Floor (Container : Set; Key : Key_Type) return Cursor is
Node : constant Count_Type := Key_Keys.Floor (Container, Key);
-
begin
- if Node = 0 then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = 0 then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Floor;
-------------------------
function New_Node return Count_Type is
Result : Count_Type;
-
begin
Allocate (Container, Result);
return Result;
function New_Node return Count_Type is
Result : Count_Type;
-
begin
Allocate (Dst_Set, Result);
return Result;
function Last (Container : Set) return Cursor is
begin
- if Container.Last = 0 then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Container.Last);
+ return (if Container.Last = 0 then No_Element
+ else Cursor'(Container'Unrestricted_Access, Container.Last));
end Last;
function Last (Object : Iterator) return Cursor is
begin
- if Object.Container.Last = 0 then
- return No_Element;
- else
- return Cursor'(
- Object.Container.all'Unrestricted_Access,
- Object.Container.Last);
- end if;
+ return (if Object.Container.Last = 0 then No_Element
+ else Cursor'(Object.Container.all'Unrestricted_Access,
+ Object.Container.Last));
end Last;
------------------
function Next (Object : Iterator; Position : Cursor) return Cursor is
pragma Unreferenced (Object);
-
begin
return Next (Position);
end Next;
Tree_Operations.Previous
(Position.Container.all,
Position.Node);
-
begin
- if Node = 0 then
- return No_Element;
- end if;
-
- return Cursor'(Position.Container, Node);
+ return (if Node = 0 then No_Element
+ else Cursor'(Position.Container, Node));
end;
end Previous;
declare
S : Set renames Position.Container.all;
-
B : Natural renames S.Busy;
L : Natural renames S.Lock;
function New_Node return Count_Type is
begin
Node.Element := Item;
- Node.Color := Red_Black_Trees.Red;
- Node.Parent := 0;
- Node.Right := 0;
- Node.Left := 0;
-
+ Node.Color := Red_Black_Trees.Red;
+ Node.Parent := 0;
+ Node.Right := 0;
+ Node.Left := 0;
return Index;
end New_Node;
overriding function First (Object : Iterator) return Cursor;
overriding function Next
- (Object : Iterator;
+ (Object : Iterator;
Position : Cursor) return Cursor;
-----------------------
-- Equivalent_Elements --
-------------------------
- function Equivalent_Elements (Left, Right : Cursor)
- return Boolean is
+ function Equivalent_Elements (Left, Right : Cursor) return Boolean is
begin
if Left.Node = null then
raise Constraint_Error with
Right.Node.Element.all);
end Equivalent_Elements;
- function Equivalent_Elements (Left : Cursor; Right : Element_Type)
- return Boolean is
+ function Equivalent_Elements
+ (Left : Cursor;
+ Right : Element_Type) return Boolean
+ is
begin
if Left.Node = null then
raise Constraint_Error with
return Equivalent_Elements (Left.Node.Element.all, Right);
end Equivalent_Elements;
- function Equivalent_Elements (Left : Element_Type; Right : Cursor)
- return Boolean is
+ function Equivalent_Elements
+ (Left : Element_Type;
+ Right : Cursor) return Boolean
+ is
begin
if Right.Node = null then
raise Constraint_Error with
-- Equivalent_Keys --
---------------------
- function Equivalent_Keys (Key : Element_Type; Node : Node_Access)
- return Boolean is
+ function Equivalent_Keys
+ (Key : Element_Type;
+ Node : Node_Access) return Boolean
+ is
begin
return Equivalent_Elements (Key, Node.Element.all);
end Equivalent_Keys;
Item : Element_Type) return Cursor
is
Node : constant Node_Access := Element_Keys.Find (Container.HT, Item);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Find;
--------------------
function First (Container : Set) return Cursor is
Node : constant Node_Access := HT_Ops.First (Container.HT);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end First;
function First (Object : Iterator) return Cursor is
Node : constant Node_Access := HT_Ops.First (Object.Container.HT);
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Object.Container, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Object.Container, Node));
end First;
----------
function New_Node (Next : Node_Access) return Node_Access is
Element : Element_Access := new Element_Type'(New_Item);
-
begin
return new Node_Type'(Element, Next);
exception
declare
HT : Hash_Table_Type renames Position.Container.HT;
Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Position.Container, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Position.Container, Node));
end;
end Next;
end Next;
function Next
- (Object : Iterator;
+ (Object : Iterator;
Position : Cursor) return Cursor
is
begin
"Position cursor designates wrong set";
end if;
- if Position.Node = null then
- return No_Element;
- end if;
-
- return Next (Position);
+ return (if Position.Node = null then No_Element else Next (Position));
end Next;
-------------
(Stream : not null access Root_Stream_Type'Class) return Node_Access
is
X : Element_Access := new Element_Type'(Element_Type'Input (Stream));
-
begin
return new Node_Type'(X, null);
exception
(Container : aliased Set;
Position : Cursor) return Constant_Reference_Type
is
- begin
pragma Unreferenced (Container);
-
+ begin
return (Element => Position.Node.Element);
end Constant_Reference;
Iterate_Source_When_Empty_Target : declare
procedure Process (Src_Node : Node_Access);
- procedure Iterate is
- new HT_Ops.Generic_Iteration (Process);
+ procedure Iterate is new HT_Ops.Generic_Iteration (Process);
-------------
-- Process --
------------
function To_Set (New_Item : Element_Type) return Set is
- HT : Hash_Table_Type;
-
+ HT : Hash_Table_Type;
Node : Node_Access;
Inserted : Boolean;
pragma Unreferenced (Node, Inserted);
-
begin
Insert (HT, New_Item, Node, Inserted);
return Set'(Controlled with HT);
function New_Node (Next : Node_Access) return Node_Access is
Tgt : Element_Access := new Element_Type'(Src);
-
begin
return new Node_Type'(Tgt, Next);
exception
-------------
procedure Process (L_Node : Node_Access) is
- Src : Element_Type renames L_Node.Element.all;
-
- J : constant Hash_Type := Hash (Src) mod Buckets'Length;
-
+ Src : Element_Type renames L_Node.Element.all;
+ J : constant Hash_Type := Hash (Src) mod Buckets'Length;
Bucket : Node_Access renames Buckets (J);
-
- Tgt : Element_Access := new Element_Type'(Src);
-
+ Tgt : Element_Access := new Element_Type'(Src);
begin
Bucket := new Node_Type'(Tgt, Bucket);
exception
Key : Key_Type) return Cursor
is
Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Find;
---------
function Reference_Preserving_Key
(Container : aliased in out Set;
- Key : Key_Type) return Reference_Type
+ Key : Key_Type) return Reference_Type
is
Position : constant Cursor := Find (Container, Key);
begin
function Reference_Preserving_Key
(Container : aliased in out Set;
- Position : Cursor)
- return Reference_Type;
+ Position : Cursor) return Reference_Type;
function Reference_Preserving_Key
(Container : aliased in out Set;
- Key : Key_Type)
- return Reference_Type;
+ Key : Key_Type) return Reference_Type;
private
type Reference_Type (Element : not null access Element_Type)
end Generic_Keys;
private
-
pragma Inline (Next);
type Node_Type;
-- Adjust --
------------
- procedure Adjust is
- new Tree_Operations.Generic_Adjust (Copy_Tree);
+ procedure Adjust is new Tree_Operations.Generic_Adjust (Copy_Tree);
procedure Adjust (Container : in out Map) is
begin
function Ceiling (Container : Map; Key : Key_Type) return Cursor is
Node : constant Node_Access := Key_Ops.Ceiling (Container.Tree, Key);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Ceiling;
-----------
-- Clear --
-----------
- procedure Clear is
- new Tree_Operations.Generic_Clear (Delete_Tree);
+ procedure Clear is new Tree_Operations.Generic_Clear (Delete_Tree);
procedure Clear (Container : in out Map) is
begin
(Container : Map;
Key : Key_Type) return Constant_Reference_Type
is
- begin return (Element => Container.Element (Key)'Unrestricted_Access);
+ begin
+ return (Element => Container.Element (Key)'Unrestricted_Access);
end Constant_Reference;
--------------
function Copy_Node (Source : Node_Access) return Node_Access is
K : Key_Access := new Key_Type'(Source.Key.all);
E : Element_Access;
+
begin
E := new Element_Type'(Source.Element.all);
procedure Delete_First (Container : in out Map) is
X : Node_Access := Container.Tree.First;
-
begin
if X /= null then
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
procedure Delete_Last (Container : in out Map) is
X : Node_Access := Container.Tree.Last;
-
begin
if X /= null then
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
begin
- if Left < Right
- or else Right < Left
- then
- return False;
- else
- return True;
- end if;
+ return (if Left < Right or else Right < Left then False else True);
end Equivalent_Keys;
-------------
procedure Exclude (Container : in out Map; Key : Key_Type) is
X : Node_Access := Key_Ops.Find (Container.Tree, Key);
-
begin
if X /= null then
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
function Find (Container : Map; Key : Key_Type) return Cursor is
Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Find;
-----------
function First (Container : Map) return Cursor is
T : Tree_Type renames Container.Tree;
-
begin
- if T.First = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, T.First);
+ return (if T.First = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, T.First));
end First;
function First (Object : Iterator) return Cursor is
M : constant Map_Access := Object.Container;
N : constant Node_Access := M.Tree.First;
-
begin
- if N = null then
- return No_Element;
- else
- return Cursor'(Object.Container.all'Unchecked_Access, N);
- end if;
+ return (if N = null then No_Element
+ else Cursor'(Object.Container.all'Unchecked_Access, N));
end First;
-------------------
function Floor (Container : Map; Key : Key_Type) return Cursor is
Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Floor;
----------
begin
Free_Key (X.Key);
+
exception
when others =>
X.Key := null;
begin
Free_Element (X.Element);
+
exception
when others =>
X.Element := null;
-- Is_Equal_Node_Node --
------------------------
- function Is_Equal_Node_Node
- (L, R : Node_Access) return Boolean is
+ function Is_Equal_Node_Node (L, R : Node_Access) return Boolean is
begin
- if L.Key.all < R.Key.all then
- return False;
-
- elsif R.Key.all < L.Key.all then
- return False;
-
- else
- return L.Element.all = R.Element.all;
- end if;
+ return (if L.Key.all < R.Key.all then False
+ elsif R.Key.all < L.Key.all then False
+ else L.Element.all = R.Element.all);
end Is_Equal_Node_Node;
-------------------------
is
Node : constant Node_Access := Container.Tree.First;
It : constant Iterator := (Container'Unrestricted_Access, Node);
-
begin
return It;
end Iterate;
- function Iterate (Container : Map; Start : Cursor)
+ function Iterate
+ (Container : Map;
+ Start : Cursor)
return Map_Iterator_Interfaces.Reversible_Iterator'class
is
It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
function Last (Container : Map) return Cursor is
T : Tree_Type renames Container.Tree;
-
begin
- if T.Last = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, T.Last);
+ return (if T.Last = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, T.Last));
end Last;
function Last (Object : Iterator) return Cursor is
M : constant Map_Access := Object.Container;
N : constant Node_Access := M.Tree.Last;
begin
- if N = null then
- return No_Element;
- else
- return Cursor'(Object.Container.all'Unchecked_Access, N);
- end if;
+ return (if N = null then No_Element
+ else Cursor'(Object.Container.all'Unchecked_Access, N));
end Last;
------------------
-- Move --
----------
- procedure Move is
- new Tree_Operations.Generic_Move (Clear);
+ procedure Move is new Tree_Operations.Generic_Move (Clear);
procedure Move (Target : in out Map; Source : in out Map) is
begin
declare
Node : constant Node_Access :=
Tree_Operations.Next (Position.Node);
-
begin
- if Node = null then
- return No_Element;
- else
- return Cursor'(Position.Container, Node);
- end if;
+ return (if Node = null then No_Element
+ else Cursor'(Position.Container, Node));
end;
end Next;
Position : Cursor) return Cursor
is
begin
- if Position.Node = null then
- return No_Element;
- else
- return (Object.Container, Tree_Operations.Next (Position.Node));
- end if;
+ return (if Position.Node = null then No_Element
+ else (Object.Container, Tree_Operations.Next (Position.Node)));
end Next;
------------
declare
Node : constant Node_Access :=
Tree_Operations.Previous (Position.Node);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Position.Container, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Position.Container, Node));
end;
end Previous;
Position : Cursor) return Cursor
is
begin
- if Position.Node = null then
- return No_Element;
- else
- return (Object.Container, Tree_Operations.Previous (Position.Node));
- end if;
+ return
+ (if Position.Node = null then No_Element
+ else (Object.Container, Tree_Operations.Previous (Position.Node)));
end Previous;
-------------------
-- Adjust --
------------
- procedure Adjust is
- new Tree_Operations.Generic_Adjust (Copy_Tree);
+ procedure Adjust is new Tree_Operations.Generic_Adjust (Copy_Tree);
procedure Adjust (Container : in out Set) is
begin
function Ceiling (Container : Set; Item : Element_Type) return Cursor is
Node : constant Node_Access :=
Element_Keys.Ceiling (Container.Tree, Item);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Ceiling;
-----------
procedure Delete_First (Container : in out Set) is
Tree : Tree_Type renames Container.Tree;
X : Node_Access := Tree.First;
-
begin
if X /= null then
Tree_Operations.Delete_Node_Sans_Free (Tree, X);
procedure Delete_Last (Container : in out Set) is
Tree : Tree_Type renames Container.Tree;
X : Node_Access := Tree.Last;
-
begin
if X /= null then
Tree_Operations.Delete_Node_Sans_Free (Tree, X);
end Difference;
function Difference (Left, Right : Set) return Set is
- Tree : constant Tree_Type :=
- Set_Ops.Difference (Left.Tree, Right.Tree);
+ Tree : constant Tree_Type := Set_Ops.Difference (Left.Tree, Right.Tree);
begin
return Set'(Controlled with Tree);
end Difference;
function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
begin
- if Left < Right
- or else Right < Left
- then
+ if Left < Right or else Right < Left then
return False;
else
return True;
procedure Exclude (Container : in out Set; Item : Element_Type) is
X : Node_Access :=
Element_Keys.Find (Container.Tree, Item);
-
begin
if X /= null then
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
function First (Container : Set) return Cursor is
begin
- if Container.Tree.First = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
+ return
+ (if Container.Tree.First = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Container.Tree.First));
end First;
function First (Object : Iterator) return Cursor is
Node : constant Node_Access :=
Element_Keys.Floor (Container.Tree, Item);
begin
- if Node = null then
- return No_Element;
- else
- return Cursor'(Container'Unrestricted_Access, Node);
- end if;
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Floor;
----------
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
Node : constant Node_Access :=
Key_Keys.Ceiling (Container.Tree, Key);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Ceiling;
--------------
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
begin
- if Left < Right
- or else Right < Left
- then
+ if Left < Right or else Right < Left then
return False;
else
return True;
procedure Exclude (Container : in out Set; Key : Key_Type) is
X : Node_Access := Key_Keys.Find (Container.Tree, Key);
-
begin
if X /= null then
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
function Find (Container : Set; Key : Key_Type) return Cursor is
Node : constant Node_Access :=
Key_Keys.Find (Container.Tree, Key);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Find;
-----------
function Floor (Container : Set; Key : Key_Type) return Cursor is
Node : constant Node_Access :=
Key_Keys.Floor (Container.Tree, Key);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Floor;
-------------------------
function Is_Greater_Key_Node
(Left : Key_Type;
- Right : Node_Access) return Boolean is
+ Right : Node_Access) return Boolean
+ is
begin
return Key (Right.Element.all) < Left;
end Is_Greater_Key_Node;
function Is_Less_Key_Node
(Left : Key_Type;
- Right : Node_Access) return Boolean is
+ Right : Node_Access) return Boolean
+ is
begin
return Left < Key (Right.Element.all);
end Is_Less_Key_Node;
function Is_Greater_Element_Node
(Left : Element_Type;
- Right : Node_Access) return Boolean is
+ Right : Node_Access) return Boolean
+ is
begin
-- e > node same as node < e
function Is_Less_Element_Node
(Left : Element_Type;
- Right : Node_Access) return Boolean is
+ Right : Node_Access) return Boolean
+ is
begin
return Left < Right.Element.all;
end Is_Less_Element_Node;
function Last (Container : Set) return Cursor is
begin
- if Container.Tree.Last = null then
- return No_Element;
- else
- return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
- end if;
+ return
+ (if Container.Tree.Last = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Container.Tree.Last));
end Last;
function Last (Object : Iterator) return Cursor is
begin
- if Object.Container.Tree.Last = null then
- return No_Element;
- else
- return Cursor'(
- Object.Container.all'Unrestricted_Access,
- Object.Container.Tree.Last);
- end if;
+ return (if Object.Container.Tree.Last = null then No_Element
+ else Cursor'(Object.Container.all'Unrestricted_Access,
+ Object.Container.Tree.Last));
end Last;
------------------
-- Move --
----------
- procedure Move is
- new Tree_Operations.Generic_Move (Clear);
+ procedure Move is new Tree_Operations.Generic_Move (Clear);
procedure Move (Target : in out Set; Source : in out Set) is
begin
declare
Node : constant Node_Access :=
Tree_Operations.Next (Position.Node);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Position.Container, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Position.Container, Node));
end;
end Next;
declare
Node : constant Node_Access :=
Tree_Operations.Previous (Position.Node);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Position.Container, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Position.Container, Node));
end;
end Previous;
pragma Inline (New_Node);
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
- new Element_Keys.Generic_Conditional_Insert (Local_Insert_Post);
+ new Element_Keys.Generic_Conditional_Insert (Local_Insert_Post);
procedure Local_Insert_With_Hint is
- new Element_Keys.Generic_Conditional_Insert_With_Hint
- (Local_Insert_Post,
- Local_Insert_Sans_Hint);
+ new Element_Keys.Generic_Conditional_Insert_With_Hint
+ (Local_Insert_Post,
+ Local_Insert_Sans_Hint);
--------------
-- New_Node --
Node.Parent := null;
Node.Right := null;
Node.Left := null;
-
return Node;
end New_Node;
------------
function To_Set (New_Item : Element_Type) return Set is
- Tree : Tree_Type;
-
+ Tree : Tree_Type;
Node : Node_Access;
Inserted : Boolean;
pragma Unreferenced (Node, Inserted);
-
begin
Insert_Sans_Hint (Tree, New_Item, Node, Inserted);
return Set'(Controlled with Tree);
overriding function First (Object : Iterator) return Cursor;
overriding function Next
- (Object : Iterator;
+ (Object : Iterator;
Position : Cursor) return Cursor;
overriding function First (Object : Child_Iterator) return Cursor;
overriding function Next
- (Object : Child_Iterator;
+ (Object : Child_Iterator;
Position : Cursor) return Cursor;
overriding function Previous
- (Object : Child_Iterator;
+ (Object : Child_Iterator;
Position : Cursor) return Cursor;
overriding function Last (Object : Child_Iterator) return Cursor;
function Child_Count (Parent : Cursor) return Count_Type is
begin
- if Parent = No_Element then
- return 0;
- else
- return Child_Count (Parent.Node.Children);
- end if;
+ return (if Parent = No_Element
+ then 0 else Child_Count (Parent.Node.Children));
end Child_Count;
function Child_Count (Children : Children_Type) return Count_Type is
-- raise Program_Error with "Position cursor not in container";
-- end if;
- if Is_Root (Position) then
- Result := Find_In_Children (Position.Node, Item);
-
- else
- Result := Find_In_Subtree (Position.Node, Item);
- end if;
+ Result :=
+ (if Is_Root (Position)
+ then Find_In_Children (Position.Node, Item)
+ else Find_In_Subtree (Position.Node, Item));
if Result = null then
return No_Element;
function Iterate_Children
(Container : Tree;
Parent : Cursor)
- return Tree_Iterator_Interfaces.Reversible_Iterator'Class
+ return Tree_Iterator_Interfaces.Reversible_Iterator'Class
is
pragma Unreferenced (Container);
begin
end Iterate_Subtree;
procedure Iterate_Subtree
- (Position : Cursor;
- Process : not null access procedure (Position : Cursor))
+ (Position : Cursor;
+ Process : not null access procedure (Position : Cursor))
is
begin
if Position = No_Element then
function Last_Child (Parent : Cursor) return Cursor is
Node : Tree_Node_Access;
+
begin
if Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element";
----------
function Next
- (Object : Iterator;
+ (Object : Iterator;
Position : Cursor) return Cursor
is
T : Tree renames Position.Container.all;
end Next;
function Next
- (Object : Child_Iterator;
+ (Object : Child_Iterator;
Position : Cursor) return Cursor
is
C : constant Tree_Node_Access := Position.Node.Next;
-
begin
- if C = null then
- return No_Element;
-
- else
- return (Object.Container, C);
- end if;
+ return (if C = null then No_Element else (Object.Container, C));
end Next;
------------------
--------------
overriding function Previous
- (Object : Child_Iterator;
+ (Object : Child_Iterator;
Position : Cursor) return Cursor
is
C : constant Tree_Node_Access := Position.Node.Prev;
-
begin
- if C = null then
- return No_Element;
-
- else
- return (Object.Container, C);
- end if;
+ return (if C = null then No_Element else (Object.Container, C));
end Previous;
----------------------
function Previous_Sibling (Position : Cursor) return Cursor is
begin
- if Position = No_Element then
- return No_Element;
- end if;
-
- if Position.Node.Prev = null then
- return No_Element;
- end if;
-
- return Cursor'(Position.Container, Position.Node.Prev);
+ return
+ (if Position = No_Element then No_Element
+ elsif Position.Node.Prev = null then No_Element
+ else Cursor'(Position.Container, Position.Node.Prev));
end Previous_Sibling;
procedure Previous_Sibling (Position : in out Cursor) is
function Ceiling (Container : Set; Item : Element_Type) return Cursor is
Node : constant Node_Access :=
Element_Keys.Ceiling (Container.Tree, Item);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Ceiling;
-----------
procedure Delete_First (Container : in out Set) is
Tree : Tree_Type renames Container.Tree;
X : Node_Access := Tree.First;
-
begin
if X /= null then
Tree_Operations.Delete_Node_Sans_Free (Tree, X);
procedure Delete_Last (Container : in out Set) is
Tree : Tree_Type renames Container.Tree;
X : Node_Access := Tree.Last;
-
begin
if X /= null then
Tree_Operations.Delete_Node_Sans_Free (Tree, X);
function Equivalent_Elements (Left, Right : Element_Type) return Boolean is
begin
- if Left < Right
- or else Right < Left
- then
- return False;
- else
- return True;
- end if;
+ return (if Left < Right or else Right < Left then False else True);
end Equivalent_Elements;
---------------------
function Is_Equivalent_Node_Node (L, R : Node_Access) return Boolean is
begin
- if L.Element < R.Element then
- return False;
- elsif R.Element < L.Element then
- return False;
- else
- return True;
- end if;
+ return (if L.Element < R.Element then False
+ elsif R.Element < L.Element then False
+ else True);
end Is_Equivalent_Node_Node;
-- Start of processing for Equivalent_Sets
function Find (Container : Set; Item : Element_Type) return Cursor is
Node : constant Node_Access :=
Element_Keys.Find (Container.Tree, Item);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Find;
-----------
function First (Container : Set) return Cursor is
begin
- if Container.Tree.First = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
+ return
+ (if Container.Tree.First = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Container.Tree.First));
end First;
function First (Object : Iterator) return Cursor is
begin
- if Object.Container = null then
- return No_Element;
- else
- return
- Cursor'(
- Object.Container.all'Unrestricted_Access,
- Object.Container.Tree.First);
- end if;
+ return (if Object.Container = null then No_Element
+ else Cursor'(Object.Container.all'Unrestricted_Access,
+ Object.Container.Tree.First));
end First;
-------------------
function Floor (Container : Set; Item : Element_Type) return Cursor is
Node : constant Node_Access :=
Element_Keys.Floor (Container.Tree, Item);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Floor;
----------
procedure Free (X : in out Node_Access) is
procedure Deallocate is
new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
-
begin
if X /= null then
X.Parent := X;
- X.Left := X;
- X.Right := X;
-
+ X.Left := X;
+ X.Right := X;
Deallocate (X);
end if;
end Free;
function Ceiling (Container : Set; Key : Key_Type) return Cursor is
Node : constant Node_Access :=
Key_Keys.Ceiling (Container.Tree, Key);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Ceiling;
--------------
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
begin
- if Left < Right
- or else Right < Left
- then
- return False;
- else
- return True;
- end if;
+ return (if Left < Right or else Right < Left then False else True);
end Equivalent_Keys;
-------------
procedure Exclude (Container : in out Set; Key : Key_Type) is
X : Node_Access := Key_Keys.Find (Container.Tree, Key);
-
begin
if X /= null then
Delete_Node_Sans_Free (Container.Tree, X);
function Find (Container : Set; Key : Key_Type) return Cursor is
Node : constant Node_Access := Key_Keys.Find (Container.Tree, Key);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Find;
-----------
function Floor (Container : Set; Key : Key_Type) return Cursor is
Node : constant Node_Access := Key_Keys.Floor (Container.Tree, Key);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Container'Unrestricted_Access, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Node));
end Floor;
-------------------------
function Last (Container : Set) return Cursor is
begin
- if Container.Tree.Last = null then
- return No_Element;
- else
- return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
- end if;
+ return
+ (if Container.Tree.Last = null then No_Element
+ else Cursor'(Container'Unrestricted_Access, Container.Tree.Last));
end Last;
function Last (Object : Iterator) return Cursor is
begin
- if Object.Container = null then
- return No_Element;
- else
- return Cursor'(
- Object.Container.all'Unrestricted_Access,
- Object.Container.Tree.Last);
- end if;
+ return (if Object.Container = null then No_Element
+ else Cursor'(Object.Container.all'Unrestricted_Access,
+ Object.Container.Tree.Last));
end Last;
------------------
-- Move --
----------
- procedure Move is
- new Tree_Operations.Generic_Move (Clear);
+ procedure Move is new Tree_Operations.Generic_Move (Clear);
procedure Move (Target : in out Set; Source : in out Set) is
begin
declare
Node : constant Node_Access :=
Tree_Operations.Next (Position.Node);
-
begin
- if Node = null then
- return No_Element;
- end if;
-
- return Cursor'(Position.Container, Node);
+ return (if Node = null then No_Element
+ else Cursor'(Position.Container, Node));
end;
end Next;
Node : constant Node_Access :=
Tree_Operations.Previous (Position.Node);
begin
- if Node = null then
- return No_Element;
- else
- return Cursor'(Position.Container, Node);
- end if;
+ return (if Node = null then No_Element
+ else Cursor'(Position.Container, Node));
end;
end Previous;
(Stream : not null access Root_Stream_Type'Class) return Node_Access
is
Node : Node_Access := new Node_Type;
-
begin
Element_Type'Read (Stream, Node.Element);
return Node;
-
exception
when others =>
Free (Node);
function New_Node return Node_Access is
begin
Node.Element := Item;
- Node.Color := Red;
- Node.Parent := null;
- Node.Right := null;
- Node.Left := null;
-
+ Node.Color := Red;
+ Node.Parent := null;
+ Node.Right := null;
+ Node.Left := null;
return Node;
end New_Node;
-- Start of processing for Replace_Element
begin
- if Item < Node.Element
- or else Node.Element < Item
- then
+ if Item < Node.Element or else Node.Element < Item then
null;
else
-- incompatibility with Ada 95. Not clear whether this should be
-- 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 not In_Instance_Body
and then not OK_For_Limited_Init_In_05 (R_Type, Expr)
with Sem_Eval; use Sem_Eval;
with Sem_Intr; use Sem_Intr;
with Sem_Util; use Sem_Util;
+with Targparm; use Targparm;
with Sem_Type; use Sem_Type;
with Sem_Warn; use Sem_Warn;
with Sinfo; use Sinfo;
(Is_Real_Type (Etype (Rop))
and then Expr_Value_R (Rop) = Ureal_0))
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
when N_Op_Divide =>
- Apply_Compile_Time_Constraint_Error
- (N, "division by zero?", CE_Divide_By_Zero,
- Loc => Sloc (Right_Opnd (N)));
+
+ -- For division, we have two cases, for float division
+ -- 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 =>
Apply_Compile_Time_Constraint_Error
projects / thirdparty / gcc.git / commitdiff
