diff options
Diffstat (limited to 'gcc/ada/a-cidlli.adb')
| -rw-r--r-- | gcc/ada/a-cidlli.adb | 178 |
1 files changed, 141 insertions, 37 deletions
diff --git a/gcc/ada/a-cidlli.adb b/gcc/ada/a-cidlli.adb index dbdc6de47d4..b74e8e115e4 100644 --- a/gcc/ada/a-cidlli.adb +++ b/gcc/ada/a-cidlli.adb @@ -27,23 +27,25 @@ -- This unit was originally developed by Matthew J Heaney. -- ------------------------------------------------------------------------------ -with System; use type System.Address; with Ada.Unchecked_Deallocation; +with System; use type System.Address; package body Ada.Containers.Indefinite_Doubly_Linked_Lists is procedure Free is new Ada.Unchecked_Deallocation (Element_Type, Element_Access); - type Iterator is new - List_Iterator_Interfaces.Reversible_Iterator with record - Container : List_Access; - Node : Node_Access; - end record; + type Iterator is new Limited_Controlled and + List_Iterator_Interfaces.Reversible_Iterator with + record + Container : List_Access; + Node : Node_Access; + end record; - overriding function First (Object : Iterator) return Cursor; + overriding procedure Finalize (Object : in out Iterator); - overriding function Last (Object : Iterator) return Cursor; + overriding function First (Object : Iterator) return Cursor; + overriding function Last (Object : Iterator) return Cursor; overriding function Next (Object : Iterator; @@ -429,6 +431,22 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is return Position.Node.Element.all; end Element; + -------------- + -- Finalize -- + -------------- + + procedure Finalize (Object : in out Iterator) is + begin + if Object.Container /= null then + declare + B : Natural renames Object.Container.all.Busy; + + begin + B := B - 1; + end; + end if; + end Finalize; + ---------- -- Find -- ---------- @@ -459,7 +477,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is while Node /= null loop if Node.Element.all = Item then - return Cursor'(Container'Unchecked_Access, Node); + return Cursor'(Container'Unrestricted_Access, Node); end if; Node := Node.Next; @@ -478,15 +496,28 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is return No_Element; end if; - return Cursor'(Container'Unchecked_Access, Container.First); + return Cursor'(Container'Unrestricted_Access, Container.First); end First; function First (Object : Iterator) return Cursor is begin - if Object.Container = null then - return No_Element; + -- 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 Indefinite_Doubly_Linked_Lists.First (Object.Container.all); else - return Cursor'(Object.Container, Object.Container.First); + return Cursor'(Object.Container, Object.Node); end if; end First; @@ -871,9 +902,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is (Container : List; Process : not null access procedure (Position : Cursor)) is - C : List renames Container'Unrestricted_Access.all; - B : Natural renames C.Busy; - + B : Natural renames Container'Unrestricted_Access.all.Busy; Node : Node_Access := Container.First; begin @@ -881,7 +910,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is begin while Node /= null loop - Process (Cursor'(Container'Unchecked_Access, Node)); + Process (Cursor'(Container'Unrestricted_Access, Node)); Node := Node.Next; end loop; exception @@ -897,22 +926,75 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is (Container : List) return List_Iterator_Interfaces.Reversible_Iterator'class is + B : Natural renames Container'Unrestricted_Access.all.Busy; + begin - if Container.Length = 0 then - return Iterator'(null, null); - else - return Iterator'(Container'Unchecked_Access, Container.First); - end if; + -- 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 := + Iterator'(Limited_Controlled with + Container => Container'Unrestricted_Access, + Node => null) + do + B := B + 1; + end return; end Iterate; function Iterate (Container : List; Start : Cursor) - return List_Iterator_Interfaces.Reversible_Iterator'class + return List_Iterator_Interfaces.Reversible_Iterator'Class is - It : constant Iterator := (Container'Unchecked_Access, Start.Node); + B : Natural renames Container'Unrestricted_Access.all.Busy; + begin - return It; + -- 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 list"; + end if; + + pragma Assert (Vet (Start), "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 := + Iterator'(Limited_Controlled with + Container => Container'Unrestricted_Access, + Node => Start.Node) + do + B := B + 1; + end return; end Iterate; ---------- @@ -925,15 +1007,28 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is return No_Element; end if; - return Cursor'(Container'Unchecked_Access, Container.Last); + return Cursor'(Container'Unrestricted_Access, Container.Last); end Last; function Last (Object : Iterator) return Cursor is begin - if Object.Container = null then - return No_Element; + -- 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 Indefinite_Doubly_Linked_Lists.Last (Object.Container.all); else - return Cursor'(Object.Container, Object.Container.Last); + return Cursor'(Object.Container, Object.Node); end if; end Last; @@ -1016,12 +1111,16 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is function Next (Object : Iterator; Position : Cursor) return Cursor is begin - if Position.Node = Object.Container.Last then + if Position.Container = null then return No_Element; + end if; - else - return (Object.Container, Position.Node.Next); + if Position.Container /= Object.Container then + raise Program_Error with + "Position cursor of Next designates wrong list"; end if; + + return Next (Position); end Next; ------------- @@ -1067,11 +1166,16 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is function Previous (Object : Iterator; Position : Cursor) return Cursor is begin - if Position.Node = Position.Container.First then + if Position.Container = null then return No_Element; - else - return (Object.Container, Position.Node.Prev); end if; + + if Position.Container /= Object.Container then + raise Program_Error with + "Position cursor of Previous designates wrong list"; + end if; + + return Previous (Position); end Previous; ------------------- @@ -1380,7 +1484,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is while Node /= null loop if Node.Element.all = Item then - return Cursor'(Container'Unchecked_Access, Node); + return Cursor'(Container'Unrestricted_Access, Node); end if; Node := Node.Prev; @@ -1407,7 +1511,7 @@ package body Ada.Containers.Indefinite_Doubly_Linked_Lists is begin while Node /= null loop - Process (Cursor'(Container'Unchecked_Access, Node)); + Process (Cursor'(Container'Unrestricted_Access, Node)); Node := Node.Prev; end loop; exception |