diff options
Diffstat (limited to 'gcc/ada/a-cdlili.adb')
| -rw-r--r-- | gcc/ada/a-cdlili.adb | 178 |
1 files changed, 142 insertions, 36 deletions
diff --git a/gcc/ada/a-cdlili.adb b/gcc/ada/a-cdlili.adb index 8b513222ef8..12242583ebe 100644 --- a/gcc/ada/a-cdlili.adb +++ b/gcc/ada/a-cdlili.adb @@ -27,17 +27,20 @@ -- 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.Doubly_Linked_Lists is - type Iterator is new - List_Iterator_Interfaces.Reversible_Iterator with record - Container : List_Access; - Node : Node_Access; + + type Iterator is new Limited_Controlled and + List_Iterator_Interfaces.Reversible_Iterator with + record + Container : List_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; @@ -395,6 +398,22 @@ package body Ada.Containers.Doubly_Linked_Lists is return Position.Node.Element; 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 -- ---------- @@ -421,7 +440,7 @@ package body Ada.Containers.Doubly_Linked_Lists is while Node /= null loop if Node.Element = Item then - return Cursor'(Container'Unchecked_Access, Node); + return Cursor'(Container'Unrestricted_Access, Node); end if; Node := Node.Next; @@ -440,15 +459,28 @@ package body Ada.Containers.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 Doubly_Linked_Lists.First (Object.Container.all); else - return (Object.Container, Object.Container.First); + return Cursor'(Object.Container, Object.Node); end if; end First; @@ -843,9 +875,7 @@ package body Ada.Containers.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 @@ -853,7 +883,7 @@ package body Ada.Containers.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 @@ -866,22 +896,75 @@ package body Ada.Containers.Doubly_Linked_Lists is end Iterate; function Iterate (Container : List) - return List_Iterator_Interfaces.Reversible_Iterator'class + 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; ---------- @@ -894,15 +977,28 @@ package body Ada.Containers.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 Doubly_Linked_Lists.Last (Object.Container.all); else - return (Object.Container, Object.Container.Last); + return Cursor'(Object.Container, Object.Node); end if; end Last; @@ -992,11 +1088,16 @@ package body Ada.Containers.Doubly_Linked_Lists is Position : Cursor) return Cursor is begin - if Position.Node = Object.Container.Last then + if Position.Container = null then return No_Element; - else - return (Object.Container, Position.Node.Next); end if; + + if Position.Container /= Object.Container then + raise Program_Error with + "Position cursor of Next designates wrong list"; + end if; + + return Next (Position); end Next; ------------- @@ -1046,11 +1147,16 @@ package body Ada.Containers.Doubly_Linked_Lists is 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; ------------------- @@ -1338,7 +1444,7 @@ package body Ada.Containers.Doubly_Linked_Lists is while Node /= null loop if Node.Element = Item then - return Cursor'(Container'Unchecked_Access, Node); + return Cursor'(Container'Unrestricted_Access, Node); end if; Node := Node.Prev; @@ -1365,7 +1471,7 @@ package body Ada.Containers.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; |