Skip to content

R
riscv-gcc-1
Commit ce72a9a3 by Arnaud Charlet
Options

[multiple changes] 

2011-10-06  Robert Dewar  <dewar@adacore.com>

	* a-ciorse.adb, a-cihase.adb, a-cihase.ads, a-coorse.adb,
	a-cborse.adb, a-comutr.adb, a-ciorma.adb, a-cbmutr.adb,
	a-cbmutr.ads, a-cbhase.adb, a-cbhase.ads: Minor reformatting and code
	reorganization (use conditional expressions).

2011-10-06  Robert Dewar  <dewar@adacore.com>

	* sem_res.adb (Resolve_Arithmetic_Op): Fix bad warning for
	floating divide by zero.

2011-10-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch6.adb: Limited interfaces that are not immutably limited
	are OK in return statements.

From-SVN: r179629
parent 908e19d0
Showing with 322 additions and 604 deletions
gcc/ada/ChangeLog
2011-10-06 Robert Dewar <dewar@adacore.com>
* a-ciorse.adb, a-cihase.adb, a-cihase.ads, a-coorse.adb,
a-cborse.adb, a-comutr.adb, a-ciorma.adb, a-cbmutr.adb,
a-cbmutr.ads, a-cbhase.adb, a-cbhase.ads: Minor reformatting and code
reorganization (use conditional expressions).
2011-10-06 Robert Dewar <dewar@adacore.com>
* sem_res.adb (Resolve_Arithmetic_Op): Fix bad warning for
floating divide by zero.
2011-10-06 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb: Limited interfaces that are not immutably limited
are OK in return statements.
2011-09-30 Iain Sandoe <iains@gcc.gnu.org> 2011-09-30 Iain Sandoe <iains@gcc.gnu.org>
* gcc-interface/Makefile.in (Darwin): Partial reversion of previous * gcc-interface/Makefile.in (Darwin): Partial reversion of previous
......
gcc/ada/a-cbhase.adb
...@@ -47,7 +47,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -47,7 +47,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
overriding function First (Object : Iterator) return Cursor; overriding function First (Object : Iterator) return Cursor;
overriding function Next overriding function Next
(Object : Iterator; (Object : Iterator;
Position : Cursor) return Cursor; Position : Cursor) return Cursor;
----------------------- -----------------------
...@@ -68,9 +68,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -68,9 +68,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
Node : out Count_Type; Node : out Count_Type;
Inserted : out Boolean); Inserted : out Boolean);
function Is_In function Is_In (HT : Set; Key : Node_Type) return Boolean;
(HT : Set;
Key : Node_Type) return Boolean;
pragma Inline (Is_In); pragma Inline (Is_In);
procedure Set_Element (Node : in out Node_Type; Item : Element_Type); procedure Set_Element (Node : in out Node_Type; Item : Element_Type);
...@@ -169,7 +167,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -169,7 +167,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
N : Node_Type renames Source.Nodes (Source_Node); N : Node_Type renames Source.Nodes (Source_Node);
X : Count_Type; X : Count_Type;
B : Boolean; B : Boolean;
begin begin
Insert (Target, N.Element, X, B); Insert (Target, N.Element, X, B);
pragma Assert (B); pragma Assert (B);
...@@ -233,10 +230,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -233,10 +230,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is
begin begin
if Capacity = 0 then if Capacity = 0 then
C := Source.Length; C := Source.Length;
elsif Capacity >= Source.Length then elsif Capacity >= Source.Length then
C := Capacity; C := Capacity;
else else
raise Capacity_Error with "Capacity value too small"; raise Capacity_Error with "Capacity value too small";
end if; end if;
...@@ -396,7 +391,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -396,7 +391,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
N : Node_Type renames Left.Nodes (L_Node); N : Node_Type renames Left.Nodes (L_Node);
X : Count_Type; X : Count_Type;
B : Boolean; B : Boolean;
begin begin
if not Is_In (Right, N) then if not Is_In (Right, N) then
Insert (Result, N.Element, X, B); -- optimize this ??? Insert (Result, N.Element, X, B); -- optimize this ???
...@@ -428,7 +422,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -428,7 +422,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
declare declare
S : Set renames Position.Container.all; S : Set renames Position.Container.all;
N : Node_Type renames S.Nodes (Position.Node); N : Node_Type renames S.Nodes (Position.Node);
begin begin
return N.Element; return N.Element;
end; end;
...@@ -488,6 +481,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -488,6 +481,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
function Equivalent_Elements (Left, Right : Cursor) function Equivalent_Elements (Left, Right : Cursor)
return Boolean is return Boolean is
begin begin
if Left.Node = 0 then if Left.Node = 0 then
raise Constraint_Error with raise Constraint_Error with
...@@ -505,14 +499,15 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -505,14 +499,15 @@ package body Ada.Containers.Bounded_Hashed_Sets is
declare declare
LN : Node_Type renames Left.Container.Nodes (Left.Node); LN : Node_Type renames Left.Container.Nodes (Left.Node);
RN : Node_Type renames Right.Container.Nodes (Right.Node); RN : Node_Type renames Right.Container.Nodes (Right.Node);
begin begin
return Equivalent_Elements (LN.Element, RN.Element); return Equivalent_Elements (LN.Element, RN.Element);
end; end;
end Equivalent_Elements; end Equivalent_Elements;
function Equivalent_Elements (Left : Cursor; Right : Element_Type) function Equivalent_Elements
return Boolean is (Left : Cursor;
Right : Element_Type) return Boolean
is
begin begin
if Left.Node = 0 then if Left.Node = 0 then
raise Constraint_Error with raise Constraint_Error with
...@@ -528,8 +523,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -528,8 +523,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is
end; end;
end Equivalent_Elements; end Equivalent_Elements;
function Equivalent_Elements (Left : Element_Type; Right : Cursor) function Equivalent_Elements
return Boolean is (Left : Element_Type;
Right : Cursor) return Boolean
is
begin begin
if Right.Node = 0 then if Right.Node = 0 then
raise Constraint_Error with raise Constraint_Error with
...@@ -551,8 +548,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -551,8 +548,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is
-- Equivalent_Keys -- -- Equivalent_Keys --
--------------------- ---------------------
function Equivalent_Keys (Key : Element_Type; Node : Node_Type) function Equivalent_Keys
return Boolean is (Key : Element_Type;
Node : Node_Type) return Boolean
is
begin begin
return Equivalent_Elements (Key, Node.Element); return Equivalent_Elements (Key, Node.Element);
end Equivalent_Keys; end Equivalent_Keys;
...@@ -580,13 +579,9 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -580,13 +579,9 @@ package body Ada.Containers.Bounded_Hashed_Sets is
Item : Element_Type) return Cursor Item : Element_Type) return Cursor
is is
Node : constant Count_Type := Element_Keys.Find (Container, Item); Node : constant Count_Type := Element_Keys.Find (Container, Item);
begin begin
if Node = 0 then return (if Node = 0 then No_Element
return No_Element; else Cursor'(Container'Unrestricted_Access, Node));
end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Find; end Find;
----------- -----------
...@@ -595,23 +590,16 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -595,23 +590,16 @@ package body Ada.Containers.Bounded_Hashed_Sets is
function First (Container : Set) return Cursor is function First (Container : Set) return Cursor is
Node : constant Count_Type := HT_Ops.First (Container); Node : constant Count_Type := HT_Ops.First (Container);
begin begin
if Node = 0 then return (if Node = 0 then No_Element
return No_Element; else Cursor'(Container'Unrestricted_Access, Node));
end if;
return Cursor'(Container'Unrestricted_Access, Node);
end First; end First;
overriding function First (Object : Iterator) return Cursor is overriding function First (Object : Iterator) return Cursor is
Node : constant Count_Type := HT_Ops.First (Object.Container.all); Node : constant Count_Type := HT_Ops.First (Object.Container.all);
begin begin
if Node = 0 then return (if Node = 0 then No_Element
return No_Element; else Cursor'(Object.Container, Node));
end if;
return Cursor'(Object.Container, Node);
end First; end First;
----------------- -----------------
...@@ -999,11 +987,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -999,11 +987,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
"Position cursor designates wrong set"; "Position cursor designates wrong set";
end if; end if;
if Position.Node = 0 then return (if Position.Node = 0 then No_Element else Next (Position));
return No_Element;
end if;
return Next (Position);
end Next; end Next;
------------- -------------
...@@ -1143,12 +1127,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -1143,12 +1127,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is
(Container : aliased Set; (Container : aliased Set;
Position : Cursor) return Constant_Reference_Type Position : Cursor) return Constant_Reference_Type
is is
pragma Unreferenced (Container);
S : Set renames Position.Container.all; S : Set renames Position.Container.all;
N : Node_Type renames S.Nodes (Position.Node); N : Node_Type renames S.Nodes (Position.Node);
begin begin
pragma Unreferenced (Container);
return (Element => N.Element'Unrestricted_Access); return (Element => N.Element'Unrestricted_Access);
end Constant_Reference; end Constant_Reference;
...@@ -1316,7 +1298,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -1316,7 +1298,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
N : Node_Type renames Left.Nodes (L_Node); N : Node_Type renames Left.Nodes (L_Node);
X : Count_Type; X : Count_Type;
B : Boolean; B : Boolean;
begin begin
if not Is_In (Right, N) then if not Is_In (Right, N) then
Insert (Result, N.Element, X, B); Insert (Result, N.Element, X, B);
...@@ -1344,7 +1325,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -1344,7 +1325,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
N : Node_Type renames Right.Nodes (R_Node); N : Node_Type renames Right.Nodes (R_Node);
X : Count_Type; X : Count_Type;
B : Boolean; B : Boolean;
begin begin
if not Is_In (Left, N) then if not Is_In (Left, N) then
Insert (Result, N.Element, X, B); Insert (Result, N.Element, X, B);
...@@ -1367,7 +1347,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -1367,7 +1347,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
function To_Set (New_Item : Element_Type) return Set is function To_Set (New_Item : Element_Type) return Set is
X : Count_Type; X : Count_Type;
B : Boolean; B : Boolean;
begin begin
return Result : Set (1, 1) do return Result : Set (1, 1) do
Insert (Result, New_Item, X, B); Insert (Result, New_Item, X, B);
...@@ -1396,7 +1375,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -1396,7 +1375,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
N : Node_Type renames Source.Nodes (Src_Node); N : Node_Type renames Source.Nodes (Src_Node);
X : Count_Type; X : Count_Type;
B : Boolean; B : Boolean;
begin begin
Insert (Target, N.Element, X, B); Insert (Target, N.Element, X, B);
end Process; end Process;
...@@ -1413,7 +1391,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -1413,7 +1391,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
"attempt to tamper with cursors (set is busy)"; "attempt to tamper with cursors (set is busy)";
end if; end if;
-- ??? -- ??? why is this code commented out ???
-- declare -- declare
-- N : constant Count_Type := Target.Length + Source.Length; -- N : constant Count_Type := Target.Length + Source.Length;
-- begin -- begin
...@@ -1661,15 +1639,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -1661,15 +1639,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is
(Container : Set; (Container : Set;
Key : Key_Type) return Cursor Key : Key_Type) return Cursor
is is
Node : constant Count_Type := Node : constant Count_Type := Key_Keys.Find (Container, Key);
Key_Keys.Find (Container, Key);
begin begin
if Node = 0 then return (if Node = 0 then No_Element
return No_Element; else Cursor'(Container'Unrestricted_Access, Node));
end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Find; end Find;
--------- ---------
...@@ -1684,7 +1657,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -1684,7 +1657,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
end if; end if;
pragma Assert (Vet (Position), "bad cursor in function Key"); pragma Assert (Vet (Position), "bad cursor in function Key");
return Key (Position.Container.Nodes (Position.Node).Element); return Key (Position.Container.Nodes (Position.Node).Element);
end Key; end Key;
...@@ -1697,8 +1669,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -1697,8 +1669,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
Key : Key_Type; Key : Key_Type;
New_Item : Element_Type) New_Item : Element_Type)
is is
Node : constant Count_Type := Node : constant Count_Type := Key_Keys.Find (Container, Key);
Key_Keys.Find (Container, Key);
begin begin
if Node = 0 then if Node = 0 then
...@@ -1733,7 +1704,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -1733,7 +1704,7 @@ package body Ada.Containers.Bounded_Hashed_Sets is
"Position cursor designates wrong set"; "Position cursor designates wrong set";
end if; end if;
-- ??? -- ??? why is this code commented out ???
-- if HT.Buckets = null -- if HT.Buckets = null
-- or else HT.Buckets'Length = 0 -- or else HT.Buckets'Length = 0
-- or else HT.Length = 0 -- or else HT.Length = 0
...@@ -1747,7 +1718,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -1747,7 +1718,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is
(Vet (Position), (Vet (Position),
"bad cursor in Update_Element_Preserving_Key"); "bad cursor in Update_Element_Preserving_Key");
-- Record bucket now, in case key is changed. -- Record bucket now, in case key is changed
Indx := HT_Ops.Index (Container.Buckets, N (Position.Node)); Indx := HT_Ops.Index (Container.Buckets, N (Position.Node));
declare declare
...@@ -1823,10 +1795,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -1823,10 +1795,10 @@ package body Ada.Containers.Bounded_Hashed_Sets is
function Reference_Preserving_Key function Reference_Preserving_Key
(Container : aliased in out Set; (Container : aliased in out Set;
Key : Key_Type) return Reference_Type Key : Key_Type) return Reference_Type
is is
Position : constant Cursor := Find (Container, Key); Position : constant Cursor := Find (Container, Key);
N : Node_Type renames Container.Nodes (Position.Node); N : Node_Type renames Container.Nodes (Position.Node);
begin begin
return (Element => N.Element'Unrestricted_Access); return (Element => N.Element'Unrestricted_Access);
end Reference_Preserving_Key; end Reference_Preserving_Key;
......
gcc/ada/a-cbhase.ads
...@@ -148,8 +148,7 @@ package Ada.Containers.Bounded_Hashed_Sets is ...@@ -148,8 +148,7 @@ package Ada.Containers.Bounded_Hashed_Sets is
function Constant_Reference function Constant_Reference
(Container : aliased Set; (Container : aliased Set;
Position : Cursor) Position : Cursor) return Constant_Reference_Type;
return Constant_Reference_Type;
procedure Assign (Target : in out Set; Source : Set); procedure Assign (Target : in out Set; Source : Set);
-- If Target denotes the same object as Source, then the operation has no -- If Target denotes the same object as Source, then the operation has no
...@@ -355,8 +354,9 @@ package Ada.Containers.Bounded_Hashed_Sets is ...@@ -355,8 +354,9 @@ package Ada.Containers.Bounded_Hashed_Sets is
Process : not null access procedure (Position : Cursor)); Process : not null access procedure (Position : Cursor));
-- Calls Process for each node in the set -- Calls Process for each node in the set
function Iterate (Container : Set) function Iterate
return Set_Iterator_Interfaces.Forward_Iterator'Class; (Container : Set)
return Set_Iterator_Interfaces.Forward_Iterator'Class;
generic generic
type Key_Type (<>) is private; type Key_Type (<>) is private;
...@@ -431,13 +431,11 @@ package Ada.Containers.Bounded_Hashed_Sets is ...@@ -431,13 +431,11 @@ package Ada.Containers.Bounded_Hashed_Sets is
function Reference_Preserving_Key function Reference_Preserving_Key
(Container : aliased in out Set; (Container : aliased in out Set;
Position : Cursor) Position : Cursor) return Reference_Type;
return Reference_Type;
function Reference_Preserving_Key function Reference_Preserving_Key
(Container : aliased in out Set; (Container : aliased in out Set;
Key : Key_Type) Key : Key_Type) return Reference_Type;
return Reference_Type;
private private
type Reference_Type (Element : not null access Element_Type) type Reference_Type (Element : not null access Element_Type)
...@@ -446,7 +444,6 @@ package Ada.Containers.Bounded_Hashed_Sets is ...@@ -446,7 +444,6 @@ package Ada.Containers.Bounded_Hashed_Sets is
end Generic_Keys; end Generic_Keys;
private private
pragma Inline (Next); pragma Inline (Next);
type Node_Type is record type Node_Type is record
...@@ -519,6 +516,6 @@ private ...@@ -519,6 +516,6 @@ private
for Constant_Reference_Type'Write use Write; for Constant_Reference_Type'Write use Write;
Empty_Set : constant Set := Empty_Set : constant Set :=
(Hash_Table_Type with Capacity => 0, Modulus => 0); (Hash_Table_Type with Capacity => 0, Modulus => 0);
end Ada.Containers.Bounded_Hashed_Sets; end Ada.Containers.Bounded_Hashed_Sets;
gcc/ada/a-cbmutr.adb
...@@ -54,11 +54,11 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -54,11 +54,11 @@ package body Ada.Containers.Bounded_Multiway_Trees is
overriding function First (Object : Child_Iterator) return Cursor; overriding function First (Object : Child_Iterator) return Cursor;
overriding function Next overriding function Next
(Object : Child_Iterator; (Object : Child_Iterator;
Position : Cursor) return Cursor; Position : Cursor) return Cursor;
overriding function Previous overriding function Previous
(Object : Child_Iterator; (Object : Child_Iterator;
Position : Cursor) return Cursor; Position : Cursor) return Cursor;
overriding function Last (Object : Child_Iterator) return Cursor; overriding function Last (Object : Child_Iterator) return Cursor;
...@@ -599,10 +599,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -599,10 +599,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is
begin begin
if Capacity = 0 then if Capacity = 0 then
C := Source.Count; C := Source.Count;
elsif Capacity >= Source.Count then elsif Capacity >= Source.Count then
C := Capacity; C := Capacity;
else else
raise Capacity_Error with "Capacity value too small"; raise Capacity_Error with "Capacity value too small";
end if; end if;
...@@ -841,12 +839,12 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -841,12 +839,12 @@ package body Ada.Containers.Bounded_Multiway_Trees is
-- nodes that contain elements that have been inserted onto the tree, -- nodes that contain elements that have been inserted onto the tree,
-- and another for the "inactive" nodes of the free store, from which -- and another for the "inactive" nodes of the free store, from which
-- nodes are allocated when a new child is inserted in the tree. -- nodes are allocated when a new child is inserted in the tree.
--
-- We desire that merely declaring a tree object should have only -- We desire that merely declaring a tree object should have only
-- minimal cost; specially, we want to avoid having to initialize the -- minimal cost; specially, we want to avoid having to initialize the
-- free store (to fill in the links), especially if the capacity of the -- free store (to fill in the links), especially if the capacity of the
-- tree object is large. -- tree object is large.
--
-- The head of the free list is indicated by Container.Free. If its -- The head of the free list is indicated by Container.Free. If its
-- value is non-negative, then the free store has been initialized in -- value is non-negative, then the free store has been initialized in
-- the "normal" way: Container.Free points to the head of the list of -- the "normal" way: Container.Free points to the head of the list of
...@@ -854,20 +852,20 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -854,20 +852,20 @@ package body Ada.Containers.Bounded_Multiway_Trees is
-- empty. Each node on the free list has been initialized to point to -- empty. Each node on the free list has been initialized to point to
-- the next free node (via its Next component), and the value 0 means -- the next free node (via its Next component), and the value 0 means
-- that this is the last node of the free list. -- that this is the last node of the free list.
--
-- If Container.Free is negative, then the links on the free store have -- If Container.Free is negative, then the links on the free store have
-- not been initialized. In this case the link values are implied: the -- not been initialized. In this case the link values are implied: the
-- free store comprises the components of the node array started with -- free store comprises the components of the node array started with
-- the absolute value of Container.Free, and continuing until the end of -- the absolute value of Container.Free, and continuing until the end of
-- the array (Nodes'Last). -- the array (Nodes'Last).
--
-- We prefer to lazy-init the free store (in fact, we would prefer to -- We prefer to lazy-init the free store (in fact, we would prefer to
-- not initialize it at all, because such initialization is an O(n) -- not initialize it at all, because such initialization is an O(n)
-- operation). The time when we need to actually initialize the nodes in -- operation). The time when we need to actually initialize the nodes in
-- the free store is when the node that becomes inactive is not at the -- the free store is when the node that becomes inactive is not at the
-- end of the active list. The free store would then be discontigous and -- end of the active list. The free store would then be discontigous and
-- so its nodes would need to be linked in the traditional way. -- so its nodes would need to be linked in the traditional way.
--
-- It might be possible to perform an optimization here. Suppose that -- It might be possible to perform an optimization here. Suppose that
-- the free store can be represented as having two parts: one comprising -- the free store can be represented as having two parts: one comprising
-- the non-contiguous inactive nodes linked together in the normal way, -- the non-contiguous inactive nodes linked together in the normal way,
...@@ -1218,8 +1216,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -1218,8 +1216,8 @@ package body Ada.Containers.Bounded_Multiway_Trees is
Right_Subtree : Count_Type) return Boolean Right_Subtree : Count_Type) return Boolean
is is
begin begin
if Left_Tree.Elements (Left_Subtree) if Left_Tree.Elements (Left_Subtree) /=
/= Right_Tree.Elements (Right_Subtree) Right_Tree.Elements (Right_Subtree)
then then
return False; return False;
end if; end if;
...@@ -1262,7 +1260,6 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -1262,7 +1260,6 @@ package body Ada.Containers.Bounded_Multiway_Trees is
function First (Object : Child_Iterator) return Cursor is function First (Object : Child_Iterator) return Cursor is
Node : Count_Type'Base; Node : Count_Type'Base;
begin begin
Node := Object.Container.Nodes (Object.Position.Node).Children.First; Node := Object.Container.Nodes (Object.Position.Node).Children.First;
return (Object.Container, Node); return (Object.Container, Node);
...@@ -1722,11 +1719,9 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -1722,11 +1719,9 @@ package body Ada.Containers.Bounded_Multiway_Trees is
function Is_Root (Position : Cursor) return Boolean is function Is_Root (Position : Cursor) return Boolean is
begin begin
if Position.Container = null then return
return False; (if Position.Container = null then False
end if; else Position.Node = Root_Node (Position.Container.all));
return Position.Node = Root_Node (Position.Container.all);
end Is_Root; end Is_Root;
------------- -------------
...@@ -1839,7 +1834,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -1839,7 +1834,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is
function Iterate_Children function Iterate_Children
(Container : Tree; (Container : Tree;
Parent : Cursor) Parent : Cursor)
return Tree_Iterator_Interfaces.Reversible_Iterator'Class return Tree_Iterator_Interfaces.Reversible_Iterator'Class
is is
pragma Unreferenced (Container); pragma Unreferenced (Container);
begin begin
...@@ -2039,10 +2034,9 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -2039,10 +2034,9 @@ package body Ada.Containers.Bounded_Multiway_Trees is
end Next; end Next;
function Next function Next
(Object : Child_Iterator; (Object : Child_Iterator;
Position : Cursor) return Cursor Position : Cursor) return Cursor
is is
begin begin
if Object.Container /= Position.Container then if Object.Container /= Position.Container then
raise Program_Error; raise Program_Error;
...@@ -2201,7 +2195,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -2201,7 +2195,7 @@ package body Ada.Containers.Bounded_Multiway_Trees is
-------------- --------------
overriding function Previous overriding function Previous
(Object : Child_Iterator; (Object : Child_Iterator;
Position : Cursor) return Cursor Position : Cursor) return Cursor
is is
begin begin
......
gcc/ada/a-cbmutr.ads
...@@ -182,7 +182,7 @@ package Ada.Containers.Bounded_Multiway_Trees is ...@@ -182,7 +182,7 @@ package Ada.Containers.Bounded_Multiway_Trees is
function Iterate_Children function Iterate_Children
(Container : Tree; (Container : Tree;
Parent : Cursor) Parent : Cursor)
return Tree_Iterator_Interfaces.Reversible_Iterator'Class; return Tree_Iterator_Interfaces.Reversible_Iterator'Class;
function Child_Count (Parent : Cursor) return Count_Type; function Child_Count (Parent : Cursor) return Count_Type;
......
gcc/ada/a-cihase.adb
...@@ -49,7 +49,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -49,7 +49,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
overriding function First (Object : Iterator) return Cursor; overriding function First (Object : Iterator) return Cursor;
overriding function Next overriding function Next
(Object : Iterator; (Object : Iterator;
Position : Cursor) return Cursor; Position : Cursor) return Cursor;
----------------------- -----------------------
...@@ -426,8 +426,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -426,8 +426,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
-- Equivalent_Elements -- -- Equivalent_Elements --
------------------------- -------------------------
function Equivalent_Elements (Left, Right : Cursor) function Equivalent_Elements (Left, Right : Cursor) return Boolean is
return Boolean is
begin begin
if Left.Node = null then if Left.Node = null then
raise Constraint_Error with raise Constraint_Error with
...@@ -457,8 +456,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -457,8 +456,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Right.Node.Element.all); Right.Node.Element.all);
end Equivalent_Elements; end Equivalent_Elements;
function Equivalent_Elements (Left : Cursor; Right : Element_Type) function Equivalent_Elements
return Boolean is (Left : Cursor;
Right : Element_Type) return Boolean
is
begin begin
if Left.Node = null then if Left.Node = null then
raise Constraint_Error with raise Constraint_Error with
...@@ -475,8 +476,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -475,8 +476,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
return Equivalent_Elements (Left.Node.Element.all, Right); return Equivalent_Elements (Left.Node.Element.all, Right);
end Equivalent_Elements; end Equivalent_Elements;
function Equivalent_Elements (Left : Element_Type; Right : Cursor) function Equivalent_Elements
return Boolean is (Left : Element_Type;
Right : Cursor) return Boolean
is
begin begin
if Right.Node = null then if Right.Node = null then
raise Constraint_Error with raise Constraint_Error with
...@@ -497,8 +500,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -497,8 +500,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
-- Equivalent_Keys -- -- Equivalent_Keys --
--------------------- ---------------------
function Equivalent_Keys (Key : Element_Type; Node : Node_Access) function Equivalent_Keys
return Boolean is (Key : Element_Type;
Node : Node_Access) return Boolean
is
begin begin
return Equivalent_Elements (Key, Node.Element.all); return Equivalent_Elements (Key, Node.Element.all);
end Equivalent_Keys; end Equivalent_Keys;
...@@ -535,13 +540,9 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -535,13 +540,9 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Item : Element_Type) return Cursor Item : Element_Type) return Cursor
is is
Node : constant Node_Access := Element_Keys.Find (Container.HT, Item); Node : constant Node_Access := Element_Keys.Find (Container.HT, Item);
begin begin
if Node = null then return (if Node = null then No_Element
return No_Element; else Cursor'(Container'Unrestricted_Access, Node));
end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Find; end Find;
-------------------- --------------------
...@@ -604,23 +605,16 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -604,23 +605,16 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
function First (Container : Set) return Cursor is function First (Container : Set) return Cursor is
Node : constant Node_Access := HT_Ops.First (Container.HT); Node : constant Node_Access := HT_Ops.First (Container.HT);
begin begin
if Node = null then return (if Node = null then No_Element
return No_Element; else Cursor'(Container'Unrestricted_Access, Node));
end if;
return Cursor'(Container'Unrestricted_Access, Node);
end First; end First;
function First (Object : Iterator) return Cursor is function First (Object : Iterator) return Cursor is
Node : constant Node_Access := HT_Ops.First (Object.Container.HT); Node : constant Node_Access := HT_Ops.First (Object.Container.HT);
begin begin
if Node = null then return (if Node = null then No_Element
return No_Element; else Cursor'(Object.Container, Node));
end if;
return Cursor'(Object.Container, Node);
end First; end First;
---------- ----------
...@@ -750,7 +744,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -750,7 +744,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
function New_Node (Next : Node_Access) return Node_Access is function New_Node (Next : Node_Access) return Node_Access is
Element : Element_Access := new Element_Type'(New_Item); Element : Element_Access := new Element_Type'(New_Item);
begin begin
return new Node_Type'(Element, Next); return new Node_Type'(Element, Next);
exception exception
...@@ -1025,13 +1018,9 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1025,13 +1018,9 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
declare declare
HT : Hash_Table_Type renames Position.Container.HT; HT : Hash_Table_Type renames Position.Container.HT;
Node : constant Node_Access := HT_Ops.Next (HT, Position.Node); Node : constant Node_Access := HT_Ops.Next (HT, Position.Node);
begin begin
if Node = null then return (if Node = null then No_Element
return No_Element; else Cursor'(Position.Container, Node));
end if;
return Cursor'(Position.Container, Node);
end; end;
end Next; end Next;
...@@ -1041,7 +1030,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1041,7 +1030,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
end Next; end Next;
function Next function Next
(Object : Iterator; (Object : Iterator;
Position : Cursor) return Cursor Position : Cursor) return Cursor
is is
begin begin
...@@ -1050,11 +1039,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1050,11 +1039,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
"Position cursor designates wrong set"; "Position cursor designates wrong set";
end if; end if;
if Position.Node = null then return (if Position.Node = null then No_Element else Next (Position));
return No_Element;
end if;
return Next (Position);
end Next; end Next;
------------- -------------
...@@ -1166,7 +1151,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1166,7 +1151,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
(Stream : not null access Root_Stream_Type'Class) return Node_Access (Stream : not null access Root_Stream_Type'Class) return Node_Access
is is
X : Element_Access := new Element_Type'(Element_Type'Input (Stream)); X : Element_Access := new Element_Type'(Element_Type'Input (Stream));
begin begin
return new Node_Type'(X, null); return new Node_Type'(X, null);
exception exception
...@@ -1183,9 +1167,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1183,9 +1167,8 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
(Container : aliased Set; (Container : aliased Set;
Position : Cursor) return Constant_Reference_Type Position : Cursor) return Constant_Reference_Type
is is
begin
pragma Unreferenced (Container); pragma Unreferenced (Container);
begin
return (Element => Position.Node.Element); return (Element => Position.Node.Element);
end Constant_Reference; end Constant_Reference;
...@@ -1301,8 +1284,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1301,8 +1284,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Iterate_Source_When_Empty_Target : declare Iterate_Source_When_Empty_Target : declare
procedure Process (Src_Node : Node_Access); procedure Process (Src_Node : Node_Access);
procedure Iterate is procedure Iterate is new HT_Ops.Generic_Iteration (Process);
new HT_Ops.Generic_Iteration (Process);
------------- -------------
-- Process -- -- Process --
...@@ -1535,12 +1517,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1535,12 +1517,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
------------ ------------
function To_Set (New_Item : Element_Type) return Set is function To_Set (New_Item : Element_Type) return Set is
HT : Hash_Table_Type; HT : Hash_Table_Type;
Node : Node_Access; Node : Node_Access;
Inserted : Boolean; Inserted : Boolean;
pragma Unreferenced (Node, Inserted); pragma Unreferenced (Node, Inserted);
begin begin
Insert (HT, New_Item, Node, Inserted); Insert (HT, New_Item, Node, Inserted);
return Set'(Controlled with HT); return Set'(Controlled with HT);
...@@ -1578,7 +1558,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1578,7 +1558,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
function New_Node (Next : Node_Access) return Node_Access is function New_Node (Next : Node_Access) return Node_Access is
Tgt : Element_Access := new Element_Type'(Src); Tgt : Element_Access := new Element_Type'(Src);
begin begin
return new Node_Type'(Tgt, Next); return new Node_Type'(Tgt, Next);
exception exception
...@@ -1655,14 +1634,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1655,14 +1634,10 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
------------- -------------
procedure Process (L_Node : Node_Access) is procedure Process (L_Node : Node_Access) is
Src : Element_Type renames L_Node.Element.all; Src : Element_Type renames L_Node.Element.all;
J : constant Hash_Type := Hash (Src) mod Buckets'Length;
J : constant Hash_Type := Hash (Src) mod Buckets'Length;
Bucket : Node_Access renames Buckets (J); Bucket : Node_Access renames Buckets (J);
Tgt : Element_Access := new Element_Type'(Src);
Tgt : Element_Access := new Element_Type'(Src);
begin begin
Bucket := new Node_Type'(Tgt, Bucket); Bucket := new Node_Type'(Tgt, Bucket);
exception exception
...@@ -1940,13 +1915,9 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1940,13 +1915,9 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
Key : Key_Type) return Cursor Key : Key_Type) return Cursor
is is
Node : constant Node_Access := Key_Keys.Find (Container.HT, Key); Node : constant Node_Access := Key_Keys.Find (Container.HT, Key);
begin begin
if Node = null then return (if Node = null then No_Element
return No_Element; else Cursor'(Container'Unrestricted_Access, Node));
end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Find; end Find;
--------- ---------
...@@ -2106,7 +2077,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -2106,7 +2077,7 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
function Reference_Preserving_Key function Reference_Preserving_Key
(Container : aliased in out Set; (Container : aliased in out Set;
Key : Key_Type) return Reference_Type Key : Key_Type) return Reference_Type
is is
Position : constant Cursor := Find (Container, Key); Position : constant Cursor := Find (Container, Key);
begin begin
......
gcc/ada/a-cihase.ads
...@@ -414,13 +414,11 @@ package Ada.Containers.Indefinite_Hashed_Sets is ...@@ -414,13 +414,11 @@ package Ada.Containers.Indefinite_Hashed_Sets is
function Reference_Preserving_Key function Reference_Preserving_Key
(Container : aliased in out Set; (Container : aliased in out Set;
Position : Cursor) Position : Cursor) return Reference_Type;
return Reference_Type;
function Reference_Preserving_Key function Reference_Preserving_Key
(Container : aliased in out Set; (Container : aliased in out Set;
Key : Key_Type) Key : Key_Type) return Reference_Type;
return Reference_Type;
private private
type Reference_Type (Element : not null access Element_Type) type Reference_Type (Element : not null access Element_Type)
...@@ -428,7 +426,6 @@ package Ada.Containers.Indefinite_Hashed_Sets is ...@@ -428,7 +426,6 @@ package Ada.Containers.Indefinite_Hashed_Sets is
end Generic_Keys; end Generic_Keys;
private private
pragma Inline (Next); pragma Inline (Next);
type Node_Type; type Node_Type;
......
gcc/ada/a-ciorma.adb
...@@ -279,8 +279,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -279,8 +279,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
-- Adjust -- -- Adjust --
------------ ------------
procedure Adjust is procedure Adjust is new Tree_Operations.Generic_Adjust (Copy_Tree);
new Tree_Operations.Generic_Adjust (Copy_Tree);
procedure Adjust (Container : in out Map) is procedure Adjust (Container : in out Map) is
begin begin
...@@ -293,21 +292,16 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -293,21 +292,16 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function Ceiling (Container : Map; Key : Key_Type) return Cursor is function Ceiling (Container : Map; Key : Key_Type) return Cursor is
Node : constant Node_Access := Key_Ops.Ceiling (Container.Tree, Key); Node : constant Node_Access := Key_Ops.Ceiling (Container.Tree, Key);
begin begin
if Node = null then return (if Node = null then No_Element
return No_Element; else Cursor'(Container'Unrestricted_Access, Node));
end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Ceiling; end Ceiling;
----------- -----------
-- Clear -- -- Clear --
----------- -----------
procedure Clear is procedure Clear is new Tree_Operations.Generic_Clear (Delete_Tree);
new Tree_Operations.Generic_Clear (Delete_Tree);
procedure Clear (Container : in out Map) is procedure Clear (Container : in out Map) is
begin begin
...@@ -331,7 +325,8 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -331,7 +325,8 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
(Container : Map; (Container : Map;
Key : Key_Type) return Constant_Reference_Type Key : Key_Type) return Constant_Reference_Type
is is
begin return (Element => Container.Element (Key)'Unrestricted_Access); begin
return (Element => Container.Element (Key)'Unrestricted_Access);
end Constant_Reference; end Constant_Reference;
-------------- --------------
...@@ -350,6 +345,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -350,6 +345,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function Copy_Node (Source : Node_Access) return Node_Access is function Copy_Node (Source : Node_Access) return Node_Access is
K : Key_Access := new Key_Type'(Source.Key.all); K : Key_Access := new Key_Type'(Source.Key.all);
E : Element_Access; E : Element_Access;
begin begin
E := new Element_Type'(Source.Element.all); E := new Element_Type'(Source.Element.all);
...@@ -418,7 +414,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -418,7 +414,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
procedure Delete_First (Container : in out Map) is procedure Delete_First (Container : in out Map) is
X : Node_Access := Container.Tree.First; X : Node_Access := Container.Tree.First;
begin begin
if X /= null then if X /= null then
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X); Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
...@@ -432,7 +427,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -432,7 +427,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
procedure Delete_Last (Container : in out Map) is procedure Delete_Last (Container : in out Map) is
X : Node_Access := Container.Tree.Last; X : Node_Access := Container.Tree.Last;
begin begin
if X /= null then if X /= null then
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X); Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
...@@ -479,13 +473,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -479,13 +473,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function Equivalent_Keys (Left, Right : Key_Type) return Boolean is function Equivalent_Keys (Left, Right : Key_Type) return Boolean is
begin begin
if Left < Right return (if Left < Right or else Right < Left then False else True);
or else Right < Left
then
return False;
else
return True;
end if;
end Equivalent_Keys; end Equivalent_Keys;
------------- -------------
...@@ -494,7 +482,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -494,7 +482,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
procedure Exclude (Container : in out Map; Key : Key_Type) is procedure Exclude (Container : in out Map; Key : Key_Type) is
X : Node_Access := Key_Ops.Find (Container.Tree, Key); X : Node_Access := Key_Ops.Find (Container.Tree, Key);
begin begin
if X /= null then if X /= null then
Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X); Tree_Operations.Delete_Node_Sans_Free (Container.Tree, X);
...@@ -508,13 +495,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -508,13 +495,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function Find (Container : Map; Key : Key_Type) return Cursor is function Find (Container : Map; Key : Key_Type) return Cursor is
Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key); Node : constant Node_Access := Key_Ops.Find (Container.Tree, Key);
begin begin
if Node = null then return (if Node = null then No_Element
return No_Element; else Cursor'(Container'Unrestricted_Access, Node));
end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Find; end Find;
----------- -----------
...@@ -523,25 +506,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -523,25 +506,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function First (Container : Map) return Cursor is function First (Container : Map) return Cursor is
T : Tree_Type renames Container.Tree; T : Tree_Type renames Container.Tree;
begin begin
if T.First = null then return (if T.First = null then No_Element
return No_Element; else Cursor'(Container'Unrestricted_Access, T.First));
end if;
return Cursor'(Container'Unrestricted_Access, T.First);
end First; end First;
function First (Object : Iterator) return Cursor is function First (Object : Iterator) return Cursor is
M : constant Map_Access := Object.Container; M : constant Map_Access := Object.Container;
N : constant Node_Access := M.Tree.First; N : constant Node_Access := M.Tree.First;
begin begin
if N = null then return (if N = null then No_Element
return No_Element; else Cursor'(Object.Container.all'Unchecked_Access, N));
else
return Cursor'(Object.Container.all'Unchecked_Access, N);
end if;
end First; end First;
------------------- -------------------
...@@ -580,13 +555,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -580,13 +555,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function Floor (Container : Map; Key : Key_Type) return Cursor is function Floor (Container : Map; Key : Key_Type) return Cursor is
Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key); Node : constant Node_Access := Key_Ops.Floor (Container.Tree, Key);
begin begin
if Node = null then return (if Node = null then No_Element
return No_Element; else Cursor'(Container'Unrestricted_Access, Node));
end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Floor; end Floor;
---------- ----------
...@@ -608,6 +579,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -608,6 +579,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin begin
Free_Key (X.Key); Free_Key (X.Key);
exception exception
when others => when others =>
X.Key := null; X.Key := null;
...@@ -625,6 +597,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -625,6 +597,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
begin begin
Free_Element (X.Element); Free_Element (X.Element);
exception exception
when others => when others =>
X.Element := null; X.Element := null;
...@@ -771,18 +744,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -771,18 +744,11 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
-- Is_Equal_Node_Node -- -- Is_Equal_Node_Node --
------------------------ ------------------------
function Is_Equal_Node_Node function Is_Equal_Node_Node (L, R : Node_Access) return Boolean is
(L, R : Node_Access) return Boolean is
begin begin
if L.Key.all < R.Key.all then return (if L.Key.all < R.Key.all then False
return False; elsif R.Key.all < L.Key.all then False
else L.Element.all = R.Element.all);
elsif R.Key.all < L.Key.all then
return False;
else
return L.Element.all = R.Element.all;
end if;
end Is_Equal_Node_Node; end Is_Equal_Node_Node;
------------------------- -------------------------
...@@ -856,12 +822,13 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -856,12 +822,13 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
is is
Node : constant Node_Access := Container.Tree.First; Node : constant Node_Access := Container.Tree.First;
It : constant Iterator := (Container'Unrestricted_Access, Node); It : constant Iterator := (Container'Unrestricted_Access, Node);
begin begin
return It; return It;
end Iterate; end Iterate;
function Iterate (Container : Map; Start : Cursor) function Iterate
(Container : Map;
Start : Cursor)
return Map_Iterator_Interfaces.Reversible_Iterator'class return Map_Iterator_Interfaces.Reversible_Iterator'class
is is
It : constant Iterator := (Container'Unrestricted_Access, Start.Node); It : constant Iterator := (Container'Unrestricted_Access, Start.Node);
...@@ -897,24 +864,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -897,24 +864,17 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
function Last (Container : Map) return Cursor is function Last (Container : Map) return Cursor is
T : Tree_Type renames Container.Tree; T : Tree_Type renames Container.Tree;
begin begin
if T.Last = null then return (if T.Last = null then No_Element
return No_Element; else Cursor'(Container'Unrestricted_Access, T.Last));
end if;
return Cursor'(Container'Unrestricted_Access, T.Last);
end Last; end Last;
function Last (Object : Iterator) return Cursor is function Last (Object : Iterator) return Cursor is
M : constant Map_Access := Object.Container; M : constant Map_Access := Object.Container;
N : constant Node_Access := M.Tree.Last; N : constant Node_Access := M.Tree.Last;
begin begin
if N = null then return (if N = null then No_Element
return No_Element; else Cursor'(Object.Container.all'Unchecked_Access, N));
else
return Cursor'(Object.Container.all'Unchecked_Access, N);
end if;
end Last; end Last;
------------------ ------------------
...@@ -969,8 +929,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -969,8 +929,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
-- Move -- -- Move --
---------- ----------
procedure Move is procedure Move is new Tree_Operations.Generic_Move (Clear);
new Tree_Operations.Generic_Move (Clear);
procedure Move (Target : in out Map; Source : in out Map) is procedure Move (Target : in out Map; Source : in out Map) is
begin begin
...@@ -996,13 +955,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -996,13 +955,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
declare declare
Node : constant Node_Access := Node : constant Node_Access :=
Tree_Operations.Next (Position.Node); Tree_Operations.Next (Position.Node);
begin begin
if Node = null then return (if Node = null then No_Element
return No_Element; else Cursor'(Position.Container, Node));
else
return Cursor'(Position.Container, Node);
end if;
end; end;
end Next; end Next;
...@@ -1016,11 +971,8 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -1016,11 +971,8 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
Position : Cursor) return Cursor Position : Cursor) return Cursor
is is
begin begin
if Position.Node = null then return (if Position.Node = null then No_Element
return No_Element; else (Object.Container, Tree_Operations.Next (Position.Node)));
else
return (Object.Container, Tree_Operations.Next (Position.Node));
end if;
end Next; end Next;
------------ ------------
...@@ -1051,13 +1003,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -1051,13 +1003,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
declare declare
Node : constant Node_Access := Node : constant Node_Access :=
Tree_Operations.Previous (Position.Node); Tree_Operations.Previous (Position.Node);
begin begin
if Node = null then return (if Node = null then No_Element
return No_Element; else Cursor'(Position.Container, Node));
end if;
return Cursor'(Position.Container, Node);
end; end;
end Previous; end Previous;
...@@ -1071,11 +1019,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -1071,11 +1019,9 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
Position : Cursor) return Cursor Position : Cursor) return Cursor
is is
begin begin
if Position.Node = null then return
return No_Element; (if Position.Node = null then No_Element
else else (Object.Container, Tree_Operations.Previous (Position.Node)));
return (Object.Container, Tree_Operations.Previous (Position.Node));
end if;
end Previous; end Previous;
------------------- -------------------
......
gcc/ada/a-comutr.adb
...@@ -48,16 +48,16 @@ package body Ada.Containers.Multiway_Trees is ...@@ -48,16 +48,16 @@ package body Ada.Containers.Multiway_Trees is
overriding function First (Object : Iterator) return Cursor; overriding function First (Object : Iterator) return Cursor;
overriding function Next overriding function Next
(Object : Iterator; (Object : Iterator;
Position : Cursor) return Cursor; Position : Cursor) return Cursor;
overriding function First (Object : Child_Iterator) return Cursor; overriding function First (Object : Child_Iterator) return Cursor;
overriding function Next overriding function Next
(Object : Child_Iterator; (Object : Child_Iterator;
Position : Cursor) return Cursor; Position : Cursor) return Cursor;
overriding function Previous overriding function Previous
(Object : Child_Iterator; (Object : Child_Iterator;
Position : Cursor) return Cursor; Position : Cursor) return Cursor;
overriding function Last (Object : Child_Iterator) return Cursor; overriding function Last (Object : Child_Iterator) return Cursor;
...@@ -327,11 +327,8 @@ package body Ada.Containers.Multiway_Trees is ...@@ -327,11 +327,8 @@ package body Ada.Containers.Multiway_Trees is
function Child_Count (Parent : Cursor) return Count_Type is function Child_Count (Parent : Cursor) return Count_Type is
begin begin
if Parent = No_Element then return (if Parent = No_Element
return 0; then 0 else Child_Count (Parent.Node.Children));
else
return Child_Count (Parent.Node.Children);
end if;
end Child_Count; end Child_Count;
function Child_Count (Children : Children_Type) return Count_Type is function Child_Count (Children : Children_Type) return Count_Type is
...@@ -1010,12 +1007,10 @@ package body Ada.Containers.Multiway_Trees is ...@@ -1010,12 +1007,10 @@ package body Ada.Containers.Multiway_Trees is
-- raise Program_Error with "Position cursor not in container"; -- raise Program_Error with "Position cursor not in container";
-- end if; -- end if;
if Is_Root (Position) then Result :=
Result := Find_In_Children (Position.Node, Item); (if Is_Root (Position)
then Find_In_Children (Position.Node, Item)
else else Find_In_Subtree (Position.Node, Item));
Result := Find_In_Subtree (Position.Node, Item);
end if;
if Result = null then if Result = null then
return No_Element; return No_Element;
...@@ -1437,7 +1432,7 @@ package body Ada.Containers.Multiway_Trees is ...@@ -1437,7 +1432,7 @@ package body Ada.Containers.Multiway_Trees is
function Iterate_Children function Iterate_Children
(Container : Tree; (Container : Tree;
Parent : Cursor) Parent : Cursor)
return Tree_Iterator_Interfaces.Reversible_Iterator'Class return Tree_Iterator_Interfaces.Reversible_Iterator'Class
is is
pragma Unreferenced (Container); pragma Unreferenced (Container);
begin begin
...@@ -1457,8 +1452,8 @@ package body Ada.Containers.Multiway_Trees is ...@@ -1457,8 +1452,8 @@ package body Ada.Containers.Multiway_Trees is
end Iterate_Subtree; end Iterate_Subtree;
procedure Iterate_Subtree procedure Iterate_Subtree
(Position : Cursor; (Position : Cursor;
Process : not null access procedure (Position : Cursor)) Process : not null access procedure (Position : Cursor))
is is
begin begin
if Position = No_Element then if Position = No_Element then
...@@ -1515,6 +1510,7 @@ package body Ada.Containers.Multiway_Trees is ...@@ -1515,6 +1510,7 @@ package body Ada.Containers.Multiway_Trees is
function Last_Child (Parent : Cursor) return Cursor is function Last_Child (Parent : Cursor) return Cursor is
Node : Tree_Node_Access; Node : Tree_Node_Access;
begin begin
if Parent = No_Element then if Parent = No_Element then
raise Constraint_Error with "Parent cursor has no element"; raise Constraint_Error with "Parent cursor has no element";
...@@ -1575,7 +1571,7 @@ package body Ada.Containers.Multiway_Trees is ...@@ -1575,7 +1571,7 @@ package body Ada.Containers.Multiway_Trees is
---------- ----------
function Next function Next
(Object : Iterator; (Object : Iterator;
Position : Cursor) return Cursor Position : Cursor) return Cursor
is is
T : Tree renames Position.Container.all; T : Tree renames Position.Container.all;
...@@ -1635,18 +1631,12 @@ package body Ada.Containers.Multiway_Trees is ...@@ -1635,18 +1631,12 @@ package body Ada.Containers.Multiway_Trees is
end Next; end Next;
function Next function Next
(Object : Child_Iterator; (Object : Child_Iterator;
Position : Cursor) return Cursor Position : Cursor) return Cursor
is is
C : constant Tree_Node_Access := Position.Node.Next; C : constant Tree_Node_Access := Position.Node.Next;
begin begin
if C = null then return (if C = null then No_Element else (Object.Container, C));
return No_Element;
else
return (Object.Container, C);
end if;
end Next; end Next;
------------------ ------------------
...@@ -1773,18 +1763,12 @@ package body Ada.Containers.Multiway_Trees is ...@@ -1773,18 +1763,12 @@ package body Ada.Containers.Multiway_Trees is
-------------- --------------
overriding function Previous overriding function Previous
(Object : Child_Iterator; (Object : Child_Iterator;
Position : Cursor) return Cursor Position : Cursor) return Cursor
is is
C : constant Tree_Node_Access := Position.Node.Prev; C : constant Tree_Node_Access := Position.Node.Prev;
begin begin
if C = null then return (if C = null then No_Element else (Object.Container, C));
return No_Element;
else
return (Object.Container, C);
end if;
end Previous; end Previous;
---------------------- ----------------------
...@@ -1793,15 +1777,10 @@ package body Ada.Containers.Multiway_Trees is ...@@ -1793,15 +1777,10 @@ package body Ada.Containers.Multiway_Trees is
function Previous_Sibling (Position : Cursor) return Cursor is function Previous_Sibling (Position : Cursor) return Cursor is
begin begin
if Position = No_Element then return
return No_Element; (if Position = No_Element then No_Element
end if; elsif Position.Node.Prev = null then No_Element
else Cursor'(Position.Container, Position.Node.Prev));
if Position.Node.Prev = null then
return No_Element;
end if;
return Cursor'(Position.Container, Position.Node.Prev);
end Previous_Sibling; end Previous_Sibling;
procedure Previous_Sibling (Position : in out Cursor) is procedure Previous_Sibling (Position : in out Cursor) is
......
gcc/ada/sem_ch6.adb
...@@ -452,7 +452,18 @@ package body Sem_Ch6 is ...@@ -452,7 +452,18 @@ package body Sem_Ch6 is
-- incompatibility with Ada 95. Not clear whether this should be -- incompatibility with Ada 95. Not clear whether this should be
-- enforced yet or perhaps controllable with special switch. ??? -- enforced yet or perhaps controllable with special switch. ???
if Is_Limited_Type (R_Type) -- A limited interface that is not immutably limited is OK.
if Is_Limited_Interface (R_Type)
and then
not (Is_Task_Interface (R_Type)
or else Is_Protected_Interface (R_Type)
or else Is_Synchronized_Interface (R_Type))
then
null;
elsif Is_Limited_Type (R_Type)
and then not Is_Interface (R_Type)
and then Comes_From_Source (N) and then Comes_From_Source (N)
and then not In_Instance_Body and then not In_Instance_Body
and then not OK_For_Limited_Init_In_05 (R_Type, Expr) and then not OK_For_Limited_Init_In_05 (R_Type, Expr)
......
gcc/ada/sem_res.adb
...@@ -64,6 +64,7 @@ with Sem_Elab; use Sem_Elab; ...@@ -64,6 +64,7 @@ with Sem_Elab; use Sem_Elab;
with Sem_Eval; use Sem_Eval; with Sem_Eval; use Sem_Eval;
with Sem_Intr; use Sem_Intr; with Sem_Intr; use Sem_Intr;
with Sem_Util; use Sem_Util; with Sem_Util; use Sem_Util;
with Targparm; use Targparm;
with Sem_Type; use Sem_Type; with Sem_Type; use Sem_Type;
with Sem_Warn; use Sem_Warn; with Sem_Warn; use Sem_Warn;
with Sinfo; use Sinfo; with Sinfo; use Sinfo;
...@@ -4874,13 +4875,33 @@ package body Sem_Res is ...@@ -4874,13 +4875,33 @@ package body Sem_Res is
(Is_Real_Type (Etype (Rop)) (Is_Real_Type (Etype (Rop))
and then Expr_Value_R (Rop) = Ureal_0)) and then Expr_Value_R (Rop) = Ureal_0))
then then
-- Specialize the warning message according to the operation -- Specialize the warning message according to the operation.
-- The following warnings are for the case
case Nkind (N) is case Nkind (N) is
when N_Op_Divide => when N_Op_Divide =>
Apply_Compile_Time_Constraint_Error
(N, "division by zero?", CE_Divide_By_Zero, -- For division, we have two cases, for float division
Loc => Sloc (Right_Opnd (N))); -- of an unconstrained float type, on a machine where
-- Machine_Overflows is false, we don't get an exception
-- at run-time, but rather an infinity or Nan. The Nan
-- case is pretty obscure, so just warn about infinities.
if Is_Floating_Point_Type (Typ)
and then not Is_Constrained (Typ)
and then not Machine_Overflows_On_Target
then
Error_Msg_N
("float division by zero, " &
"may generate '+'/'- infinity?", Right_Opnd (N));
-- For all other cases, we get a Constraint_Error
else
Apply_Compile_Time_Constraint_Error
(N, "division by zero?", CE_Divide_By_Zero,
Loc => Sloc (Right_Opnd (N)));
end if;
when N_Op_Rem => when N_Op_Rem =>
Apply_Compile_Time_Constraint_Error Apply_Compile_Time_Constraint_Error
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment