Skip to content

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

[multiple changes] 

2011-12-02  Matthew Heaney  <heaney@adacore.com>

	* a-coormu.ads, a-ciormu.ads: Declare iterator factory function.
	* a-ciormu.adb, a-ciormu.adb (Iterator): Declare concrete
	Iterator type.
	(Finalize): Decrement busy counter.
	(First, Last): Cursor return value depends on iterator node value.
	(Iterate): Use start position as iterator node value.
	(Next, Previous): Forward to corresponding cursor-based operation.

2011-12-02  Robert Dewar  <dewar@adacore.com>

	* a-cborma.adb, a-cbhama.adb, a-cbdlli.adb, a-cbmutr.adb,
	a-cbhase.adb, a-cdlili.adb, a-cihama.adb, a-ciorse.adb, a-cidlli.adb,
	a-cimutr.adb, a-cihase.adb, a-cohama.adb, a-cborse.adb,
	a-ciorma.adb, a-cobove.adb: Minor reformatting.

From-SVN: r181912
parent 3e44f600
Showing with 485 additions and 98 deletions
gcc/ada/ChangeLog
2011-12-02 Matthew Heaney <heaney@adacore.com>
* a-coormu.ads, a-ciormu.ads: Declare iterator factory function.
* a-ciormu.adb, a-ciormu.adb (Iterator): Declare concrete
Iterator type.
(Finalize): Decrement busy counter.
(First, Last): Cursor return value depends on iterator node value.
(Iterate): Use start position as iterator node value.
(Next, Previous): Forward to corresponding cursor-based operation.
2011-12-02 Robert Dewar <dewar@adacore.com>
* a-cborma.adb, a-cbhama.adb, a-cbdlli.adb, a-cbmutr.adb,
a-cbhase.adb, a-cdlili.adb, a-cihama.adb, a-ciorse.adb, a-cidlli.adb,
a-cimutr.adb, a-cihase.adb, a-cohama.adb, a-cborse.adb,
a-ciorma.adb, a-cobove.adb: Minor reformatting.
2011-12-01 Jakub Jelinek <jakub@redhat.com> 2011-12-01 Jakub Jelinek <jakub@redhat.com>
PR bootstrap/51201 PR bootstrap/51201
......
gcc/ada/a-cbdlli.adb
...@@ -28,6 +28,7 @@ ...@@ -28,6 +28,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Finalization; use Ada.Finalization; with Ada.Finalization; use Ada.Finalization;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Bounded_Doubly_Linked_Lists is package body Ada.Containers.Bounded_Doubly_Linked_Lists is
...@@ -129,24 +130,23 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -129,24 +130,23 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
if Container.Free >= 0 then if Container.Free >= 0 then
New_Node := Container.Free; New_Node := Container.Free;
-- We always perform the assignment first, before we -- We always perform the assignment first, before we change container
-- change container state, in order to defend against -- state, in order to defend against exceptions duration assignment.
-- exceptions duration assignment.
N (New_Node).Element := New_Item; N (New_Node).Element := New_Item;
Container.Free := N (New_Node).Next; Container.Free := N (New_Node).Next;
else else
-- A negative free store value means that the links of the nodes -- A negative free store value means that the links of the nodes in
-- in the free store have not been initialized. In this case, the -- the free store have not been initialized. In this case, the nodes
-- nodes are physically contiguous in the array, starting at the -- are physically contiguous in the array, starting at the index that
-- index that is the absolute value of the Container.Free, and -- is the absolute value of the Container.Free, and continuing until
-- continuing until the end of the array (Nodes'Last). -- the end of the array (Nodes'Last).
New_Node := abs Container.Free; New_Node := abs Container.Free;
-- As above, we perform this assignment first, before modifying -- As above, we perform this assignment first, before modifying any
-- any container state. -- container state.
N (New_Node).Element := New_Item; N (New_Node).Element := New_Item;
Container.Free := Container.Free - 1; Container.Free := Container.Free - 1;
...@@ -164,24 +164,23 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -164,24 +164,23 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
if Container.Free >= 0 then if Container.Free >= 0 then
New_Node := Container.Free; New_Node := Container.Free;
-- We always perform the assignment first, before we -- We always perform the assignment first, before we change container
-- change container state, in order to defend against -- state, in order to defend against exceptions duration assignment.
-- exceptions duration assignment.
Element_Type'Read (Stream, N (New_Node).Element); Element_Type'Read (Stream, N (New_Node).Element);
Container.Free := N (New_Node).Next; Container.Free := N (New_Node).Next;
else else
-- A negative free store value means that the links of the nodes -- A negative free store value means that the links of the nodes in
-- in the free store have not been initialized. In this case, the -- the free store have not been initialized. In this case, the nodes
-- nodes are physically contiguous in the array, starting at the -- are physically contiguous in the array, starting at the index that
-- index that is the absolute value of the Container.Free, and -- is the absolute value of the Container.Free, and continuing until
-- continuing until the end of the array (Nodes'Last). -- the end of the array (Nodes'Last).
New_Node := abs Container.Free; New_Node := abs Container.Free;
-- As above, we perform this assignment first, before modifying -- As above, we perform this assignment first, before modifying any
-- any container state. -- container state.
Element_Type'Read (Stream, N (New_Node).Element); Element_Type'Read (Stream, N (New_Node).Element);
Container.Free := Container.Free - 1; Container.Free := Container.Free - 1;
...@@ -674,7 +673,10 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -674,7 +673,10 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
-- inactive immediately precedes the start of the free store. All -- inactive immediately precedes the start of the free store. All
-- we need to do is move the start of the free store back by one. -- we need to do is move the start of the free store back by one.
N (X).Next := 0; -- not strictly necessary, but marginally safer -- Note: initializing Next to zero is not strictly necessary but
-- seems cleaner and marginally safer.
N (X).Next := 0;
Container.Free := Container.Free + 1; Container.Free := Container.Free + 1;
else else
...@@ -794,7 +796,6 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -794,7 +796,6 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
if RN (RI.Node).Element < LN (LI.Node).Element then if RN (RI.Node).Element < LN (LI.Node).Element then
declare declare
RJ : Cursor := RI; RJ : Cursor := RI;
pragma Warnings (Off, RJ);
begin begin
RI.Node := RN (RI.Node).Next; RI.Node := RN (RI.Node).Next;
Splice (Target, LI, Source, RJ); Splice (Target, LI, Source, RJ);
...@@ -1035,7 +1036,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -1035,7 +1036,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
Container.Last := New_Node; Container.Last := New_Node;
N (Container.Last).Next := 0; N (Container.Last).Next := 0;
elsif Before = 0 then -- means append -- Before = zero means append
elsif Before = 0 then
pragma Assert (N (Container.Last).Next = 0); pragma Assert (N (Container.Last).Next = 0);
N (Container.Last).Next := New_Node; N (Container.Last).Next := New_Node;
...@@ -1044,7 +1047,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -1044,7 +1047,9 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
Container.Last := New_Node; Container.Last := New_Node;
N (Container.Last).Next := 0; N (Container.Last).Next := 0;
elsif Before = Container.First then -- means prepend -- Before = Container.First means prepend
elsif Before = Container.First then
pragma Assert (N (Container.First).Prev = 0); pragma Assert (N (Container.First).Prev = 0);
N (Container.First).Prev := New_Node; N (Container.First).Prev := New_Node;
...@@ -2129,20 +2134,17 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -2129,20 +2134,17 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
declare declare
L : List renames Position.Container.all; L : List renames Position.Container.all;
N : Node_Array renames L.Nodes; N : Node_Array renames L.Nodes;
begin begin
if L.Length = 0 then if L.Length = 0 then
return False; return False;
end if; end if;
if L.First = 0 if L.First = 0 or L.First > L.Capacity then
or L.First > L.Capacity
then
return False; return False;
end if; end if;
if L.Last = 0 if L.Last = 0 or L.Last > L.Capacity then
or L.Last > L.Capacity
then
return False; return False;
end if; end if;
...@@ -2182,6 +2184,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -2182,6 +2184,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
-- If we get here, we know that this disjunction is true: -- If we get here, we know that this disjunction is true:
-- N (Position.Node).Prev /= 0 or else Position.Node = L.First -- N (Position.Node).Prev /= 0 or else Position.Node = L.First
-- Why not do this with an assertion???
if N (Position.Node).Next = 0 if N (Position.Node).Next = 0
and then Position.Node /= L.Last and then Position.Node /= L.Last
...@@ -2191,6 +2194,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -2191,6 +2194,7 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
-- If we get here, we know that this disjunction is true: -- If we get here, we know that this disjunction is true:
-- N (Position.Node).Next /= 0 or else Position.Node = L.Last -- N (Position.Node).Next /= 0 or else Position.Node = L.Last
-- Why not do this with an assertion???
if L.Length = 1 then if L.Length = 1 then
return L.First = L.Last; return L.First = L.Last;
...@@ -2242,15 +2246,15 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is ...@@ -2242,15 +2246,15 @@ package body Ada.Containers.Bounded_Doubly_Linked_Lists is
return True; return True;
end if; end if;
-- If we get here, we know (disjunctive syllogism) that this -- If we get to this point, we know that this predicate is true:
-- predicate is true: N (Position.Node).Prev /= 0 -- N (Position.Node).Prev /= 0
if Position.Node = L.Last then -- eliminates earlier disjunct if Position.Node = L.Last then -- eliminates earlier disjunct
return True; return True;
end if; end if;
-- If we get here, we know (disjunctive syllogism) that this -- If we get to this point, we know that this predicate is true:
-- predicate is true: N (Position.Node).Next /= 0 -- N (Position.Node).Next /= 0
if N (N (Position.Node).Next).Prev /= Position.Node then if N (N (Position.Node).Next).Prev /= Position.Node then
return False; return False;
......
gcc/ada/a-cbhama.adb
...@@ -35,6 +35,7 @@ pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Bounded_Keys); ...@@ -35,6 +35,7 @@ pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Bounded_Keys);
with Ada.Containers.Prime_Numbers; use Ada.Containers.Prime_Numbers; with Ada.Containers.Prime_Numbers; use Ada.Containers.Prime_Numbers;
with Ada.Finalization; use Ada.Finalization; with Ada.Finalization; use Ada.Finalization;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Bounded_Hashed_Maps is package body Ada.Containers.Bounded_Hashed_Maps is
...@@ -405,7 +406,6 @@ package body Ada.Containers.Bounded_Hashed_Maps is ...@@ -405,7 +406,6 @@ package body Ada.Containers.Bounded_Hashed_Maps is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.Busy; B : Natural renames Object.Container.all.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
...@@ -418,13 +418,12 @@ package body Ada.Containers.Bounded_Hashed_Maps is ...@@ -418,13 +418,12 @@ package body Ada.Containers.Bounded_Hashed_Maps is
function Find (Container : Map; Key : Key_Type) return Cursor is function Find (Container : Map; Key : Key_Type) return Cursor is
Node : constant Count_Type := Key_Ops.Find (Container, Key); Node : constant Count_Type := Key_Ops.Find (Container, Key);
begin begin
if Node = 0 then if Node = 0 then
return No_Element; return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Node);
end if; end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Find; end Find;
----------- -----------
...@@ -433,13 +432,12 @@ package body Ada.Containers.Bounded_Hashed_Maps is ...@@ -433,13 +432,12 @@ package body Ada.Containers.Bounded_Hashed_Maps is
function First (Container : Map) return Cursor is function First (Container : Map) 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 if Node = 0 then
return No_Element; return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Node);
end if; 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
...@@ -489,7 +487,6 @@ package body Ada.Containers.Bounded_Hashed_Maps is ...@@ -489,7 +487,6 @@ package body Ada.Containers.Bounded_Hashed_Maps is
declare declare
N : Node_Type renames Container.Nodes (Position.Node); N : Node_Type renames Container.Nodes (Position.Node);
begin begin
N.Key := Key; N.Key := Key;
N.Element := New_Item; N.Element := New_Item;
...@@ -532,6 +529,7 @@ package body Ada.Containers.Bounded_Hashed_Maps is ...@@ -532,6 +529,7 @@ package body Ada.Containers.Bounded_Hashed_Maps is
-- parameter. -- parameter.
-- Node.Element := New_Item; -- Node.Element := New_Item;
-- What is this deleted code about???
end Assign_Key; end Assign_Key;
-------------- --------------
...@@ -768,13 +766,12 @@ package body Ada.Containers.Bounded_Hashed_Maps is ...@@ -768,13 +766,12 @@ package body Ada.Containers.Bounded_Hashed_Maps is
declare declare
M : Map renames Position.Container.all; M : Map renames Position.Container.all;
Node : constant Count_Type := HT_Ops.Next (M, Position.Node); Node : constant Count_Type := HT_Ops.Next (M, Position.Node);
begin begin
if Node = 0 then if Node = 0 then
return No_Element; return No_Element;
else
return Cursor'(Position.Container, Node);
end if; end if;
return Cursor'(Position.Container, Node);
end; end;
end Next; end Next;
......
gcc/ada/a-cbhase.adb
...@@ -583,7 +583,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -583,7 +583,6 @@ package body Ada.Containers.Bounded_Hashed_Sets is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.Busy; B : Natural renames Object.Container.all.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
...@@ -930,10 +929,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is ...@@ -930,10 +929,8 @@ package body Ada.Containers.Bounded_Hashed_Sets is
return Set_Iterator_Interfaces.Forward_Iterator'Class return Set_Iterator_Interfaces.Forward_Iterator'Class
is is
B : Natural renames Container'Unrestricted_Access.all.Busy; B : Natural renames Container'Unrestricted_Access.all.Busy;
begin begin
B := B + 1; B := B + 1;
return It : constant Iterator := return It : constant Iterator :=
Iterator'(Limited_Controlled with Iterator'(Limited_Controlled with
Container => Container'Unrestricted_Access); Container => Container'Unrestricted_Access);
......
gcc/ada/a-cbmutr.adb
...@@ -28,6 +28,7 @@ ...@@ -28,6 +28,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Finalization; use Ada.Finalization; with Ada.Finalization; use Ada.Finalization;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Bounded_Multiway_Trees is package body Ada.Containers.Bounded_Multiway_Trees is
...@@ -1246,7 +1247,6 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -1246,7 +1247,6 @@ package body Ada.Containers.Bounded_Multiway_Trees is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.Busy; B : Natural renames Object.Container.all.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
...@@ -1258,7 +1258,6 @@ package body Ada.Containers.Bounded_Multiway_Trees is ...@@ -1258,7 +1258,6 @@ package body Ada.Containers.Bounded_Multiway_Trees is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.Busy; B : Natural renames Object.Container.all.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
......
gcc/ada/a-cborma.adb
...@@ -36,6 +36,7 @@ pragma Elaborate_All ...@@ -36,6 +36,7 @@ pragma Elaborate_All
(Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys); (Ada.Containers.Red_Black_Trees.Generic_Bounded_Keys);
with Ada.Finalization; use Ada.Finalization; with Ada.Finalization; use Ada.Finalization;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Bounded_Ordered_Maps is package body Ada.Containers.Bounded_Ordered_Maps is
...@@ -563,7 +564,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is ...@@ -563,7 +564,6 @@ package body Ada.Containers.Bounded_Ordered_Maps is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.Busy; B : Natural renames Object.Container.all.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
......
gcc/ada/a-cborse.adb
...@@ -39,6 +39,7 @@ pragma Elaborate_All ...@@ -39,6 +39,7 @@ pragma Elaborate_All
(Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations); (Ada.Containers.Red_Black_Trees.Generic_Bounded_Set_Operations);
with Ada.Finalization; use Ada.Finalization; with Ada.Finalization; use Ada.Finalization;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Bounded_Ordered_Sets is package body Ada.Containers.Bounded_Ordered_Sets is
...@@ -580,7 +581,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is ...@@ -580,7 +581,6 @@ package body Ada.Containers.Bounded_Ordered_Sets is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.Busy; B : Natural renames Object.Container.all.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
......
gcc/ada/a-cdlili.adb
...@@ -28,6 +28,7 @@ ...@@ -28,6 +28,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation; with Ada.Unchecked_Deallocation;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Doubly_Linked_Lists is package body Ada.Containers.Doubly_Linked_Lists is
...@@ -407,7 +408,6 @@ package body Ada.Containers.Doubly_Linked_Lists is ...@@ -407,7 +408,6 @@ package body Ada.Containers.Doubly_Linked_Lists is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.Busy; B : Natural renames Object.Container.all.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
...@@ -504,7 +504,6 @@ package body Ada.Containers.Doubly_Linked_Lists is ...@@ -504,7 +504,6 @@ package body Ada.Containers.Doubly_Linked_Lists is
procedure Free (X : in out Node_Access) is procedure Free (X : in out Node_Access) is
procedure Deallocate is procedure Deallocate is
new Ada.Unchecked_Deallocation (Node_Type, Node_Access); new Ada.Unchecked_Deallocation (Node_Type, Node_Access);
begin begin
X.Prev := X; X.Prev := X;
X.Next := X; X.Next := X;
......
gcc/ada/a-cidlli.adb
...@@ -28,6 +28,7 @@ ...@@ -28,6 +28,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation; with Ada.Unchecked_Deallocation;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Indefinite_Doubly_Linked_Lists is package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
...@@ -440,7 +441,6 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is ...@@ -440,7 +441,6 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.Busy; B : Natural renames Object.Container.all.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
......
gcc/ada/a-cihama.adb
...@@ -34,6 +34,7 @@ with Ada.Containers.Hash_Tables.Generic_Keys; ...@@ -34,6 +34,7 @@ with Ada.Containers.Hash_Tables.Generic_Keys;
pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Keys); pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Keys);
with Ada.Unchecked_Deallocation; with Ada.Unchecked_Deallocation;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Indefinite_Hashed_Maps is package body Ada.Containers.Indefinite_Hashed_Maps is
...@@ -428,7 +429,6 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -428,7 +429,6 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.HT.Busy; B : Natural renames Object.Container.all.HT.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
...@@ -479,13 +479,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -479,13 +479,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
function First (Container : Map) return Cursor is function First (Container : Map) 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 if Node = null then
return No_Element; return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Node);
end if; 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
...@@ -726,7 +725,6 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -726,7 +725,6 @@ package body Ada.Containers.Indefinite_Hashed_Maps is
(Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'Class (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'Class
is is
B : Natural renames Container'Unrestricted_Access.all.HT.Busy; B : Natural renames Container'Unrestricted_Access.all.HT.Busy;
begin begin
return It : constant Iterator := return It : constant Iterator :=
(Limited_Controlled with (Limited_Controlled with
...@@ -809,13 +807,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps is ...@@ -809,13 +807,12 @@ package body Ada.Containers.Indefinite_Hashed_Maps 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 if Node = null then
return No_Element; return No_Element;
else
return Cursor'(Position.Container, Node);
end if; end if;
return Cursor'(Position.Container, Node);
end; end;
end Next; end Next;
......
gcc/ada/a-cihase.adb
...@@ -36,6 +36,7 @@ with Ada.Containers.Hash_Tables.Generic_Keys; ...@@ -36,6 +36,7 @@ with Ada.Containers.Hash_Tables.Generic_Keys;
pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Keys); pragma Elaborate_All (Ada.Containers.Hash_Tables.Generic_Keys);
with Ada.Containers.Prime_Numbers; with Ada.Containers.Prime_Numbers;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Indefinite_Hashed_Sets is package body Ada.Containers.Indefinite_Hashed_Sets is
...@@ -576,7 +577,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -576,7 +577,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.HT.Busy; B : Natural renames Object.Container.all.HT.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
...@@ -1024,7 +1024,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is ...@@ -1024,7 +1024,6 @@ package body Ada.Containers.Indefinite_Hashed_Sets is
return Set_Iterator_Interfaces.Forward_Iterator'Class return Set_Iterator_Interfaces.Forward_Iterator'Class
is is
B : Natural renames Container'Unrestricted_Access.all.HT.Busy; B : Natural renames Container'Unrestricted_Access.all.HT.Busy;
begin begin
return It : constant Iterator := return It : constant Iterator :=
Iterator'(Limited_Controlled with Iterator'(Limited_Controlled with
......
gcc/ada/a-cimutr.adb
...@@ -28,6 +28,7 @@ ...@@ -28,6 +28,7 @@
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
with Ada.Unchecked_Deallocation; with Ada.Unchecked_Deallocation;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Indefinite_Multiway_Trees is package body Ada.Containers.Indefinite_Multiway_Trees is
...@@ -940,7 +941,6 @@ package body Ada.Containers.Indefinite_Multiway_Trees is ...@@ -940,7 +941,6 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.Busy; B : Natural renames Object.Container.all.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
...@@ -952,7 +952,6 @@ package body Ada.Containers.Indefinite_Multiway_Trees is ...@@ -952,7 +952,6 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.Busy; B : Natural renames Object.Container.all.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
...@@ -1362,7 +1361,6 @@ package body Ada.Containers.Indefinite_Multiway_Trees is ...@@ -1362,7 +1361,6 @@ package body Ada.Containers.Indefinite_Multiway_Trees is
B : Natural renames Container'Unrestricted_Access.all.Busy; B : Natural renames Container'Unrestricted_Access.all.Busy;
RC : constant Cursor := RC : constant Cursor :=
(Container'Unrestricted_Access, Root_Node (Container)); (Container'Unrestricted_Access, Root_Node (Container));
begin begin
return It : constant Iterator := return It : constant Iterator :=
Iterator'(Limited_Controlled with Iterator'(Limited_Controlled with
......
gcc/ada/a-ciorma.adb
...@@ -546,7 +546,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is ...@@ -546,7 +546,6 @@ package body Ada.Containers.Indefinite_Ordered_Maps is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.Tree.Busy; B : Natural renames Object.Container.all.Tree.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
......
gcc/ada/a-ciormu.adb
...@@ -42,6 +42,26 @@ with System; use type System.Address; ...@@ -42,6 +42,26 @@ with System; use type System.Address;
package body Ada.Containers.Indefinite_Ordered_Multisets is package body Ada.Containers.Indefinite_Ordered_Multisets is
type Iterator is new Limited_Controlled and
Set_Iterator_Interfaces.Reversible_Iterator with
record
Container : Set_Access;
Node : Node_Access;
end record;
overriding procedure Finalize (Object : in out Iterator);
overriding function First (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
overriding function Next
(Object : Iterator;
Position : Cursor) return Cursor;
overriding function Previous
(Object : Iterator;
Position : Cursor) return Cursor;
----------------------------- -----------------------------
-- Node Access Subprograms -- -- Node Access Subprograms --
----------------------------- -----------------------------
...@@ -592,6 +612,17 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -592,6 +612,17 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
return Cursor'(Container'Unrestricted_Access, Node); return Cursor'(Container'Unrestricted_Access, Node);
end Find; end Find;
--------------
-- Finalize --
--------------
procedure Finalize (Object : in out Iterator) is
B : Natural renames Object.Container.Tree.Busy;
pragma Assert (B > 0);
begin
B := B - 1;
end Finalize;
----------- -----------
-- First -- -- First --
----------- -----------
...@@ -605,6 +636,28 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -605,6 +636,28 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
return Cursor'(Container'Unrestricted_Access, Container.Tree.First); return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
end First; end First;
function First (Object : Iterator) return Cursor is
begin
-- The value of the iterator object's Node component influences the
-- behavior of the First (and Last) selector function.
-- When the Node component is null, this means the iterator object was
-- constructed without a start expression, in which case the (forward)
-- iteration starts from the (logical) beginning of the entire sequence
-- of items (corresponding to Container.First, for a forward iterator).
-- Otherwise, this is iteration over a partial sequence of items. When
-- the Node component is non-null, the iterator object was constructed
-- with a start expression, that specifies the position from which the
-- (forward) partial iteration begins.
if Object.Node = null then
return Object.Container.First;
else
return Cursor'(Object.Container, Object.Node);
end if;
end First;
------------------- -------------------
-- First_Element -- -- First_Element --
------------------- -------------------
...@@ -1347,6 +1400,75 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -1347,6 +1400,75 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
B := B - 1; B := B - 1;
end Iterate; end Iterate;
function Iterate (Container : Set)
return Set_Iterator_Interfaces.Reversible_Iterator'Class
is
S : constant Set_Access := Container'Unrestricted_Access;
B : Natural renames S.Tree.Busy;
begin
-- The value of the Node component influences the behavior of the First
-- and Last selector functions of the iterator object. When the Node
-- component is null (as is the case here), this means the iterator
-- object was constructed without a start expression. This is a complete
-- iterator, meaning that the iteration starts from the (logical)
-- beginning of the sequence of items.
-- Note: For a forward iterator, Container.First is the beginning, and
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator := (Limited_Controlled with S, null) do
B := B + 1;
end return;
end Iterate;
function Iterate (Container : Set; Start : Cursor)
return Set_Iterator_Interfaces.Reversible_Iterator'Class
is
S : constant Set_Access := Container'Unrestricted_Access;
B : Natural renames S.Tree.Busy;
begin
-- It was formerly the case that when Start = No_Element, the partial
-- iterator was defined to behave the same as for a complete iterator,
-- and iterate over the entire sequence of items. However, those
-- semantics were unintuitive and arguably error-prone (it is too easy
-- to accidentally create an endless loop), and so they were changed,
-- per the ARG meeting in Denver on 2011/11. However, there was no
-- consensus about what positive meaning this corner case should have,
-- and so it was decided to simply raise an exception. This does imply,
-- however, that it is not possible to use a partial iterator to specify
-- an empty sequence of items.
if Start = No_Element then
raise Constraint_Error with
"Start position for iterator equals No_Element";
end if;
if Start.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Start cursor of Iterate designates wrong set";
end if;
pragma Assert (Vet (Container.Tree, Start.Node),
"Start cursor of Iterate is bad");
-- The value of the Node component influences the behavior of the First
-- and Last selector functions of the iterator object. When the Node
-- component is non-null (as is the case here), it means that this is a
-- partial iteration, over a subset of the complete sequence of
-- items. The iterator object was constructed with a start expression,
-- indicating the position from which the iteration begins. Note that
-- the start position has the same value irrespective of whether this is
-- a forward or reverse iteration.
return It : constant Iterator :=
(Limited_Controlled with S, Start.Node)
do
B := B + 1;
end return;
end Iterate;
---------- ----------
-- Last -- -- Last --
---------- ----------
...@@ -1360,6 +1482,28 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -1360,6 +1482,28 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
return Cursor'(Container'Unrestricted_Access, Container.Tree.Last); return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
end Last; end Last;
function Last (Object : Iterator) return Cursor is
begin
-- The value of the iterator object's Node component influences the
-- behavior of the Last (and First) selector function.
-- When the Node component is null, this means the iterator object was
-- constructed without a start expression, in which case the (reverse)
-- iteration starts from the (logical) beginning of the entire sequence
-- (corresponding to Container.Last, for a reverse iterator).
-- Otherwise, this is iteration over a partial sequence of items. When
-- the Node component is non-null, the iterator object was constructed
-- with a start expression, that specifies the position from which the
-- (reverse) partial iteration begins.
if Object.Node = null then
return Object.Container.Last;
else
return Cursor'(Object.Container, Object.Node);
end if;
end Last;
------------------ ------------------
-- Last_Element -- -- Last_Element --
------------------ ------------------
...@@ -1435,6 +1579,20 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -1435,6 +1579,20 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
Position := Next (Position); Position := Next (Position);
end Next; end Next;
function Next (Object : Iterator; Position : Cursor) return Cursor is
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong set";
end if;
return Next (Position);
end Next;
------------- -------------
-- Overlap -- -- Overlap --
------------- -------------
...@@ -1484,6 +1642,20 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -1484,6 +1642,20 @@ package body Ada.Containers.Indefinite_Ordered_Multisets is
Position := Previous (Position); Position := Previous (Position);
end Previous; end Previous;
function Previous (Object : Iterator; Position : Cursor) return Cursor is
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Previous designates wrong set";
end if;
return Previous (Position);
end Previous;
------------------- -------------------
-- Query_Element -- -- Query_Element --
------------------- -------------------
......
gcc/ada/a-ciormu.ads
...@@ -35,6 +35,7 @@ ...@@ -35,6 +35,7 @@
private with Ada.Containers.Red_Black_Trees; private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization; private with Ada.Finalization;
private with Ada.Streams; private with Ada.Streams;
with Ada.Iterator_Interfaces;
generic generic
type Element_Type (<>) is private; type Element_Type (<>) is private;
...@@ -50,7 +51,10 @@ package Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -50,7 +51,10 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
-- Returns False if Left is less than Right, or Right is less than Left; -- Returns False if Left is less than Right, or Right is less than Left;
-- otherwise, it returns True. -- otherwise, it returns True.
type Set is tagged private; type Set is tagged private
with Default_Iterator => Iterate,
Iterator_Element => Element_Type;
pragma Preelaborable_Initialization (Set); pragma Preelaborable_Initialization (Set);
type Cursor is private; type Cursor is private;
...@@ -64,6 +68,12 @@ package Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -64,6 +68,12 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
-- The default value for cursor objects declared without an explicit -- The default value for cursor objects declared without an explicit
-- initialization expression. -- initialization expression.
function Has_Element (Position : Cursor) return Boolean;
-- Equivalent to Position /= No_Element
package Set_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
function "=" (Left, Right : Set) return Boolean; function "=" (Left, Right : Set) return Boolean;
-- If Left denotes the same set object as Right, then equality returns -- If Left denotes the same set object as Right, then equality returns
-- True. If the length of Left is different from the length of Right, then -- True. If the length of Left is different from the length of Right, then
...@@ -286,9 +296,6 @@ package Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -286,9 +296,6 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
function Contains (Container : Set; Item : Element_Type) return Boolean; function Contains (Container : Set; Item : Element_Type) return Boolean;
-- Equivalent to Container.Find (Item) /= No_Element -- Equivalent to Container.Find (Item) /= No_Element
function Has_Element (Position : Cursor) return Boolean;
-- Equivalent to Position /= No_Element
function "<" (Left, Right : Cursor) return Boolean; function "<" (Left, Right : Cursor) return Boolean;
-- Equivalent to Element (Left) < Element (Right) -- Equivalent to Element (Left) < Element (Right)
...@@ -333,6 +340,15 @@ package Ada.Containers.Indefinite_Ordered_Multisets is ...@@ -333,6 +340,15 @@ package Ada.Containers.Indefinite_Ordered_Multisets is
-- Call Process with a cursor designating each element equivalent to Item, -- Call Process with a cursor designating each element equivalent to Item,
-- in order from Container.Ceiling (Item) to Container.Floor (Item). -- in order from Container.Ceiling (Item) to Container.Floor (Item).
function Iterate
(Container : Set)
return Set_Iterator_Interfaces.Reversible_Iterator'class;
function Iterate
(Container : Set;
Start : Cursor)
return Set_Iterator_Interfaces.Reversible_Iterator'class;
generic generic
type Key_Type (<>) is private; type Key_Type (<>) is private;
......
gcc/ada/a-ciorse.adb
...@@ -37,6 +37,7 @@ with Ada.Containers.Red_Black_Trees.Generic_Set_Operations; ...@@ -37,6 +37,7 @@ with Ada.Containers.Red_Black_Trees.Generic_Set_Operations;
pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations); pragma Elaborate_All (Ada.Containers.Red_Black_Trees.Generic_Set_Operations);
with Ada.Unchecked_Deallocation; with Ada.Unchecked_Deallocation;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Indefinite_Ordered_Sets is package body Ada.Containers.Indefinite_Ordered_Sets is
...@@ -581,7 +582,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -581,7 +582,6 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.Tree.Busy; B : Natural renames Object.Container.all.Tree.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
...@@ -595,13 +595,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -595,13 +595,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
function Find (Container : Set; Item : Element_Type) return Cursor is function Find (Container : Set; Item : Element_Type) return Cursor is
Node : constant Node_Access := Node : constant Node_Access :=
Element_Keys.Find (Container.Tree, Item); Element_Keys.Find (Container.Tree, Item);
begin begin
if Node = null then if Node = null then
return No_Element; return No_Element;
else
return Cursor'(Container'Unrestricted_Access, Node);
end if; end if;
return Cursor'(Container'Unrestricted_Access, Node);
end Find; end Find;
----------- -----------
...@@ -766,13 +765,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is ...@@ -766,13 +765,12 @@ package body Ada.Containers.Indefinite_Ordered_Sets is
function Element (Container : Set; Key : Key_Type) return Element_Type is function Element (Container : Set; Key : Key_Type) return Element_Type is
Node : constant Node_Access := Node : constant Node_Access :=
Key_Keys.Find (Container.Tree, Key); Key_Keys.Find (Container.Tree, Key);
begin begin
if Node = null then if Node = null then
raise Constraint_Error with "key not in set"; raise Constraint_Error with "key not in set";
else
return Node.Element.all;
end if; end if;
return Node.Element.all;
end Element; end Element;
--------------------- ---------------------
......
gcc/ada/a-cobove.adb
...@@ -29,6 +29,7 @@ ...@@ -29,6 +29,7 @@
with Ada.Containers.Generic_Array_Sort; with Ada.Containers.Generic_Array_Sort;
with Ada.Finalization; use Ada.Finalization; with Ada.Finalization; use Ada.Finalization;
with System; use type System.Address; with System; use type System.Address;
package body Ada.Containers.Bounded_Vectors is package body Ada.Containers.Bounded_Vectors is
...@@ -670,7 +671,6 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -670,7 +671,6 @@ package body Ada.Containers.Bounded_Vectors is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.Busy; B : Natural renames Object.Container.all.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
...@@ -1649,7 +1649,6 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -1649,7 +1649,6 @@ package body Ada.Containers.Bounded_Vectors is
return Vector_Iterator_Interfaces.Reversible_Iterator'Class return Vector_Iterator_Interfaces.Reversible_Iterator'Class
is is
B : Natural renames Container'Unrestricted_Access.all.Busy; B : Natural renames Container'Unrestricted_Access.all.Busy;
begin begin
return It : constant Iterator := return It : constant Iterator :=
Iterator'(Limited_Controlled with Iterator'(Limited_Controlled with
...@@ -1666,7 +1665,6 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -1666,7 +1665,6 @@ package body Ada.Containers.Bounded_Vectors is
return Vector_Iterator_Interfaces.Reversible_Iterator'class return Vector_Iterator_Interfaces.Reversible_Iterator'class
is is
B : Natural renames Container'Unrestricted_Access.all.Busy; B : Natural renames Container'Unrestricted_Access.all.Busy;
begin begin
return It : constant Iterator := return It : constant Iterator :=
Iterator'(Limited_Controlled with Iterator'(Limited_Controlled with
...@@ -1783,7 +1781,8 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -1783,7 +1781,8 @@ package body Ada.Containers.Bounded_Vectors is
"attempt to tamper with cursors (Source is busy)"; "attempt to tamper with cursors (Source is busy)";
end if; end if;
-- Clear Target now, in case element assignment fails. -- Clear Target now, in case element assignment fails
Target.Last := No_Index; Target.Last := No_Index;
Target.Elements (1 .. Source.Length) := Target.Elements (1 .. Source.Length) :=
...@@ -1992,8 +1991,10 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -1992,8 +1991,10 @@ package body Ada.Containers.Bounded_Vectors is
--------------- ---------------
function Constant_Reference function Constant_Reference
(Container : Vector; Position : Cursor) -- SHOULD BE ALIASED (Container : Vector;
return Constant_Reference_Type is Position : Cursor) -- SHOULD BE ALIASED
return Constant_Reference_Type
is
begin begin
pragma Unreferenced (Container); pragma Unreferenced (Container);
...@@ -2012,8 +2013,10 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -2012,8 +2013,10 @@ package body Ada.Containers.Bounded_Vectors is
end Constant_Reference; end Constant_Reference;
function Constant_Reference function Constant_Reference
(Container : Vector; Position : Index_Type) (Container : Vector;
return Constant_Reference_Type is Position : Index_Type)
return Constant_Reference_Type
is
begin begin
if (Position) > Container.Last then if (Position) > Container.Last then
raise Constraint_Error with "Index is out of range"; raise Constraint_Error with "Index is out of range";
...@@ -2023,8 +2026,11 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -2023,8 +2026,11 @@ package body Ada.Containers.Bounded_Vectors is
Container.Elements (To_Array_Index (Position))'Access); Container.Elements (To_Array_Index (Position))'Access);
end Constant_Reference; end Constant_Reference;
function Reference (Container : Vector; Position : Cursor) function Reference
return Reference_Type is (Container : Vector;
Position : Cursor)
return Reference_Type
is
begin begin
pragma Unreferenced (Container); pragma Unreferenced (Container);
...@@ -2042,8 +2048,11 @@ package body Ada.Containers.Bounded_Vectors is ...@@ -2042,8 +2048,11 @@ package body Ada.Containers.Bounded_Vectors is
(To_Array_Index (Position.Index))'Access); (To_Array_Index (Position.Index))'Access);
end Reference; end Reference;
function Reference (Container : Vector; Position : Index_Type) function Reference
return Reference_Type is (Container : Vector;
Position : Index_Type)
return Reference_Type
is
begin begin
if Position > Container.Last then if Position > Container.Last then
raise Constraint_Error with "Index is out of range"; raise Constraint_Error with "Index is out of range";
......
gcc/ada/a-cohama.adb
...@@ -393,7 +393,6 @@ package body Ada.Containers.Hashed_Maps is ...@@ -393,7 +393,6 @@ package body Ada.Containers.Hashed_Maps is
if Object.Container /= null then if Object.Container /= null then
declare declare
B : Natural renames Object.Container.all.HT.Busy; B : Natural renames Object.Container.all.HT.Busy;
begin begin
B := B - 1; B := B - 1;
end; end;
...@@ -678,7 +677,6 @@ package body Ada.Containers.Hashed_Maps is ...@@ -678,7 +677,6 @@ package body Ada.Containers.Hashed_Maps is
(Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'Class (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'Class
is is
B : Natural renames Container'Unrestricted_Access.all.HT.Busy; B : Natural renames Container'Unrestricted_Access.all.HT.Busy;
begin begin
return It : constant Iterator := return It : constant Iterator :=
(Limited_Controlled with (Limited_Controlled with
......
gcc/ada/a-coormu.adb
...@@ -42,6 +42,26 @@ with System; use type System.Address; ...@@ -42,6 +42,26 @@ with System; use type System.Address;
package body Ada.Containers.Ordered_Multisets is package body Ada.Containers.Ordered_Multisets is
type Iterator is new Limited_Controlled and
Set_Iterator_Interfaces.Reversible_Iterator with
record
Container : Set_Access;
Node : Node_Access;
end record;
overriding procedure Finalize (Object : in out Iterator);
overriding function First (Object : Iterator) return Cursor;
overriding function Last (Object : Iterator) return Cursor;
overriding function Next
(Object : Iterator;
Position : Cursor) return Cursor;
overriding function Previous
(Object : Iterator;
Position : Cursor) return Cursor;
----------------------------- -----------------------------
-- Node Access Subprograms -- -- Node Access Subprograms --
----------------------------- -----------------------------
...@@ -531,6 +551,17 @@ package body Ada.Containers.Ordered_Multisets is ...@@ -531,6 +551,17 @@ package body Ada.Containers.Ordered_Multisets is
end loop; end loop;
end Exclude; end Exclude;
--------------
-- Finalize --
--------------
procedure Finalize (Object : in out Iterator) is
B : Natural renames Object.Container.Tree.Busy;
pragma Assert (B > 0);
begin
B := B - 1;
end Finalize;
---------- ----------
-- Find -- -- Find --
---------- ----------
...@@ -560,6 +591,28 @@ package body Ada.Containers.Ordered_Multisets is ...@@ -560,6 +591,28 @@ package body Ada.Containers.Ordered_Multisets is
return Cursor'(Container'Unrestricted_Access, Container.Tree.First); return Cursor'(Container'Unrestricted_Access, Container.Tree.First);
end First; end First;
function First (Object : Iterator) return Cursor is
begin
-- The value of the iterator object's Node component influences the
-- behavior of the First (and Last) selector function.
-- When the Node component is null, this means the iterator object was
-- constructed without a start expression, in which case the (forward)
-- iteration starts from the (logical) beginning of the entire sequence
-- of items (corresponding to Container.First, for a forward iterator).
-- Otherwise, this is iteration over a partial sequence of items. When
-- the Node component is non-null, the iterator object was constructed
-- with a start expression, that specifies the position from which the
-- (forward) partial iteration begins.
if Object.Node = null then
return Object.Container.First;
else
return Cursor'(Object.Container, Object.Node);
end if;
end First;
------------------- -------------------
-- First_Element -- -- First_Element --
------------------- -------------------
...@@ -1269,6 +1322,75 @@ package body Ada.Containers.Ordered_Multisets is ...@@ -1269,6 +1322,75 @@ package body Ada.Containers.Ordered_Multisets is
B := B - 1; B := B - 1;
end Iterate; end Iterate;
function Iterate (Container : Set)
return Set_Iterator_Interfaces.Reversible_Iterator'Class
is
S : constant Set_Access := Container'Unrestricted_Access;
B : Natural renames S.Tree.Busy;
begin
-- The value of the Node component influences the behavior of the First
-- and Last selector functions of the iterator object. When the Node
-- component is null (as is the case here), this means the iterator
-- object was constructed without a start expression. This is a complete
-- iterator, meaning that the iteration starts from the (logical)
-- beginning of the sequence of items.
-- Note: For a forward iterator, Container.First is the beginning, and
-- for a reverse iterator, Container.Last is the beginning.
return It : constant Iterator := (Limited_Controlled with S, null) do
B := B + 1;
end return;
end Iterate;
function Iterate (Container : Set; Start : Cursor)
return Set_Iterator_Interfaces.Reversible_Iterator'Class
is
S : constant Set_Access := Container'Unrestricted_Access;
B : Natural renames S.Tree.Busy;
begin
-- It was formerly the case that when Start = No_Element, the partial
-- iterator was defined to behave the same as for a complete iterator,
-- and iterate over the entire sequence of items. However, those
-- semantics were unintuitive and arguably error-prone (it is too easy
-- to accidentally create an endless loop), and so they were changed,
-- per the ARG meeting in Denver on 2011/11. However, there was no
-- consensus about what positive meaning this corner case should have,
-- and so it was decided to simply raise an exception. This does imply,
-- however, that it is not possible to use a partial iterator to specify
-- an empty sequence of items.
if Start = No_Element then
raise Constraint_Error with
"Start position for iterator equals No_Element";
end if;
if Start.Container /= Container'Unrestricted_Access then
raise Program_Error with
"Start cursor of Iterate designates wrong set";
end if;
pragma Assert (Vet (Container.Tree, Start.Node),
"Start cursor of Iterate is bad");
-- The value of the Node component influences the behavior of the First
-- and Last selector functions of the iterator object. When the Node
-- component is non-null (as is the case here), it means that this is a
-- partial iteration, over a subset of the complete sequence of
-- items. The iterator object was constructed with a start expression,
-- indicating the position from which the iteration begins. Note that
-- the start position has the same value irrespective of whether this is
-- a forward or reverse iteration.
return It : constant Iterator :=
(Limited_Controlled with S, Start.Node)
do
B := B + 1;
end return;
end Iterate;
---------- ----------
-- Last -- -- Last --
---------- ----------
...@@ -1282,6 +1404,28 @@ package body Ada.Containers.Ordered_Multisets is ...@@ -1282,6 +1404,28 @@ package body Ada.Containers.Ordered_Multisets is
return Cursor'(Container'Unrestricted_Access, Container.Tree.Last); return Cursor'(Container'Unrestricted_Access, Container.Tree.Last);
end Last; end Last;
function Last (Object : Iterator) return Cursor is
begin
-- The value of the iterator object's Node component influences the
-- behavior of the Last (and First) selector function.
-- When the Node component is null, this means the iterator object was
-- constructed without a start expression, in which case the (reverse)
-- iteration starts from the (logical) beginning of the entire sequence
-- (corresponding to Container.Last, for a reverse iterator).
-- Otherwise, this is iteration over a partial sequence of items. When
-- the Node component is non-null, the iterator object was constructed
-- with a start expression, that specifies the position from which the
-- (reverse) partial iteration begins.
if Object.Node = null then
return Object.Container.Last;
else
return Cursor'(Object.Container, Object.Node);
end if;
end Last;
------------------ ------------------
-- Last_Element -- -- Last_Element --
------------------ ------------------
...@@ -1356,6 +1500,20 @@ package body Ada.Containers.Ordered_Multisets is ...@@ -1356,6 +1500,20 @@ package body Ada.Containers.Ordered_Multisets is
end; end;
end Next; end Next;
function Next (Object : Iterator; Position : Cursor) return Cursor is
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Next designates wrong set";
end if;
return Next (Position);
end Next;
------------- -------------
-- Overlap -- -- Overlap --
------------- -------------
...@@ -1405,6 +1563,20 @@ package body Ada.Containers.Ordered_Multisets is ...@@ -1405,6 +1563,20 @@ package body Ada.Containers.Ordered_Multisets is
end; end;
end Previous; end Previous;
function Previous (Object : Iterator; Position : Cursor) return Cursor is
begin
if Position.Container = null then
return No_Element;
end if;
if Position.Container /= Object.Container then
raise Program_Error with
"Position cursor of Previous designates wrong set";
end if;
return Previous (Position);
end Previous;
------------------- -------------------
-- Query_Element -- -- Query_Element --
------------------- -------------------
......
gcc/ada/a-coormu.ads
...@@ -34,6 +34,7 @@ ...@@ -34,6 +34,7 @@
private with Ada.Containers.Red_Black_Trees; private with Ada.Containers.Red_Black_Trees;
private with Ada.Finalization; private with Ada.Finalization;
private with Ada.Streams; private with Ada.Streams;
with Ada.Iterator_Interfaces;
generic generic
type Element_Type is private; type Element_Type is private;
...@@ -49,7 +50,10 @@ package Ada.Containers.Ordered_Multisets is ...@@ -49,7 +50,10 @@ package Ada.Containers.Ordered_Multisets is
-- Returns False if Left is less than Right, or Right is less than Left; -- Returns False if Left is less than Right, or Right is less than Left;
-- otherwise, it returns True. -- otherwise, it returns True.
type Set is tagged private; type Set is tagged private
with Default_Iterator => Iterate,
Iterator_Element => Element_Type;
pragma Preelaborable_Initialization (Set); pragma Preelaborable_Initialization (Set);
type Cursor is private; type Cursor is private;
...@@ -63,6 +67,12 @@ package Ada.Containers.Ordered_Multisets is ...@@ -63,6 +67,12 @@ package Ada.Containers.Ordered_Multisets is
-- The default value for cursor objects declared without an explicit -- The default value for cursor objects declared without an explicit
-- initialization expression. -- initialization expression.
function Has_Element (Position : Cursor) return Boolean;
-- Equivalent to Position /= No_Element
package Set_Iterator_Interfaces is new
Ada.Iterator_Interfaces (Cursor, Has_Element);
function "=" (Left, Right : Set) return Boolean; function "=" (Left, Right : Set) return Boolean;
-- If Left denotes the same set object as Right, then equality returns -- If Left denotes the same set object as Right, then equality returns
-- True. If the length of Left is different from the length of Right, then -- True. If the length of Left is different from the length of Right, then
...@@ -293,9 +303,6 @@ package Ada.Containers.Ordered_Multisets is ...@@ -293,9 +303,6 @@ package Ada.Containers.Ordered_Multisets is
function Contains (Container : Set; Item : Element_Type) return Boolean; function Contains (Container : Set; Item : Element_Type) return Boolean;
-- Equivalent to Container.Find (Item) /= No_Element -- Equivalent to Container.Find (Item) /= No_Element
function Has_Element (Position : Cursor) return Boolean;
-- Equivalent to Position /= No_Element
function "<" (Left, Right : Cursor) return Boolean; function "<" (Left, Right : Cursor) return Boolean;
-- Equivalent to Element (Left) < Element (Right) -- Equivalent to Element (Left) < Element (Right)
...@@ -340,6 +347,15 @@ package Ada.Containers.Ordered_Multisets is ...@@ -340,6 +347,15 @@ package Ada.Containers.Ordered_Multisets is
-- Call Process with a cursor designating each element equivalent to Item, -- Call Process with a cursor designating each element equivalent to Item,
-- in order from Container.Ceiling (Item) to Container.Floor (Item). -- in order from Container.Ceiling (Item) to Container.Floor (Item).
function Iterate
(Container : Set)
return Set_Iterator_Interfaces.Reversible_Iterator'class;
function Iterate
(Container : Set;
Start : Cursor)
return Set_Iterator_Interfaces.Reversible_Iterator'class;
generic generic
type Key_Type (<>) is private; type Key_Type (<>) is private;
......
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