diff options
Diffstat (limited to 'gcc/ada/a-cdlili.adb')
| -rw-r--r-- | gcc/ada/a-cdlili.adb | 122 |
1 files changed, 121 insertions, 1 deletions
diff --git a/gcc/ada/a-cdlili.adb b/gcc/ada/a-cdlili.adb index cbac8fd4a1d..8a3b98358dd 100644 --- a/gcc/ada/a-cdlili.adb +++ b/gcc/ada/a-cdlili.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 2004-2010, Free Software Foundation, Inc. -- +-- Copyright (C) 2004-2011, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -32,6 +32,18 @@ with System; use type System.Address; with Ada.Unchecked_Deallocation; 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; + end record; + + 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; ----------------------- -- Local Subprograms -- @@ -395,6 +407,12 @@ package body Ada.Containers.Doubly_Linked_Lists is return Cursor'(Container'Unchecked_Access, Container.First); end First; + function First (Object : Iterator) return Cursor is + C : constant Cursor := (Object.Container, Object.Container.First); + begin + return C; + end First; + ------------------- -- First_Element -- ------------------- @@ -794,6 +812,22 @@ package body Ada.Containers.Doubly_Linked_Lists is B := B - 1; end Iterate; + function Iterate (Container : List) + return List_Iterator_Interfaces.Reversible_Iterator'class + is + It : constant Iterator := (Container'Unchecked_Access, Container.First); + begin + return It; + end Iterate; + + function Iterate (Container : List; Start : Cursor) + return List_Iterator_Interfaces.Reversible_Iterator'class + is + It : constant Iterator := (Container'Unchecked_Access, Start.Node); + begin + return It; + end Iterate; + ---------- -- Last -- ---------- @@ -807,6 +841,12 @@ package body Ada.Containers.Doubly_Linked_Lists is return Cursor'(Container'Unchecked_Access, Container.Last); end Last; + function Last (Object : Iterator) return Cursor is + C : constant Cursor := (Object.Container, Object.Container.Last); + begin + return C; + end Last; + ------------------ -- Last_Element -- ------------------ @@ -887,6 +927,16 @@ package body Ada.Containers.Doubly_Linked_Lists is end; end Next; + function Next (Object : Iterator; Position : Cursor) return Cursor is + begin + if Position.Node = Object.Container.Last then + return No_Element; + + else + return (Object.Container, Position.Node.Next); + end if; + end Next; + ------------- -- Prepend -- ------------- @@ -928,6 +978,16 @@ package body Ada.Containers.Doubly_Linked_Lists is end; end Previous; + function Previous (Object : Iterator; Position : Cursor) return Cursor is + begin + if Position.Node = Position.Container.First then + return No_Element; + + else + return (Object.Container, Position.Node.Prev); + end if; + end Previous; + ------------------- -- Query_Element -- ------------------- @@ -1027,6 +1087,50 @@ package body Ada.Containers.Doubly_Linked_Lists is raise Program_Error with "attempt to stream list cursor"; end Read; + procedure Read + (Stream : not null access Root_Stream_Type'Class; + Item : out Reference_Type) + is + begin + raise Program_Error with "attempt to stream reference"; + end Read; + + procedure Read + (Stream : not null access Root_Stream_Type'Class; + Item : out Constant_Reference_Type) + is + begin + raise Program_Error with "attempt to stream reference"; + end Read; + + --------------- + -- Reference -- + --------------- + + function Constant_Reference (Container : List; Position : Cursor) + return Constant_Reference_Type is + begin + pragma Unreferenced (Container); + + if Position.Container = null then + raise Constraint_Error with "Position cursor has no element"; + end if; + + return (Element => Position.Node.Element'Access); + end Constant_Reference; + + function Reference (Container : List; Position : Cursor) + return Reference_Type is + begin + pragma Unreferenced (Container); + + if Position.Container = null then + raise Constraint_Error with "Position cursor has no element"; + end if; + + return (Element => Position.Node.Element'Access); + end Reference; + --------------------- -- Replace_Element -- --------------------- @@ -1832,4 +1936,20 @@ package body Ada.Containers.Doubly_Linked_Lists is raise Program_Error with "attempt to stream list cursor"; end Write; + procedure Write + (Stream : not null access Root_Stream_Type'Class; + Item : Reference_Type) + is + begin + raise Program_Error with "attempt to stream reference"; + end Write; + + procedure Write + (Stream : not null access Root_Stream_Type'Class; + Item : Constant_Reference_Type) + is + begin + raise Program_Error with "attempt to stream reference"; + end Write; + end Ada.Containers.Doubly_Linked_Lists; |