diff options
Diffstat (limited to 'gcc/ada/a-ciorma.adb')
| -rw-r--r-- | gcc/ada/a-ciorma.adb | 184 |
1 files changed, 150 insertions, 34 deletions
diff --git a/gcc/ada/a-ciorma.adb b/gcc/ada/a-ciorma.adb index cd95b9fd5ab..3aa3c17e1c1 100644 --- a/gcc/ada/a-ciorma.adb +++ b/gcc/ada/a-ciorma.adb @@ -40,15 +40,17 @@ with System; use type System.Address; package body Ada.Containers.Indefinite_Ordered_Maps is pragma Suppress (All_Checks); - type Iterator is new - Map_Iterator_Interfaces.Reversible_Iterator with record - Container : Map_Access; - Node : Node_Access; - end record; + type Iterator is new Limited_Controlled and + Map_Iterator_Interfaces.Reversible_Iterator with + record + Container : Map_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; @@ -535,6 +537,22 @@ package body Ada.Containers.Indefinite_Ordered_Maps is end if; end Exclude; + -------------- + -- Finalize -- + -------------- + + procedure Finalize (Object : in out Iterator) is + begin + if Object.Container /= null then + declare + B : Natural renames Object.Container.all.Tree.Busy; + + begin + B := B - 1; + end; + end if; + end Finalize; + ---------- -- Find -- ---------- @@ -558,11 +576,25 @@ package body Ada.Containers.Indefinite_Ordered_Maps is end First; function First (Object : Iterator) return Cursor is - M : constant Map_Access := Object.Container; - N : constant Node_Access := M.Tree.First; begin - return (if N = null then No_Element - else Cursor'(Object.Container.all'Unchecked_Access, N)); + -- 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; ------------------- @@ -571,13 +603,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function First_Element (Container : Map) return Element_Type is T : Tree_Type renames Container.Tree; - begin if T.First = null then raise Constraint_Error with "map is empty"; + else + return T.First.Element.all; end if; - - return T.First.Element.all; end First_Element; --------------- @@ -586,13 +617,12 @@ package body Ada.Containers.Indefinite_Ordered_Maps is function First_Key (Container : Map) return Key_Type is T : Tree_Type renames Container.Tree; - begin if T.First = null then raise Constraint_Error with "map is empty"; + else + return T.First.Key.all; end if; - - return T.First.Key.all; end First_Key; ----------- @@ -845,7 +875,7 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Process (Cursor'(Container'Unrestricted_Access, Node)); end Process_Node; - B : Natural renames Container.Tree'Unrestricted_Access.all.Busy; + B : Natural renames Container'Unrestricted_Access.all.Tree.Busy; -- Start of processing for Iterate @@ -864,22 +894,78 @@ package body Ada.Containers.Indefinite_Ordered_Maps is end Iterate; function Iterate - (Container : Map) return Map_Iterator_Interfaces.Forward_Iterator'class + (Container : Map) return Map_Iterator_Interfaces.Reversible_Iterator'Class is - Node : constant Node_Access := Container.Tree.First; - It : constant Iterator := (Container'Unrestricted_Access, Node); + B : Natural renames Container'Unrestricted_Access.all.Tree.Busy; + begin - return It; + -- 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 + Container => Container'Unrestricted_Access, + Node => null) + do + B := B + 1; + end return; end Iterate; function Iterate (Container : Map; Start : Cursor) - return Map_Iterator_Interfaces.Reversible_Iterator'class + return Map_Iterator_Interfaces.Reversible_Iterator'Class is - It : constant Iterator := (Container'Unrestricted_Access, Start.Node); + B : Natural renames Container'Unrestricted_Access.all.Tree.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 map"; + 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 + Container => Container'Unrestricted_Access, + Node => Start.Node) + do + B := B + 1; + end return; end Iterate; --------- @@ -916,11 +1002,25 @@ package body Ada.Containers.Indefinite_Ordered_Maps is end Last; function Last (Object : Iterator) return Cursor is - M : constant Map_Access := Object.Container; - N : constant Node_Access := M.Tree.Last; begin - return (if N = null then No_Element - else Cursor'(Object.Container.all'Unchecked_Access, N)); + -- 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; ------------------ @@ -1017,8 +1117,16 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Position : Cursor) return Cursor is begin - return (if Position.Node = null then No_Element - else (Object.Container, Tree_Operations.Next (Position.Node))); + 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 map"; + end if; + + return Next (Position); end Next; ------------ @@ -1065,9 +1173,16 @@ package body Ada.Containers.Indefinite_Ordered_Maps is Position : Cursor) return Cursor is begin - return - (if Position.Node = null then No_Element - else (Object.Container, Tree_Operations.Previous (Position.Node))); + 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 map"; + end if; + + return Previous (Position); end Previous; ------------------- @@ -1490,4 +1605,5 @@ package body Ada.Containers.Indefinite_Ordered_Maps is begin raise Program_Error with "attempt to stream reference"; end Write; + end Ada.Containers.Indefinite_Ordered_Maps; |