1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- ADA.CONTAINERS.BOUNDED_DOUBLY_LINKED_LISTS --
9 -- Copyright (C) 2004-2015, Free Software Foundation, Inc. --
11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
15 -- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
16 -- or FITNESS FOR A PARTICULAR PURPOSE. --
18 -- As a special exception under Section 7 of GPL version 3, you are granted --
19 -- additional permissions described in the GCC Runtime Library Exception, --
20 -- version 3.1, as published by the Free Software Foundation. --
22 -- You should have received a copy of the GNU General Public License and --
23 -- a copy of the GCC Runtime Library Exception along with this program; --
24 -- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see --
25 -- <http://www.gnu.org/licenses/>. --
27 -- This unit was originally developed by Matthew J Heaney. --
28 ------------------------------------------------------------------------------
30 with System; use type System.Address;
32 package body Ada.Containers.Bounded_Doubly_Linked_Lists is
34 pragma Warnings (Off, "variable ""Busy*"" is not referenced");
35 pragma Warnings (Off, "variable ""Lock*"" is not referenced");
36 -- See comment in Ada.Containers.Helpers
38 -----------------------
39 -- Local Subprograms --
40 -----------------------
43 (Container : in out List;
44 New_Item : Element_Type;
45 New_Node : out Count_Type);
48 (Container : in out List;
49 Stream : not null access Root_Stream_Type'Class;
50 New_Node : out Count_Type);
53 (Container : in out List;
56 procedure Insert_Internal
57 (Container : in out List;
59 New_Node : Count_Type);
61 procedure Splice_Internal
62 (Target : in out List;
64 Source : in out List);
66 procedure Splice_Internal
67 (Target : in out List;
71 Tgt_Pos : out Count_Type);
73 function Vet (Position : Cursor) return Boolean;
74 -- Checks invariants of the cursor and its designated container, as a
75 -- simple way of detecting dangling references (see operation Free for a
76 -- description of the detection mechanism), returning True if all checks
77 -- pass. Invocations of Vet are used here as the argument of pragma Assert,
78 -- so the checks are performed only when assertions are enabled.
84 function "=" (Left, Right : List) return Boolean is
86 if Left.Length /= Right.Length then
90 if Left.Length = 0 then
95 -- Per AI05-0022, the container implementation is required to detect
96 -- element tampering by a generic actual subprogram.
98 Lock_Left : With_Lock (Left.TC'Unrestricted_Access);
99 Lock_Right : With_Lock (Right.TC'Unrestricted_Access);
101 LN : Node_Array renames Left.Nodes;
102 RN : Node_Array renames Right.Nodes;
104 LI : Count_Type := Left.First;
105 RI : Count_Type := Right.First;
107 for J in 1 .. Left.Length loop
108 if LN (LI).Element /= RN (RI).Element then
125 (Container : in out List;
126 New_Item : Element_Type;
127 New_Node : out Count_Type)
129 N : Node_Array renames Container.Nodes;
132 if Container.Free >= 0 then
133 New_Node := Container.Free;
135 -- We always perform the assignment first, before we change container
136 -- state, in order to defend against exceptions duration assignment.
138 N (New_Node).Element := New_Item;
139 Container.Free := N (New_Node).Next;
142 -- A negative free store value means that the links of the nodes in
143 -- the free store have not been initialized. In this case, the nodes
144 -- are physically contiguous in the array, starting at the index that
145 -- is the absolute value of the Container.Free, and continuing until
146 -- the end of the array (Nodes'Last).
148 New_Node := abs Container.Free;
150 -- As above, we perform this assignment first, before modifying any
153 N (New_Node).Element := New_Item;
154 Container.Free := Container.Free - 1;
159 (Container : in out List;
160 Stream : not null access Root_Stream_Type'Class;
161 New_Node : out Count_Type)
163 N : Node_Array renames Container.Nodes;
166 if Container.Free >= 0 then
167 New_Node := Container.Free;
169 -- We always perform the assignment first, before we change container
170 -- state, in order to defend against exceptions duration assignment.
172 Element_Type'Read (Stream, N (New_Node).Element);
173 Container.Free := N (New_Node).Next;
176 -- A negative free store value means that the links of the nodes in
177 -- the free store have not been initialized. In this case, the nodes
178 -- are physically contiguous in the array, starting at the index that
179 -- is the absolute value of the Container.Free, and continuing until
180 -- the end of the array (Nodes'Last).
182 New_Node := abs Container.Free;
184 -- As above, we perform this assignment first, before modifying any
187 Element_Type'Read (Stream, N (New_Node).Element);
188 Container.Free := Container.Free - 1;
197 (Container : in out List;
198 New_Item : Element_Type;
199 Count : Count_Type := 1)
202 Insert (Container, No_Element, New_Item, Count);
209 procedure Assign (Target : in out List; Source : List) is
210 SN : Node_Array renames Source.Nodes;
214 if Target'Address = Source'Address then
218 if Checks and then Target.Capacity < Source.Length then
219 raise Capacity_Error -- ???
220 with "Target capacity is less than Source length";
227 Target.Append (SN (J).Element);
236 procedure Clear (Container : in out List) is
237 N : Node_Array renames Container.Nodes;
241 if Container.Length = 0 then
242 pragma Assert (Container.First = 0);
243 pragma Assert (Container.Last = 0);
244 pragma Assert (Container.TC = (Busy => 0, Lock => 0));
248 pragma Assert (Container.First >= 1);
249 pragma Assert (Container.Last >= 1);
250 pragma Assert (N (Container.First).Prev = 0);
251 pragma Assert (N (Container.Last).Next = 0);
253 TC_Check (Container.TC);
255 while Container.Length > 1 loop
256 X := Container.First;
257 pragma Assert (N (N (X).Next).Prev = Container.First);
259 Container.First := N (X).Next;
260 N (Container.First).Prev := 0;
262 Container.Length := Container.Length - 1;
267 X := Container.First;
268 pragma Assert (X = Container.Last);
270 Container.First := 0;
272 Container.Length := 0;
277 ------------------------
278 -- Constant_Reference --
279 ------------------------
281 function Constant_Reference
282 (Container : aliased List;
283 Position : Cursor) return Constant_Reference_Type
286 if Checks and then Position.Container = null then
287 raise Constraint_Error with "Position cursor has no element";
290 if Checks and then Position.Container /= Container'Unrestricted_Access
292 raise Program_Error with
293 "Position cursor designates wrong container";
296 pragma Assert (Vet (Position), "bad cursor in Constant_Reference");
299 N : Node_Type renames Container.Nodes (Position.Node);
300 TC : constant Tamper_Counts_Access :=
301 Container.TC'Unrestricted_Access;
303 return R : constant Constant_Reference_Type :=
304 (Element => N.Element'Access,
305 Control => (Controlled with TC))
310 end Constant_Reference;
318 Item : Element_Type) return Boolean
321 return Find (Container, Item) /= No_Element;
328 function Copy (Source : List; Capacity : Count_Type := 0) return List is
334 elsif Capacity >= Source.Length then
337 raise Capacity_Error with "Capacity value too small";
340 return Target : List (Capacity => C) do
341 Assign (Target => Target, Source => Source);
350 (Container : in out List;
351 Position : in out Cursor;
352 Count : Count_Type := 1)
354 N : Node_Array renames Container.Nodes;
358 if Checks and then Position.Node = 0 then
359 raise Constraint_Error with
360 "Position cursor has no element";
363 if Checks and then Position.Container /= Container'Unrestricted_Access
365 raise Program_Error with
366 "Position cursor designates wrong container";
369 pragma Assert (Vet (Position), "bad cursor in Delete");
370 pragma Assert (Container.First >= 1);
371 pragma Assert (Container.Last >= 1);
372 pragma Assert (N (Container.First).Prev = 0);
373 pragma Assert (N (Container.Last).Next = 0);
375 if Position.Node = Container.First then
376 Delete_First (Container, Count);
377 Position := No_Element;
382 Position := No_Element;
386 TC_Check (Container.TC);
388 for Index in 1 .. Count loop
389 pragma Assert (Container.Length >= 2);
392 Container.Length := Container.Length - 1;
394 if X = Container.Last then
395 Position := No_Element;
397 Container.Last := N (X).Prev;
398 N (Container.Last).Next := 0;
404 Position.Node := N (X).Next;
406 N (N (X).Next).Prev := N (X).Prev;
407 N (N (X).Prev).Next := N (X).Next;
412 Position := No_Element;
419 procedure Delete_First
420 (Container : in out List;
421 Count : Count_Type := 1)
423 N : Node_Array renames Container.Nodes;
427 if Count >= Container.Length then
436 TC_Check (Container.TC);
438 for J in 1 .. Count loop
439 X := Container.First;
440 pragma Assert (N (N (X).Next).Prev = Container.First);
442 Container.First := N (X).Next;
443 N (Container.First).Prev := 0;
445 Container.Length := Container.Length - 1;
455 procedure Delete_Last
456 (Container : in out List;
457 Count : Count_Type := 1)
459 N : Node_Array renames Container.Nodes;
463 if Count >= Container.Length then
472 TC_Check (Container.TC);
474 for J in 1 .. Count loop
476 pragma Assert (N (N (X).Prev).Next = Container.Last);
478 Container.Last := N (X).Prev;
479 N (Container.Last).Next := 0;
481 Container.Length := Container.Length - 1;
491 function Element (Position : Cursor) return Element_Type is
493 if Checks and then Position.Node = 0 then
494 raise Constraint_Error with
495 "Position cursor has no element";
498 pragma Assert (Vet (Position), "bad cursor in Element");
500 return Position.Container.Nodes (Position.Node).Element;
507 procedure Finalize (Object : in out Iterator) is
509 if Object.Container /= null then
510 Unbusy (Object.Container.TC);
521 Position : Cursor := No_Element) return Cursor
523 Nodes : Node_Array renames Container.Nodes;
524 Node : Count_Type := Position.Node;
528 Node := Container.First;
531 if Checks and then Position.Container /= Container'Unrestricted_Access
533 raise Program_Error with
534 "Position cursor designates wrong container";
537 pragma Assert (Vet (Position), "bad cursor in Find");
540 -- Per AI05-0022, the container implementation is required to detect
541 -- element tampering by a generic actual subprogram.
544 Lock : With_Lock (Container.TC'Unrestricted_Access);
547 if Nodes (Node).Element = Item then
548 return Cursor'(Container'Unrestricted_Access, Node);
551 Node := Nodes (Node).Next;
562 function First (Container : List) return Cursor is
564 if Container.First = 0 then
567 return Cursor'(Container'Unrestricted_Access, Container.First);
571 function First (Object : Iterator) return Cursor is
573 -- The value of the iterator object's Node component influences the
574 -- behavior of the First (and Last) selector function.
576 -- When the Node component is 0, this means the iterator object was
577 -- constructed without a start expression, in which case the (forward)
578 -- iteration starts from the (logical) beginning of the entire sequence
579 -- of items (corresponding to Container.First, for a forward iterator).
581 -- Otherwise, this is iteration over a partial sequence of items. When
582 -- the Node component is positive, the iterator object was constructed
583 -- with a start expression, that specifies the position from which the
584 -- (forward) partial iteration begins.
586 if Object.Node = 0 then
587 return Bounded_Doubly_Linked_Lists.First (Object.Container.all);
589 return Cursor'(Object.Container, Object.Node);
597 function First_Element (Container : List) return Element_Type is
599 if Checks and then Container.First = 0 then
600 raise Constraint_Error with "list is empty";
603 return Container.Nodes (Container.First).Element;
611 (Container : in out List;
614 pragma Assert (X > 0);
615 pragma Assert (X <= Container.Capacity);
617 N : Node_Array renames Container.Nodes;
618 pragma Assert (N (X).Prev >= 0); -- node is active
621 -- The list container actually contains two lists: one for the "active"
622 -- nodes that contain elements that have been inserted onto the list,
623 -- and another for the "inactive" nodes for the free store.
625 -- We desire that merely declaring an object should have only minimal
626 -- cost; specially, we want to avoid having to initialize the free
627 -- store (to fill in the links), especially if the capacity is large.
629 -- The head of the free list is indicated by Container.Free. If its
630 -- value is non-negative, then the free store has been initialized in
631 -- the "normal" way: Container.Free points to the head of the list of
632 -- free (inactive) nodes, and the value 0 means the free list is empty.
633 -- Each node on the free list has been initialized to point to the next
634 -- free node (via its Next component), and the value 0 means that this
635 -- is the last free node.
637 -- If Container.Free is negative, then the links on the free store have
638 -- not been initialized. In this case the link values are implied: the
639 -- free store comprises the components of the node array started with
640 -- the absolute value of Container.Free, and continuing until the end of
641 -- the array (Nodes'Last).
643 -- If the list container is manipulated on one end only (for example if
644 -- the container were being used as a stack), then there is no need to
645 -- initialize the free store, since the inactive nodes are physically
646 -- contiguous (in fact, they lie immediately beyond the logical end
647 -- being manipulated). The only time we need to actually initialize the
648 -- nodes in the free store is if the node that becomes inactive is not
649 -- at the end of the list. The free store would then be discontiguous
650 -- and so its nodes would need to be linked in the traditional way.
653 -- It might be possible to perform an optimization here. Suppose that
654 -- the free store can be represented as having two parts: one comprising
655 -- the non-contiguous inactive nodes linked together in the normal way,
656 -- and the other comprising the contiguous inactive nodes (that are not
657 -- linked together, at the end of the nodes array). This would allow us
658 -- to never have to initialize the free store, except in a lazy way as
659 -- nodes become inactive.
661 -- When an element is deleted from the list container, its node becomes
662 -- inactive, and so we set its Prev component to a negative value, to
663 -- indicate that it is now inactive. This provides a useful way to
664 -- detect a dangling cursor reference (and which is used in Vet).
666 N (X).Prev := -1; -- Node is deallocated (not on active list)
668 if Container.Free >= 0 then
670 -- The free store has previously been initialized. All we need to
671 -- do here is link the newly-free'd node onto the free list.
673 N (X).Next := Container.Free;
676 elsif X + 1 = abs Container.Free then
678 -- The free store has not been initialized, and the node becoming
679 -- inactive immediately precedes the start of the free store. All
680 -- we need to do is move the start of the free store back by one.
682 -- Note: initializing Next to zero is not strictly necessary but
683 -- seems cleaner and marginally safer.
686 Container.Free := Container.Free + 1;
689 -- The free store has not been initialized, and the node becoming
690 -- inactive does not immediately precede the free store. Here we
691 -- first initialize the free store (meaning the links are given
692 -- values in the traditional way), and then link the newly-free'd
693 -- node onto the head of the free store.
696 -- See the comments above for an optimization opportunity. If the
697 -- next link for a node on the free store is negative, then this
698 -- means the remaining nodes on the free store are physically
699 -- contiguous, starting as the absolute value of that index value.
701 Container.Free := abs Container.Free;
703 if Container.Free > Container.Capacity then
707 for I in Container.Free .. Container.Capacity - 1 loop
711 N (Container.Capacity).Next := 0;
714 N (X).Next := Container.Free;
719 ---------------------
720 -- Generic_Sorting --
721 ---------------------
723 package body Generic_Sorting is
729 function Is_Sorted (Container : List) return Boolean is
730 -- Per AI05-0022, the container implementation is required to detect
731 -- element tampering by a generic actual subprogram.
733 Lock : With_Lock (Container.TC'Unrestricted_Access);
735 Nodes : Node_Array renames Container.Nodes;
738 Node := Container.First;
739 for J in 2 .. Container.Length loop
740 if Nodes (Nodes (Node).Next).Element < Nodes (Node).Element then
744 Node := Nodes (Node).Next;
755 (Target : in out List;
756 Source : in out List)
759 -- The semantics of Merge changed slightly per AI05-0021. It was
760 -- originally the case that if Target and Source denoted the same
761 -- container object, then the GNAT implementation of Merge did
762 -- nothing. However, it was argued that RM05 did not precisely
763 -- specify the semantics for this corner case. The decision of the
764 -- ARG was that if Target and Source denote the same non-empty
765 -- container object, then Program_Error is raised.
767 if Source.Is_Empty then
771 if Checks and then Target'Address = Source'Address then
772 raise Program_Error with
773 "Target and Source denote same non-empty container";
776 if Checks and then Target.Length > Count_Type'Last - Source.Length
778 raise Constraint_Error with "new length exceeds maximum";
781 if Checks and then Target.Length + Source.Length > Target.Capacity
783 raise Capacity_Error with "new length exceeds target capacity";
786 TC_Check (Target.TC);
787 TC_Check (Source.TC);
789 -- Per AI05-0022, the container implementation is required to detect
790 -- element tampering by a generic actual subprogram.
793 Lock_Target : With_Lock (Target.TC'Unchecked_Access);
794 Lock_Source : With_Lock (Source.TC'Unchecked_Access);
796 LN : Node_Array renames Target.Nodes;
797 RN : Node_Array renames Source.Nodes;
799 LI, LJ, RI, RJ : Count_Type;
805 pragma Assert (RN (RI).Next = 0
806 or else not (RN (RN (RI).Next).Element <
810 Splice_Internal (Target, 0, Source);
814 pragma Assert (LN (LI).Next = 0
815 or else not (LN (LN (LI).Next).Element <
818 if RN (RI).Element < LN (LI).Element then
821 Splice_Internal (Target, LI, Source, RJ, LJ);
834 procedure Sort (Container : in out List) is
835 N : Node_Array renames Container.Nodes;
837 procedure Partition (Pivot, Back : Count_Type);
838 -- What does this do ???
840 procedure Sort (Front, Back : Count_Type);
841 -- Internal procedure, what does it do??? rename it???
847 procedure Partition (Pivot, Back : Count_Type) is
851 Node := N (Pivot).Next;
852 while Node /= Back loop
853 if N (Node).Element < N (Pivot).Element then
855 Prev : constant Count_Type := N (Node).Prev;
856 Next : constant Count_Type := N (Node).Next;
859 N (Prev).Next := Next;
862 Container.Last := Prev;
864 N (Next).Prev := Prev;
867 N (Node).Next := Pivot;
868 N (Node).Prev := N (Pivot).Prev;
870 N (Pivot).Prev := Node;
872 if N (Node).Prev = 0 then
873 Container.First := Node;
875 N (N (Node).Prev).Next := Node;
882 Node := N (Node).Next;
891 procedure Sort (Front, Back : Count_Type) is
892 Pivot : constant Count_Type :=
893 (if Front = 0 then Container.First else N (Front).Next);
895 if Pivot /= Back then
896 Partition (Pivot, Back);
902 -- Start of processing for Sort
905 if Container.Length <= 1 then
909 pragma Assert (N (Container.First).Prev = 0);
910 pragma Assert (N (Container.Last).Next = 0);
912 TC_Check (Container.TC);
914 -- Per AI05-0022, the container implementation is required to detect
915 -- element tampering by a generic actual subprogram.
918 Lock : With_Lock (Container.TC'Unchecked_Access);
920 Sort (Front => 0, Back => 0);
923 pragma Assert (N (Container.First).Prev = 0);
924 pragma Assert (N (Container.Last).Next = 0);
929 ------------------------
930 -- Get_Element_Access --
931 ------------------------
933 function Get_Element_Access
934 (Position : Cursor) return not null Element_Access is
936 return Position.Container.Nodes (Position.Node).Element'Access;
937 end Get_Element_Access;
943 function Has_Element (Position : Cursor) return Boolean is
945 pragma Assert (Vet (Position), "bad cursor in Has_Element");
946 return Position.Node /= 0;
954 (Container : in out List;
956 New_Item : Element_Type;
957 Position : out Cursor;
958 Count : Count_Type := 1)
960 First_Node : Count_Type;
961 New_Node : Count_Type;
964 if Before.Container /= null then
965 if Checks and then Before.Container /= Container'Unrestricted_Access
967 raise Program_Error with
968 "Before cursor designates wrong list";
971 pragma Assert (Vet (Before), "bad cursor in Insert");
979 if Checks and then Container.Length > Container.Capacity - Count then
980 raise Capacity_Error with "capacity exceeded";
983 TC_Check (Container.TC);
985 Allocate (Container, New_Item, New_Node);
986 First_Node := New_Node;
987 Insert_Internal (Container, Before.Node, New_Node);
989 for Index in Count_Type'(2) .. Count loop
990 Allocate (Container, New_Item, New_Node);
991 Insert_Internal (Container, Before.Node, New_Node);
994 Position := Cursor'(Container'Unchecked_Access, First_Node);
998 (Container : in out List;
1000 New_Item : Element_Type;
1001 Count : Count_Type := 1)
1004 pragma Unreferenced (Position);
1006 Insert (Container, Before, New_Item, Position, Count);
1010 (Container : in out List;
1012 Position : out Cursor;
1013 Count : Count_Type := 1)
1015 New_Item : Element_Type;
1016 pragma Unmodified (New_Item);
1017 -- OK to reference, see below
1020 -- There is no explicit element provided, but in an instance the element
1021 -- type may be a scalar with a Default_Value aspect, or a composite
1022 -- type with such a scalar component, or components with default
1023 -- initialization, so insert the specified number of possibly
1024 -- initialized elements at the given position.
1026 Insert (Container, Before, New_Item, Position, Count);
1029 ---------------------
1030 -- Insert_Internal --
1031 ---------------------
1033 procedure Insert_Internal
1034 (Container : in out List;
1035 Before : Count_Type;
1036 New_Node : Count_Type)
1038 N : Node_Array renames Container.Nodes;
1041 if Container.Length = 0 then
1042 pragma Assert (Before = 0);
1043 pragma Assert (Container.First = 0);
1044 pragma Assert (Container.Last = 0);
1046 Container.First := New_Node;
1047 N (Container.First).Prev := 0;
1049 Container.Last := New_Node;
1050 N (Container.Last).Next := 0;
1052 -- Before = zero means append
1054 elsif Before = 0 then
1055 pragma Assert (N (Container.Last).Next = 0);
1057 N (Container.Last).Next := New_Node;
1058 N (New_Node).Prev := Container.Last;
1060 Container.Last := New_Node;
1061 N (Container.Last).Next := 0;
1063 -- Before = Container.First means prepend
1065 elsif Before = Container.First then
1066 pragma Assert (N (Container.First).Prev = 0);
1068 N (Container.First).Prev := New_Node;
1069 N (New_Node).Next := Container.First;
1071 Container.First := New_Node;
1072 N (Container.First).Prev := 0;
1075 pragma Assert (N (Container.First).Prev = 0);
1076 pragma Assert (N (Container.Last).Next = 0);
1078 N (New_Node).Next := Before;
1079 N (New_Node).Prev := N (Before).Prev;
1081 N (N (Before).Prev).Next := New_Node;
1082 N (Before).Prev := New_Node;
1085 Container.Length := Container.Length + 1;
1086 end Insert_Internal;
1092 function Is_Empty (Container : List) return Boolean is
1094 return Container.Length = 0;
1103 Process : not null access procedure (Position : Cursor))
1105 Busy : With_Busy (Container.TC'Unrestricted_Access);
1106 Node : Count_Type := Container.First;
1109 while Node /= 0 loop
1110 Process (Cursor'(Container'Unrestricted_Access, Node));
1111 Node := Container.Nodes (Node).Next;
1117 return List_Iterator_Interfaces.Reversible_Iterator'Class
1120 -- The value of the Node component influences the behavior of the First
1121 -- and Last selector functions of the iterator object. When the Node
1122 -- component is 0 (as is the case here), this means the iterator
1123 -- object was constructed without a start expression. This is a
1124 -- complete iterator, meaning that the iteration starts from the
1125 -- (logical) beginning of the sequence of items.
1127 -- Note: For a forward iterator, Container.First is the beginning, and
1128 -- for a reverse iterator, Container.Last is the beginning.
1130 return It : constant Iterator :=
1131 Iterator'(Limited_Controlled with
1132 Container => Container'Unrestricted_Access,
1135 Busy (Container.TC'Unrestricted_Access.all);
1142 return List_Iterator_Interfaces.Reversible_Iterator'class
1145 -- It was formerly the case that when Start = No_Element, the partial
1146 -- iterator was defined to behave the same as for a complete iterator,
1147 -- and iterate over the entire sequence of items. However, those
1148 -- semantics were unintuitive and arguably error-prone (it is too easy
1149 -- to accidentally create an endless loop), and so they were changed,
1150 -- per the ARG meeting in Denver on 2011/11. However, there was no
1151 -- consensus about what positive meaning this corner case should have,
1152 -- and so it was decided to simply raise an exception. This does imply,
1153 -- however, that it is not possible to use a partial iterator to specify
1154 -- an empty sequence of items.
1156 if Checks and then Start = No_Element then
1157 raise Constraint_Error with
1158 "Start position for iterator equals No_Element";
1161 if Checks and then Start.Container /= Container'Unrestricted_Access then
1162 raise Program_Error with
1163 "Start cursor of Iterate designates wrong list";
1166 pragma Assert (Vet (Start), "Start cursor of Iterate is bad");
1168 -- The value of the Node component influences the behavior of the First
1169 -- and Last selector functions of the iterator object. When the Node
1170 -- component is positive (as is the case here), it means that this
1171 -- is a partial iteration, over a subset of the complete sequence of
1172 -- items. The iterator object was constructed with a start expression,
1173 -- indicating the position from which the iteration begins. Note that
1174 -- the start position has the same value irrespective of whether this
1175 -- is a forward or reverse iteration.
1177 return It : constant Iterator :=
1178 Iterator'(Limited_Controlled with
1179 Container => Container'Unrestricted_Access,
1182 Busy (Container.TC'Unrestricted_Access.all);
1190 function Last (Container : List) return Cursor is
1192 if Container.Last = 0 then
1195 return Cursor'(Container'Unrestricted_Access, Container.Last);
1199 function Last (Object : Iterator) return Cursor is
1201 -- The value of the iterator object's Node component influences the
1202 -- behavior of the Last (and First) selector function.
1204 -- When the Node component is 0, this means the iterator object was
1205 -- constructed without a start expression, in which case the (reverse)
1206 -- iteration starts from the (logical) beginning of the entire sequence
1207 -- (corresponding to Container.Last, for a reverse iterator).
1209 -- Otherwise, this is iteration over a partial sequence of items. When
1210 -- the Node component is positive, the iterator object was constructed
1211 -- with a start expression, that specifies the position from which the
1212 -- (reverse) partial iteration begins.
1214 if Object.Node = 0 then
1215 return Bounded_Doubly_Linked_Lists.Last (Object.Container.all);
1217 return Cursor'(Object.Container, Object.Node);
1225 function Last_Element (Container : List) return Element_Type is
1227 if Checks and then Container.Last = 0 then
1228 raise Constraint_Error with "list is empty";
1231 return Container.Nodes (Container.Last).Element;
1238 function Length (Container : List) return Count_Type is
1240 return Container.Length;
1248 (Target : in out List;
1249 Source : in out List)
1251 N : Node_Array renames Source.Nodes;
1255 if Target'Address = Source'Address then
1259 if Checks and then Target.Capacity < Source.Length then
1260 raise Capacity_Error with "Source length exceeds Target capacity";
1263 TC_Check (Source.TC);
1265 -- Clear target, note that this checks busy bits of Target
1269 while Source.Length > 1 loop
1270 pragma Assert (Source.First in 1 .. Source.Capacity);
1271 pragma Assert (Source.Last /= Source.First);
1272 pragma Assert (N (Source.First).Prev = 0);
1273 pragma Assert (N (Source.Last).Next = 0);
1275 -- Copy first element from Source to Target
1278 Append (Target, N (X).Element);
1280 -- Unlink first node of Source
1282 Source.First := N (X).Next;
1283 N (Source.First).Prev := 0;
1285 Source.Length := Source.Length - 1;
1287 -- The representation invariants for Source have been restored. It is
1288 -- now safe to free the unlinked node, without fear of corrupting the
1289 -- active links of Source.
1291 -- Note that the algorithm we use here models similar algorithms used
1292 -- in the unbounded form of the doubly-linked list container. In that
1293 -- case, Free is an instantation of Unchecked_Deallocation, which can
1294 -- fail (because PE will be raised if controlled Finalize fails), so
1295 -- we must defer the call until the last step. Here in the bounded
1296 -- form, Free merely links the node we have just "deallocated" onto a
1297 -- list of inactive nodes, so technically Free cannot fail. However,
1298 -- for consistency, we handle Free the same way here as we do for the
1299 -- unbounded form, with the pessimistic assumption that it can fail.
1304 if Source.Length = 1 then
1305 pragma Assert (Source.First in 1 .. Source.Capacity);
1306 pragma Assert (Source.Last = Source.First);
1307 pragma Assert (N (Source.First).Prev = 0);
1308 pragma Assert (N (Source.Last).Next = 0);
1310 -- Copy element from Source to Target
1313 Append (Target, N (X).Element);
1315 -- Unlink node of Source
1321 -- Return the unlinked node to the free store
1331 procedure Next (Position : in out Cursor) is
1333 Position := Next (Position);
1336 function Next (Position : Cursor) return Cursor is
1338 if Position.Node = 0 then
1342 pragma Assert (Vet (Position), "bad cursor in Next");
1345 Nodes : Node_Array renames Position.Container.Nodes;
1346 Node : constant Count_Type := Nodes (Position.Node).Next;
1351 return Cursor'(Position.Container, Node);
1358 Position : Cursor) return Cursor
1361 if Position.Container = null then
1365 if Checks and then Position.Container /= Object.Container then
1366 raise Program_Error with
1367 "Position cursor of Next designates wrong list";
1370 return Next (Position);
1378 (Container : in out List;
1379 New_Item : Element_Type;
1380 Count : Count_Type := 1)
1383 Insert (Container, First (Container), New_Item, Count);
1390 procedure Previous (Position : in out Cursor) is
1392 Position := Previous (Position);
1395 function Previous (Position : Cursor) return Cursor is
1397 if Position.Node = 0 then
1401 pragma Assert (Vet (Position), "bad cursor in Previous");
1404 Nodes : Node_Array renames Position.Container.Nodes;
1405 Node : constant Count_Type := Nodes (Position.Node).Prev;
1410 return Cursor'(Position.Container, Node);
1417 Position : Cursor) return Cursor
1420 if Position.Container = null then
1424 if Checks and then Position.Container /= Object.Container then
1425 raise Program_Error with
1426 "Position cursor of Previous designates wrong list";
1429 return Previous (Position);
1432 ----------------------
1433 -- Pseudo_Reference --
1434 ----------------------
1436 function Pseudo_Reference
1437 (Container : aliased List'Class) return Reference_Control_Type
1439 TC : constant Tamper_Counts_Access := Container.TC'Unrestricted_Access;
1441 return R : constant Reference_Control_Type := (Controlled with TC) do
1444 end Pseudo_Reference;
1450 procedure Query_Element
1452 Process : not null access procedure (Element : Element_Type))
1455 if Checks and then Position.Node = 0 then
1456 raise Constraint_Error with
1457 "Position cursor has no element";
1460 pragma Assert (Vet (Position), "bad cursor in Query_Element");
1463 Lock : With_Lock (Position.Container.TC'Unrestricted_Access);
1464 C : List renames Position.Container.all'Unrestricted_Access.all;
1465 N : Node_Type renames C.Nodes (Position.Node);
1467 Process (N.Element);
1476 (Stream : not null access Root_Stream_Type'Class;
1479 N : Count_Type'Base;
1484 Count_Type'Base'Read (Stream, N);
1486 if Checks and then N < 0 then
1487 raise Program_Error with "bad list length (corrupt stream)";
1494 if Checks and then N > Item.Capacity then
1495 raise Constraint_Error with "length exceeds capacity";
1498 for Idx in 1 .. N loop
1499 Allocate (Item, Stream, New_Node => X);
1500 Insert_Internal (Item, Before => 0, New_Node => X);
1505 (Stream : not null access Root_Stream_Type'Class;
1509 raise Program_Error with "attempt to stream list cursor";
1513 (Stream : not null access Root_Stream_Type'Class;
1514 Item : out Reference_Type)
1517 raise Program_Error with "attempt to stream reference";
1521 (Stream : not null access Root_Stream_Type'Class;
1522 Item : out Constant_Reference_Type)
1525 raise Program_Error with "attempt to stream reference";
1533 (Container : aliased in out List;
1534 Position : Cursor) return Reference_Type
1537 if Checks and then Position.Container = null then
1538 raise Constraint_Error with "Position cursor has no element";
1541 if Checks and then Position.Container /= Container'Unrestricted_Access
1543 raise Program_Error with
1544 "Position cursor designates wrong container";
1547 pragma Assert (Vet (Position), "bad cursor in function Reference");
1550 N : Node_Type renames Container.Nodes (Position.Node);
1551 TC : constant Tamper_Counts_Access :=
1552 Container.TC'Unrestricted_Access;
1554 return R : constant Reference_Type :=
1555 (Element => N.Element'Access,
1556 Control => (Controlled with TC))
1563 ---------------------
1564 -- Replace_Element --
1565 ---------------------
1567 procedure Replace_Element
1568 (Container : in out List;
1570 New_Item : Element_Type)
1573 if Checks and then Position.Container = null then
1574 raise Constraint_Error with "Position cursor has no element";
1577 if Checks and then Position.Container /= Container'Unchecked_Access then
1578 raise Program_Error with
1579 "Position cursor designates wrong container";
1582 TE_Check (Container.TC);
1584 pragma Assert (Vet (Position), "bad cursor in Replace_Element");
1586 Container.Nodes (Position.Node).Element := New_Item;
1587 end Replace_Element;
1589 ----------------------
1590 -- Reverse_Elements --
1591 ----------------------
1593 procedure Reverse_Elements (Container : in out List) is
1594 N : Node_Array renames Container.Nodes;
1595 I : Count_Type := Container.First;
1596 J : Count_Type := Container.Last;
1598 procedure Swap (L, R : Count_Type);
1604 procedure Swap (L, R : Count_Type) is
1605 LN : constant Count_Type := N (L).Next;
1606 LP : constant Count_Type := N (L).Prev;
1608 RN : constant Count_Type := N (R).Next;
1609 RP : constant Count_Type := N (R).Prev;
1624 pragma Assert (RP = L);
1638 -- Start of processing for Reverse_Elements
1641 if Container.Length <= 1 then
1645 pragma Assert (N (Container.First).Prev = 0);
1646 pragma Assert (N (Container.Last).Next = 0);
1648 TC_Check (Container.TC);
1650 Container.First := J;
1651 Container.Last := I;
1653 Swap (L => I, R => J);
1661 Swap (L => J, R => I);
1670 pragma Assert (N (Container.First).Prev = 0);
1671 pragma Assert (N (Container.Last).Next = 0);
1672 end Reverse_Elements;
1678 function Reverse_Find
1680 Item : Element_Type;
1681 Position : Cursor := No_Element) return Cursor
1683 Node : Count_Type := Position.Node;
1687 Node := Container.Last;
1690 if Checks and then Position.Container /= Container'Unrestricted_Access
1692 raise Program_Error with
1693 "Position cursor designates wrong container";
1696 pragma Assert (Vet (Position), "bad cursor in Reverse_Find");
1699 -- Per AI05-0022, the container implementation is required to detect
1700 -- element tampering by a generic actual subprogram.
1703 Lock : With_Lock (Container.TC'Unrestricted_Access);
1705 while Node /= 0 loop
1706 if Container.Nodes (Node).Element = Item then
1707 return Cursor'(Container'Unrestricted_Access, Node);
1710 Node := Container.Nodes (Node).Prev;
1717 ---------------------
1718 -- Reverse_Iterate --
1719 ---------------------
1721 procedure Reverse_Iterate
1723 Process : not null access procedure (Position : Cursor))
1725 Busy : With_Busy (Container.TC'Unrestricted_Access);
1726 Node : Count_Type := Container.Last;
1729 while Node /= 0 loop
1730 Process (Cursor'(Container'Unrestricted_Access, Node));
1731 Node := Container.Nodes (Node).Prev;
1733 end Reverse_Iterate;
1740 (Target : in out List;
1742 Source : in out List)
1745 if Before.Container /= null then
1746 if Checks and then Before.Container /= Target'Unrestricted_Access then
1747 raise Program_Error with
1748 "Before cursor designates wrong container";
1751 pragma Assert (Vet (Before), "bad cursor in Splice");
1754 if Target'Address = Source'Address or else Source.Length = 0 then
1758 if Checks and then Target.Length > Count_Type'Last - Source.Length then
1759 raise Constraint_Error with "new length exceeds maximum";
1762 if Checks and then Target.Length + Source.Length > Target.Capacity then
1763 raise Capacity_Error with "new length exceeds target capacity";
1766 TC_Check (Target.TC);
1767 TC_Check (Source.TC);
1769 Splice_Internal (Target, Before.Node, Source);
1773 (Container : in out List;
1777 N : Node_Array renames Container.Nodes;
1780 if Before.Container /= null then
1781 if Checks and then Before.Container /= Container'Unchecked_Access then
1782 raise Program_Error with
1783 "Before cursor designates wrong container";
1786 pragma Assert (Vet (Before), "bad Before cursor in Splice");
1789 if Checks and then Position.Node = 0 then
1790 raise Constraint_Error with "Position cursor has no element";
1793 if Checks and then Position.Container /= Container'Unrestricted_Access
1795 raise Program_Error with
1796 "Position cursor designates wrong container";
1799 pragma Assert (Vet (Position), "bad Position cursor in Splice");
1801 if Position.Node = Before.Node
1802 or else N (Position.Node).Next = Before.Node
1807 pragma Assert (Container.Length >= 2);
1809 TC_Check (Container.TC);
1811 if Before.Node = 0 then
1812 pragma Assert (Position.Node /= Container.Last);
1814 if Position.Node = Container.First then
1815 Container.First := N (Position.Node).Next;
1816 N (Container.First).Prev := 0;
1818 N (N (Position.Node).Prev).Next := N (Position.Node).Next;
1819 N (N (Position.Node).Next).Prev := N (Position.Node).Prev;
1822 N (Container.Last).Next := Position.Node;
1823 N (Position.Node).Prev := Container.Last;
1825 Container.Last := Position.Node;
1826 N (Container.Last).Next := 0;
1831 if Before.Node = Container.First then
1832 pragma Assert (Position.Node /= Container.First);
1834 if Position.Node = Container.Last then
1835 Container.Last := N (Position.Node).Prev;
1836 N (Container.Last).Next := 0;
1838 N (N (Position.Node).Prev).Next := N (Position.Node).Next;
1839 N (N (Position.Node).Next).Prev := N (Position.Node).Prev;
1842 N (Container.First).Prev := Position.Node;
1843 N (Position.Node).Next := Container.First;
1845 Container.First := Position.Node;
1846 N (Container.First).Prev := 0;
1851 if Position.Node = Container.First then
1852 Container.First := N (Position.Node).Next;
1853 N (Container.First).Prev := 0;
1855 elsif Position.Node = Container.Last then
1856 Container.Last := N (Position.Node).Prev;
1857 N (Container.Last).Next := 0;
1860 N (N (Position.Node).Prev).Next := N (Position.Node).Next;
1861 N (N (Position.Node).Next).Prev := N (Position.Node).Prev;
1864 N (N (Before.Node).Prev).Next := Position.Node;
1865 N (Position.Node).Prev := N (Before.Node).Prev;
1867 N (Before.Node).Prev := Position.Node;
1868 N (Position.Node).Next := Before.Node;
1870 pragma Assert (N (Container.First).Prev = 0);
1871 pragma Assert (N (Container.Last).Next = 0);
1875 (Target : in out List;
1877 Source : in out List;
1878 Position : in out Cursor)
1880 Target_Position : Count_Type;
1883 if Target'Address = Source'Address then
1884 Splice (Target, Before, Position);
1888 if Before.Container /= null then
1889 if Checks and then Before.Container /= Target'Unrestricted_Access then
1890 raise Program_Error with
1891 "Before cursor designates wrong container";
1894 pragma Assert (Vet (Before), "bad Before cursor in Splice");
1897 if Checks and then Position.Node = 0 then
1898 raise Constraint_Error with "Position cursor has no element";
1901 if Checks and then Position.Container /= Source'Unrestricted_Access then
1902 raise Program_Error with
1903 "Position cursor designates wrong container";
1906 pragma Assert (Vet (Position), "bad Position cursor in Splice");
1908 if Checks and then Target.Length >= Target.Capacity then
1909 raise Capacity_Error with "Target is full";
1912 TC_Check (Target.TC);
1913 TC_Check (Source.TC);
1917 Before => Before.Node,
1919 Src_Pos => Position.Node,
1920 Tgt_Pos => Target_Position);
1922 Position := Cursor'(Target'Unrestricted_Access, Target_Position);
1925 ---------------------
1926 -- Splice_Internal --
1927 ---------------------
1929 procedure Splice_Internal
1930 (Target : in out List;
1931 Before : Count_Type;
1932 Source : in out List)
1934 N : Node_Array renames Source.Nodes;
1938 -- This implements the corresponding Splice operation, after the
1939 -- parameters have been vetted, and corner-cases disposed of.
1941 pragma Assert (Target'Address /= Source'Address);
1942 pragma Assert (Source.Length > 0);
1943 pragma Assert (Source.First /= 0);
1944 pragma Assert (N (Source.First).Prev = 0);
1945 pragma Assert (Source.Last /= 0);
1946 pragma Assert (N (Source.Last).Next = 0);
1947 pragma Assert (Target.Length <= Count_Type'Last - Source.Length);
1948 pragma Assert (Target.Length + Source.Length <= Target.Capacity);
1950 while Source.Length > 1 loop
1951 -- Copy first element of Source onto Target
1953 Allocate (Target, N (Source.First).Element, New_Node => X);
1954 Insert_Internal (Target, Before => Before, New_Node => X);
1956 -- Unlink the first node from Source
1959 pragma Assert (N (N (X).Next).Prev = X);
1961 Source.First := N (X).Next;
1962 N (Source.First).Prev := 0;
1964 Source.Length := Source.Length - 1;
1966 -- Return the Source node to its free store
1971 -- Copy first (and only remaining) element of Source onto Target
1973 Allocate (Target, N (Source.First).Element, New_Node => X);
1974 Insert_Internal (Target, Before => Before, New_Node => X);
1976 -- Unlink the node from Source
1979 pragma Assert (X = Source.Last);
1986 -- Return the Source node to its free store
1989 end Splice_Internal;
1991 procedure Splice_Internal
1992 (Target : in out List;
1993 Before : Count_Type; -- node of Target
1994 Source : in out List;
1995 Src_Pos : Count_Type; -- node of Source
1996 Tgt_Pos : out Count_Type)
1998 N : Node_Array renames Source.Nodes;
2001 -- This implements the corresponding Splice operation, after the
2002 -- parameters have been vetted, and corner-cases handled.
2004 pragma Assert (Target'Address /= Source'Address);
2005 pragma Assert (Target.Length < Target.Capacity);
2006 pragma Assert (Source.Length > 0);
2007 pragma Assert (Source.First /= 0);
2008 pragma Assert (N (Source.First).Prev = 0);
2009 pragma Assert (Source.Last /= 0);
2010 pragma Assert (N (Source.Last).Next = 0);
2011 pragma Assert (Src_Pos /= 0);
2013 Allocate (Target, N (Src_Pos).Element, New_Node => Tgt_Pos);
2014 Insert_Internal (Target, Before => Before, New_Node => Tgt_Pos);
2016 if Source.Length = 1 then
2017 pragma Assert (Source.First = Source.Last);
2018 pragma Assert (Src_Pos = Source.First);
2023 elsif Src_Pos = Source.First then
2024 pragma Assert (N (N (Src_Pos).Next).Prev = Src_Pos);
2026 Source.First := N (Src_Pos).Next;
2027 N (Source.First).Prev := 0;
2029 elsif Src_Pos = Source.Last then
2030 pragma Assert (N (N (Src_Pos).Prev).Next = Src_Pos);
2032 Source.Last := N (Src_Pos).Prev;
2033 N (Source.Last).Next := 0;
2036 pragma Assert (Source.Length >= 3);
2037 pragma Assert (N (N (Src_Pos).Next).Prev = Src_Pos);
2038 pragma Assert (N (N (Src_Pos).Prev).Next = Src_Pos);
2040 N (N (Src_Pos).Next).Prev := N (Src_Pos).Prev;
2041 N (N (Src_Pos).Prev).Next := N (Src_Pos).Next;
2044 Source.Length := Source.Length - 1;
2045 Free (Source, Src_Pos);
2046 end Splice_Internal;
2053 (Container : in out List;
2057 if Checks and then I.Node = 0 then
2058 raise Constraint_Error with "I cursor has no element";
2061 if Checks and then J.Node = 0 then
2062 raise Constraint_Error with "J cursor has no element";
2065 if Checks and then I.Container /= Container'Unchecked_Access then
2066 raise Program_Error with "I cursor designates wrong container";
2069 if Checks and then J.Container /= Container'Unchecked_Access then
2070 raise Program_Error with "J cursor designates wrong container";
2073 if I.Node = J.Node then
2077 TE_Check (Container.TC);
2079 pragma Assert (Vet (I), "bad I cursor in Swap");
2080 pragma Assert (Vet (J), "bad J cursor in Swap");
2083 EI : Element_Type renames Container.Nodes (I.Node).Element;
2084 EJ : Element_Type renames Container.Nodes (J.Node).Element;
2086 EI_Copy : constant Element_Type := EI;
2098 procedure Swap_Links
2099 (Container : in out List;
2103 if Checks and then I.Node = 0 then
2104 raise Constraint_Error with "I cursor has no element";
2107 if Checks and then J.Node = 0 then
2108 raise Constraint_Error with "J cursor has no element";
2111 if Checks and then I.Container /= Container'Unrestricted_Access then
2112 raise Program_Error with "I cursor designates wrong container";
2115 if Checks and then J.Container /= Container'Unrestricted_Access then
2116 raise Program_Error with "J cursor designates wrong container";
2119 if I.Node = J.Node then
2123 TC_Check (Container.TC);
2125 pragma Assert (Vet (I), "bad I cursor in Swap_Links");
2126 pragma Assert (Vet (J), "bad J cursor in Swap_Links");
2129 I_Next : constant Cursor := Next (I);
2133 Splice (Container, Before => I, Position => J);
2137 J_Next : constant Cursor := Next (J);
2141 Splice (Container, Before => J, Position => I);
2144 pragma Assert (Container.Length >= 3);
2146 Splice (Container, Before => I_Next, Position => J);
2147 Splice (Container, Before => J_Next, Position => I);
2154 --------------------
2155 -- Update_Element --
2156 --------------------
2158 procedure Update_Element
2159 (Container : in out List;
2161 Process : not null access procedure (Element : in out Element_Type))
2164 if Checks and then Position.Node = 0 then
2165 raise Constraint_Error with "Position cursor has no element";
2168 if Checks and then Position.Container /= Container'Unchecked_Access then
2169 raise Program_Error with
2170 "Position cursor designates wrong container";
2173 pragma Assert (Vet (Position), "bad cursor in Update_Element");
2176 Lock : With_Lock (Container.TC'Unchecked_Access);
2177 N : Node_Type renames Container.Nodes (Position.Node);
2179 Process (N.Element);
2187 function Vet (Position : Cursor) return Boolean is
2189 if Position.Node = 0 then
2190 return Position.Container = null;
2193 if Position.Container = null then
2198 L : List renames Position.Container.all;
2199 N : Node_Array renames L.Nodes;
2202 if L.Length = 0 then
2206 if L.First = 0 or L.First > L.Capacity then
2210 if L.Last = 0 or L.Last > L.Capacity then
2214 if N (L.First).Prev /= 0 then
2218 if N (L.Last).Next /= 0 then
2222 if Position.Node > L.Capacity then
2226 -- An invariant of an active node is that its Previous and Next
2227 -- components are non-negative. Operation Free sets the Previous
2228 -- component of the node to the value -1 before actually deallocating
2229 -- the node, to mark the node as inactive. (By "dellocating" we mean
2230 -- only that the node is linked onto a list of inactive nodes used
2231 -- for storage.) This marker gives us a simple way to detect a
2232 -- dangling reference to a node.
2234 if N (Position.Node).Prev < 0 then -- see Free
2238 if N (Position.Node).Prev > L.Capacity then
2242 if N (Position.Node).Next = Position.Node then
2246 if N (Position.Node).Prev = Position.Node then
2250 if N (Position.Node).Prev = 0
2251 and then Position.Node /= L.First
2256 pragma Assert (N (Position.Node).Prev /= 0
2257 or else Position.Node = L.First);
2259 if N (Position.Node).Next = 0
2260 and then Position.Node /= L.Last
2265 pragma Assert (N (Position.Node).Next /= 0
2266 or else Position.Node = L.Last);
2268 if L.Length = 1 then
2269 return L.First = L.Last;
2272 if L.First = L.Last then
2276 if N (L.First).Next = 0 then
2280 if N (L.Last).Prev = 0 then
2284 if N (N (L.First).Next).Prev /= L.First then
2288 if N (N (L.Last).Prev).Next /= L.Last then
2292 if L.Length = 2 then
2293 if N (L.First).Next /= L.Last then
2297 if N (L.Last).Prev /= L.First then
2304 if N (L.First).Next = L.Last then
2308 if N (L.Last).Prev = L.First then
2312 -- Eliminate earlier possibility
2314 if Position.Node = L.First then
2318 pragma Assert (N (Position.Node).Prev /= 0);
2320 -- Eliminate another possibility
2322 if Position.Node = L.Last then
2326 pragma Assert (N (Position.Node).Next /= 0);
2328 if N (N (Position.Node).Next).Prev /= Position.Node then
2332 if N (N (Position.Node).Prev).Next /= Position.Node then
2336 if L.Length = 3 then
2337 if N (L.First).Next /= Position.Node then
2341 if N (L.Last).Prev /= Position.Node then
2355 (Stream : not null access Root_Stream_Type'Class;
2361 Count_Type'Base'Write (Stream, Item.Length);
2364 while Node /= 0 loop
2365 Element_Type'Write (Stream, Item.Nodes (Node).Element);
2366 Node := Item.Nodes (Node).Next;
2371 (Stream : not null access Root_Stream_Type'Class;
2375 raise Program_Error with "attempt to stream list cursor";
2379 (Stream : not null access Root_Stream_Type'Class;
2380 Item : Reference_Type)
2383 raise Program_Error with "attempt to stream reference";
2387 (Stream : not null access Root_Stream_Type'Class;
2388 Item : Constant_Reference_Type)
2391 raise Program_Error with "attempt to stream reference";
2394 end Ada.Containers.Bounded_Doubly_Linked_Lists;