1 ------------------------------------------------------------------------------
3 -- GNAT LIBRARY COMPONENTS --
5 -- A D A . C O N T A I N E R S . B O U N D E D _ V E C T O R S --
9 -- Copyright (C) 2004-2024, 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 Ada
.Containers
.Generic_Array_Sort
;
32 with System
; use type System
.Address
;
33 with System
.Put_Images
;
35 package body Ada
.Containers
.Bounded_Vectors
is
37 pragma Warnings
(Off
, "variable ""Busy*"" is not referenced");
38 pragma Warnings
(Off
, "variable ""Lock*"" is not referenced");
39 -- See comment in Ada.Containers.Helpers
41 -----------------------
42 -- Local Subprograms --
43 -----------------------
45 function To_Array_Index
(Index
: Index_Type
'Base) return Count_Type
'Base;
51 function "&" (Left
, Right
: Vector
) return Vector
is
52 LN
: constant Count_Type
:= Length
(Left
);
53 RN
: constant Count_Type
:= Length
(Right
);
54 N
: Count_Type
'Base; -- length of result
55 J
: Count_Type
'Base; -- for computing intermediate index values
56 Last
: Index_Type
'Base; -- Last index of result
59 -- We decide that the capacity of the result is the sum of the lengths
60 -- of the vector parameters. We could decide to make it larger, but we
61 -- have no basis for knowing how much larger, so we just allocate the
62 -- minimum amount of storage.
64 -- Here we handle the easy cases first, when one of the vector
65 -- parameters is empty. (We say "easy" because there's nothing to
66 -- compute, that can potentially overflow.)
73 return Vector
'(Capacity => RN,
74 Elements => Right.Elements (1 .. RN),
80 return Vector'(Capacity
=> LN
,
81 Elements
=> Left
.Elements
(1 .. LN
),
86 -- Neither of the vector parameters is empty, so must compute the length
87 -- of the result vector and its last index. (This is the harder case,
88 -- because our computations must avoid overflow.)
90 -- There are two constraints we need to satisfy. The first constraint is
91 -- that a container cannot have more than Count_Type'Last elements, so
92 -- we must check the sum of the combined lengths. Note that we cannot
93 -- simply add the lengths, because of the possibility of overflow.
95 if Checks
and then LN
> Count_Type
'Last - RN
then
96 raise Constraint_Error
with "new length is out of range";
99 -- It is now safe to compute the length of the new vector, without fear
104 -- The second constraint is that the new Last index value cannot
105 -- exceed Index_Type'Last. We use the wider of Index_Type'Base and
106 -- Count_Type'Base as the type for intermediate values.
108 if Index_Type
'Base'Last >= Count_Type'Pos (Count_Type'Last) then
110 -- We perform a two-part test. First we determine whether the
111 -- computed Last value lies in the base range of the type, and then
112 -- determine whether it lies in the range of the index (sub)type.
114 -- Last must satisfy this relation:
115 -- First + Length - 1 <= Last
117 -- First - 1 <= Last - Length
118 -- Which can rewrite as:
119 -- No_Index <= Last - Length
122 Index_Type'Base'Last
- Index_Type
'Base (N
) < No_Index
124 raise Constraint_Error
with "new length is out of range";
127 -- We now know that the computed value of Last is within the base
128 -- range of the type, so it is safe to compute its value:
130 Last
:= No_Index
+ Index_Type
'Base (N
);
132 -- Finally we test whether the value is within the range of the
133 -- generic actual index subtype:
135 if Checks
and then Last
> Index_Type
'Last then
136 raise Constraint_Error
with "new length is out of range";
139 elsif Index_Type
'First <= 0 then
141 -- Here we can compute Last directly, in the normal way. We know that
142 -- No_Index is less than 0, so there is no danger of overflow when
143 -- adding the (positive) value of length.
145 J
:= Count_Type
'Base (No_Index
) + N
; -- Last
147 if Checks
and then J
> Count_Type
'Base (Index_Type
'Last) then
148 raise Constraint_Error
with "new length is out of range";
151 -- We know that the computed value (having type Count_Type) of Last
152 -- is within the range of the generic actual index subtype, so it is
153 -- safe to convert to Index_Type:
155 Last
:= Index_Type
'Base (J
);
158 -- Here Index_Type'First (and Index_Type'Last) is positive, so we
159 -- must test the length indirectly (by working backwards from the
160 -- largest possible value of Last), in order to prevent overflow.
162 J
:= Count_Type
'Base (Index_Type
'Last) - N
; -- No_Index
164 if Checks
and then J
< Count_Type
'Base (No_Index
) then
165 raise Constraint_Error
with "new length is out of range";
168 -- We have determined that the result length would not create a Last
169 -- index value outside of the range of Index_Type, so we can now
170 -- safely compute its value.
172 Last
:= Index_Type
'Base (Count_Type
'Base (No_Index
) + N
);
176 LE
: Elements_Array
renames Left
.Elements
(1 .. LN
);
177 RE
: Elements_Array
renames Right
.Elements
(1 .. RN
);
180 return Vector
'(Capacity => N,
187 function "&" (Left : Vector; Right : Element_Type) return Vector is
188 LN : constant Count_Type := Length (Left);
191 -- We decide that the capacity of the result is the sum of the lengths
192 -- of the parameters. We could decide to make it larger, but we have no
193 -- basis for knowing how much larger, so we just allocate the minimum
194 -- amount of storage.
196 -- We must compute the length of the result vector and its last index,
197 -- but in such a way that overflow is avoided. We must satisfy two
198 -- constraints: the new length cannot exceed Count_Type'Last, and the
199 -- new Last index cannot exceed Index_Type'Last.
201 if Checks and then LN = Count_Type'Last then
202 raise Constraint_Error with "new length is out of range";
205 if Checks and then Left.Last >= Index_Type'Last then
206 raise Constraint_Error with "new length is out of range";
209 return Vector'(Capacity
=> LN
+ 1,
210 Elements
=> Left
.Elements
(1 .. LN
) & Right
,
211 Last
=> Left
.Last
+ 1,
215 function "&" (Left
: Element_Type
; Right
: Vector
) return Vector
is
216 RN
: constant Count_Type
:= Length
(Right
);
219 -- We decide that the capacity of the result is the sum of the lengths
220 -- of the parameters. We could decide to make it larger, but we have no
221 -- basis for knowing how much larger, so we just allocate the minimum
222 -- amount of storage.
224 -- We compute the length of the result vector and its last index, but in
225 -- such a way that overflow is avoided. We must satisfy two constraints:
226 -- the new length cannot exceed Count_Type'Last, and the new Last index
227 -- cannot exceed Index_Type'Last.
229 if Checks
and then RN
= Count_Type
'Last then
230 raise Constraint_Error
with "new length is out of range";
233 if Checks
and then Right
.Last
>= Index_Type
'Last then
234 raise Constraint_Error
with "new length is out of range";
237 return Vector
'(Capacity => 1 + RN,
238 Elements => Left & Right.Elements (1 .. RN),
239 Last => Right.Last + 1,
243 function "&" (Left, Right : Element_Type) return Vector is
245 -- We decide that the capacity of the result is the sum of the lengths
246 -- of the parameters. We could decide to make it larger, but we have no
247 -- basis for knowing how much larger, so we just allocate the minimum
248 -- amount of storage.
250 -- We must compute the length of the result vector and its last index,
251 -- but in such a way that overflow is avoided. We must satisfy two
252 -- constraints: the new length cannot exceed Count_Type'Last (here, we
253 -- know that that condition is satisfied), and the new Last index cannot
254 -- exceed Index_Type'Last.
256 if Checks and then Index_Type'First >= Index_Type'Last then
257 raise Constraint_Error with "new length is out of range";
260 return Vector'(Capacity
=> 2,
261 Elements
=> [Left
, Right
],
262 Last
=> Index_Type
'First + 1,
270 overriding
function "=" (Left
, Right
: Vector
) return Boolean is
272 if Left
.Last
/= Right
.Last
then
276 if Left
.Length
= 0 then
281 -- Per AI05-0022, the container implementation is required to detect
282 -- element tampering by a generic actual subprogram.
284 Lock_Left
: With_Lock
(Left
.TC
'Unrestricted_Access);
285 Lock_Right
: With_Lock
(Right
.TC
'Unrestricted_Access);
287 for J
in Count_Type
range 1 .. Left
.Length
loop
288 if Left
.Elements
(J
) /= Right
.Elements
(J
) then
301 procedure Assign
(Target
: in out Vector
; Source
: Vector
) is
303 if Target
'Address = Source
'Address then
307 if Checks
and then Target
.Capacity
< Source
.Length
then
308 raise Capacity_Error
-- ???
309 with "Target capacity is less than Source length";
314 Target
.Elements
(1 .. Source
.Length
) :=
315 Source
.Elements
(1 .. Source
.Length
);
317 Target
.Last
:= Source
.Last
;
325 (Container
: in out Vector
;
326 New_Item
: Element_Type
;
334 if Checks
and then Container
.Last
>= Index_Type
'Last then
335 raise Constraint_Error
with "vector is already at its maximum length";
338 Container
.Insert
(Container
.Last
+ 1, New_Item
, Count
);
345 procedure Append_Vector
(Container
: in out Vector
; New_Item
: Vector
) is
347 if New_Item
.Is_Empty
then
351 if Checks
and then Container
.Last
>= Index_Type
'Last then
352 raise Constraint_Error
with "vector is already at its maximum length";
355 Container
.Insert_Vector
(Container
.Last
+ 1, New_Item
);
362 procedure Append
(Container
: in out Vector
;
363 New_Item
: Element_Type
)
366 Insert
(Container
, Last_Index
(Container
) + 1, New_Item
, 1);
373 function Capacity
(Container
: Vector
) return Count_Type
is
375 return Container
.Elements
'Length;
382 procedure Clear
(Container
: in out Vector
) is
384 TC_Check
(Container
.TC
);
386 Container
.Last
:= No_Index
;
389 ------------------------
390 -- Constant_Reference --
391 ------------------------
393 function Constant_Reference
394 (Container
: aliased Vector
;
395 Position
: Cursor
) return Constant_Reference_Type
398 if Checks
and then Position
.Container
= null then
399 raise Constraint_Error
with "Position cursor has no element";
402 if Checks
and then Position
.Container
/= Container
'Unrestricted_Access
404 raise Program_Error
with "Position cursor denotes wrong container";
407 if Checks
and then Position
.Index
> Position
.Container
.Last
then
408 raise Constraint_Error
with "Position cursor is out of range";
412 A
: Elements_Array
renames Container
.Elements
;
413 J
: constant Count_Type
:= To_Array_Index
(Position
.Index
);
414 TC
: constant Tamper_Counts_Access
:=
415 Container
.TC
'Unrestricted_Access;
417 return R
: constant Constant_Reference_Type
:=
418 (Element
=> A
(J
)'Unchecked_Access,
419 Control
=> (Controlled
with TC
))
424 end Constant_Reference
;
426 function Constant_Reference
427 (Container
: aliased Vector
;
428 Index
: Index_Type
) return Constant_Reference_Type
431 if Checks
and then Index
> Container
.Last
then
432 raise Constraint_Error
with "Index is out of range";
436 A
: Elements_Array
renames Container
.Elements
;
437 J
: constant Count_Type
:= To_Array_Index
(Index
);
438 TC
: constant Tamper_Counts_Access
:=
439 Container
.TC
'Unrestricted_Access;
441 return R
: constant Constant_Reference_Type
:=
442 (Element
=> A
(J
)'Unchecked_Access,
443 Control
=> (Controlled
with TC
))
448 end Constant_Reference
;
456 Item
: Element_Type
) return Boolean
459 return Find_Index
(Container
, Item
) /= No_Index
;
468 Capacity
: Count_Type
:= 0) return Vector
470 C
: constant Count_Type
:=
471 (if Capacity
= 0 then Source
.Length
474 if Checks
and then C
< Source
.Length
then
475 raise Capacity_Error
with "Capacity too small";
478 return Target
: Vector
(C
) do
479 Target
.Elements
(1 .. Source
.Length
) :=
480 Source
.Elements
(1 .. Source
.Length
);
482 Target
.Last
:= Source
.Last
;
491 (Container
: in out Vector
;
492 Index
: Extended_Index
;
493 Count
: Count_Type
:= 1)
495 Old_Last
: constant Index_Type
'Base := Container
.Last
;
496 Old_Len
: constant Count_Type
:= Container
.Length
;
497 New_Last
: Index_Type
'Base;
498 Count2
: Count_Type
'Base; -- count of items from Index to Old_Last
499 Off
: Count_Type
'Base; -- Index expressed as offset from IT'First
502 TC_Check
(Container
.TC
);
504 -- Delete removes items from the vector, the number of which is the
505 -- minimum of the specified Count and the items (if any) that exist from
506 -- Index to Container.Last. There are no constraints on the specified
507 -- value of Count (it can be larger than what's available at this
508 -- position in the vector, for example), but there are constraints on
509 -- the allowed values of the Index.
511 -- As a precondition on the generic actual Index_Type, the base type
512 -- must include Index_Type'Pred (Index_Type'First); this is the value
513 -- that Container.Last assumes when the vector is empty. However, we do
514 -- not allow that as the value for Index when specifying which items
515 -- should be deleted, so we must manually check. (That the user is
516 -- allowed to specify the value at all here is a consequence of the
517 -- declaration of the Extended_Index subtype, which includes the values
518 -- in the base range that immediately precede and immediately follow the
519 -- values in the Index_Type.)
521 if Checks
and then Index
< Index_Type
'First then
522 raise Constraint_Error
with "Index is out of range (too small)";
525 -- We do allow a value greater than Container.Last to be specified as
526 -- the Index, but only if it's immediately greater. This allows the
527 -- corner case of deleting no items from the back end of the vector to
528 -- be treated as a no-op. (It is assumed that specifying an index value
529 -- greater than Last + 1 indicates some deeper flaw in the caller's
530 -- algorithm, so that case is treated as a proper error.)
532 if Index
> Old_Last
then
533 if Checks
and then Index
> Old_Last
+ 1 then
534 raise Constraint_Error
with "Index is out of range (too large)";
540 -- Here and elsewhere we treat deleting 0 items from the container as a
541 -- no-op, even when the container is busy, so we simply return.
547 -- The tampering bits exist to prevent an item from being deleted (or
548 -- otherwise harmfully manipulated) while it is being visited. Query,
549 -- Update, and Iterate increment the busy count on entry, and decrement
550 -- the count on exit. Delete checks the count to determine whether it is
551 -- being called while the associated callback procedure is executing.
553 -- We first calculate what's available for deletion starting at
554 -- Index. Here and elsewhere we use the wider of Index_Type'Base and
555 -- Count_Type'Base as the type for intermediate values. (See function
556 -- Length for more information.)
558 if Count_Type
'Base'Last >= Index_Type'Pos (Index_Type'Base'Last
) then
559 Count2
:= Count_Type
'Base (Old_Last
) - Count_Type
'Base (Index
) + 1;
561 Count2
:= Count_Type
'Base (Old_Last
- Index
+ 1);
564 -- If more elements are requested (Count) for deletion than are
565 -- available (Count2) for deletion beginning at Index, then everything
566 -- from Index is deleted. There are no elements to slide down, and so
567 -- all we need to do is set the value of Container.Last.
569 if Count
>= Count2
then
570 Container
.Last
:= Index
- 1;
574 -- There are some elements aren't being deleted (the requested count was
575 -- less than the available count), so we must slide them down to
576 -- Index. We first calculate the index values of the respective array
577 -- slices, using the wider of Index_Type'Base and Count_Type'Base as the
578 -- type for intermediate calculations.
580 if Index_Type
'Base'Last >= Count_Type'Pos (Count_Type'Last) then
581 Off := Count_Type'Base (Index - Index_Type'First);
582 New_Last := Old_Last - Index_Type'Base (Count);
584 Off := Count_Type'Base (Index) - Count_Type'Base (Index_Type'First);
585 New_Last := Index_Type'Base (Count_Type'Base (Old_Last) - Count);
588 -- The array index values for each slice have already been determined,
589 -- so we just slide down to Index the elements that weren't deleted.
592 EA : Elements_Array renames Container.Elements;
593 Idx : constant Count_Type := EA'First + Off;
595 EA (Idx .. Old_Len - Count) := EA (Idx + Count .. Old_Len);
596 Container.Last := New_Last;
601 (Container : in out Vector;
602 Position : in out Cursor;
603 Count : Count_Type := 1)
605 pragma Warnings (Off, Position);
608 if Checks and then Position.Container = null then
609 raise Constraint_Error with "Position cursor has no element";
612 if Checks and then Position.Container /= Container'Unrestricted_Access
614 raise Program_Error with "Position cursor denotes wrong container";
617 if Checks and then Position.Index > Container.Last then
618 raise Program_Error with "Position index is out of range";
621 Delete (Container, Position.Index, Count);
622 Position := No_Element;
629 procedure Delete_First
630 (Container : in out Vector;
631 Count : Count_Type := 1)
637 elsif Count >= Length (Container) then
642 Delete (Container, Index_Type'First, Count);
650 procedure Delete_Last
651 (Container : in out Vector;
652 Count : Count_Type := 1)
655 -- The tampering bits exist to prevent an item from being deleted (or
656 -- otherwise harmfully manipulated) while it is being visited. Query,
657 -- Update, and Iterate increment the busy count on entry, and decrement
658 -- the count on exit. Delete_Last checks the count to determine whether
659 -- it is being called while the associated callback procedure is
662 TC_Check (Container.TC);
668 -- There is no restriction on how large Count can be when deleting
669 -- items. If it is equal or greater than the current length, then this
670 -- is equivalent to clearing the vector. (In particular, there's no need
671 -- for us to actually calculate the new value for Last.)
673 -- If the requested count is less than the current length, then we must
674 -- calculate the new value for Last. For the type we use the widest of
675 -- Index_Type'Base and Count_Type'Base for the intermediate values of
676 -- our calculation. (See the comments in Length for more information.)
678 if Count >= Container.Length then
679 Container.Last := No_Index;
681 elsif Index_Type'Base'Last
>= Count_Type
'Pos (Count_Type
'Last) then
682 Container
.Last
:= Container
.Last
- Index_Type
'Base (Count
);
686 Index_Type
'Base (Count_Type
'Base (Container
.Last
) - Count
);
696 Index
: Index_Type
) return Element_Type
699 if Checks
and then Index
> Container
.Last
then
700 raise Constraint_Error
with "Index is out of range";
702 return Container
.Elements
(To_Array_Index
(Index
));
706 function Element
(Position
: Cursor
) return Element_Type
is
708 if Checks
and then Position
.Container
= null then
709 raise Constraint_Error
with "Position cursor has no element";
711 return Position
.Container
.Element
(Position
.Index
);
719 function Empty
(Capacity
: Count_Type
:= 10) return Vector
is
721 return Result
: Vector
(Capacity
) do
722 Reserve_Capacity
(Result
, Capacity
);
730 procedure Finalize
(Object
: in out Iterator
) is
732 Unbusy
(Object
.Container
.TC
);
742 Position
: Cursor
:= No_Element
) return Cursor
745 if Position
.Container
/= null then
746 if Checks
and then Position
.Container
/= Container
'Unrestricted_Access
748 raise Program_Error
with "Position cursor denotes wrong container";
751 if Checks
and then Position
.Index
> Container
.Last
then
752 raise Program_Error
with "Position index is out of range";
756 -- Per AI05-0022, the container implementation is required to detect
757 -- element tampering by a generic actual subprogram.
760 Lock
: With_Lock
(Container
.TC
'Unrestricted_Access);
762 for J
in Position
.Index
.. Container
.Last
loop
763 if Container
.Elements
(To_Array_Index
(J
)) = Item
then
764 return Cursor
'(Container'Unrestricted_Access, J);
779 Index : Index_Type := Index_Type'First) return Extended_Index
781 -- Per AI05-0022, the container implementation is required to detect
782 -- element tampering by a generic actual subprogram.
784 Lock : With_Lock (Container.TC'Unrestricted_Access);
786 for Indx in Index .. Container.Last loop
787 if Container.Elements (To_Array_Index (Indx)) = Item then
799 function First (Container : Vector) return Cursor is
801 if Is_Empty (Container) then
804 return (Container'Unrestricted_Access, Index_Type'First);
808 function First (Object : Iterator) return Cursor is
810 -- The value of the iterator object's Index component influences the
811 -- behavior of the First (and Last) selector function.
813 -- When the Index component is No_Index, this means the iterator
814 -- object was constructed without a start expression, in which case the
815 -- (forward) iteration starts from the (logical) beginning of the entire
816 -- sequence of items (corresponding to Container.First, for a forward
819 -- Otherwise, this is iteration over a partial sequence of items.
820 -- When the Index component isn't No_Index, the iterator object was
821 -- constructed with a start expression, that specifies the position
822 -- from which the (forward) partial iteration begins.
824 if Object.Index = No_Index then
825 return First (Object.Container.all);
827 return Cursor'(Object
.Container
, Object
.Index
);
835 function First_Element
(Container
: Vector
) return Element_Type
is
837 if Checks
and then Container
.Last
= No_Index
then
838 raise Constraint_Error
with "Container is empty";
841 return Container
.Elements
(To_Array_Index
(Index_Type
'First));
848 function First_Index
(Container
: Vector
) return Index_Type
is
849 pragma Unreferenced
(Container
);
851 return Index_Type
'First;
858 function New_Vector
(First
, Last
: Index_Type
) return Vector
861 return (To_Vector
(Count_Type
(Last
- First
+ 1)));
864 ---------------------
865 -- Generic_Sorting --
866 ---------------------
868 package body Generic_Sorting
is
874 function Is_Sorted
(Container
: Vector
) return Boolean is
876 if Container
.Last
<= Index_Type
'First then
880 -- Per AI05-0022, the container implementation is required to detect
881 -- element tampering by a generic actual subprogram.
884 Lock
: With_Lock
(Container
.TC
'Unrestricted_Access);
885 EA
: Elements_Array
renames Container
.Elements
;
887 for J
in 1 .. Container
.Length
- 1 loop
888 if EA
(J
+ 1) < EA
(J
) then
901 procedure Merge
(Target
, Source
: in out Vector
) is
905 -- The semantics of Merge changed slightly per AI05-0021. It was
906 -- originally the case that if Target and Source denoted the same
907 -- container object, then the GNAT implementation of Merge did
908 -- nothing. However, it was argued that RM05 did not precisely
909 -- specify the semantics for this corner case. The decision of the
910 -- ARG was that if Target and Source denote the same non-empty
911 -- container object, then Program_Error is raised.
913 if Source
.Is_Empty
then
917 TC_Check
(Source
.TC
);
919 if Checks
and then Target
'Address = Source
'Address then
920 raise Program_Error
with
921 "Target and Source denote same non-empty container";
924 if Target
.Is_Empty
then
925 Move
(Target
=> Target
, Source
=> Source
);
930 Target
.Set_Length
(I
+ Source
.Length
);
932 -- Per AI05-0022, the container implementation is required to detect
933 -- element tampering by a generic actual subprogram.
936 TA
: Elements_Array
renames Target
.Elements
;
937 SA
: Elements_Array
renames Source
.Elements
;
939 Lock_Target
: With_Lock
(Target
.TC
'Unchecked_Access);
940 Lock_Source
: With_Lock
(Source
.TC
'Unchecked_Access);
943 while not Source
.Is_Empty
loop
944 pragma Assert
(Source
.Length
<= 1
945 or else not (SA
(Source
.Length
) < SA
(Source
.Length
- 1)));
948 TA
(1 .. J
) := SA
(1 .. Source
.Length
);
949 Source
.Last
:= No_Index
;
953 pragma Assert
(I
<= 1
954 or else not (TA
(I
) < TA
(I
- 1)));
956 if SA
(Source
.Length
) < TA
(I
) then
961 TA
(J
) := SA
(Source
.Length
);
962 Source
.Last
:= Source
.Last
- 1;
974 procedure Sort
(Container
: in out Vector
) is
976 new Generic_Array_Sort
977 (Index_Type
=> Count_Type
,
978 Element_Type
=> Element_Type
,
979 Array_Type
=> Elements_Array
,
983 if Container
.Last
<= Index_Type
'First then
987 -- The exception behavior for the vector container must match that
988 -- for the list container, so we check for cursor tampering here
989 -- (which will catch more things) instead of for element tampering
990 -- (which will catch fewer things). It's true that the elements of
991 -- this vector container could be safely moved around while (say) an
992 -- iteration is taking place (iteration only increments the busy
993 -- counter), and so technically all we would need here is a test for
994 -- element tampering (indicated by the lock counter), that's simply
995 -- an artifact of our array-based implementation. Logically Sort
996 -- requires a check for cursor tampering.
998 TC_Check
(Container
.TC
);
1000 -- Per AI05-0022, the container implementation is required to detect
1001 -- element tampering by a generic actual subprogram.
1004 Lock
: With_Lock
(Container
.TC
'Unchecked_Access);
1006 Sort
(Container
.Elements
(1 .. Container
.Length
));
1010 end Generic_Sorting
;
1012 ------------------------
1013 -- Get_Element_Access --
1014 ------------------------
1016 function Get_Element_Access
1017 (Position
: Cursor
) return not null Element_Access
is
1019 return Position
.Container
.Elements
1020 (To_Array_Index
(Position
.Index
))'Access;
1021 end Get_Element_Access
;
1027 function Has_Element
(Position
: Cursor
) return Boolean is
1029 if Position
.Container
= null then
1033 return Position
.Index
<= Position
.Container
.Last
;
1041 (Container
: in out Vector
;
1042 Before
: Extended_Index
;
1043 New_Item
: Element_Type
;
1044 Count
: Count_Type
:= 1)
1046 EA
: Elements_Array
renames Container
.Elements
;
1047 Old_Length
: constant Count_Type
:= Container
.Length
;
1049 Max_Length
: Count_Type
'Base; -- determined from range of Index_Type
1050 New_Length
: Count_Type
'Base; -- sum of current length and Count
1052 Index
: Index_Type
'Base; -- scratch for intermediate values
1053 J
: Count_Type
'Base; -- scratch
1056 -- The tampering bits exist to prevent an item from being harmfully
1057 -- manipulated while it is being visited. Query, Update, and Iterate
1058 -- increment the busy count on entry, and decrement the count on
1059 -- exit. Insert checks the count to determine whether it is being called
1060 -- while the associated callback procedure is executing.
1062 TC_Check
(Container
.TC
);
1064 -- As a precondition on the generic actual Index_Type, the base type
1065 -- must include Index_Type'Pred (Index_Type'First); this is the value
1066 -- that Container.Last assumes when the vector is empty. However, we do
1067 -- not allow that as the value for Index when specifying where the new
1068 -- items should be inserted, so we must manually check. (That the user
1069 -- is allowed to specify the value at all here is a consequence of the
1070 -- declaration of the Extended_Index subtype, which includes the values
1071 -- in the base range that immediately precede and immediately follow the
1072 -- values in the Index_Type.)
1074 if Checks
and then Before
< Index_Type
'First then
1075 raise Constraint_Error
with
1076 "Before index is out of range (too small)";
1079 -- We do allow a value greater than Container.Last to be specified as
1080 -- the Index, but only if it's immediately greater. This allows for the
1081 -- case of appending items to the back end of the vector. (It is assumed
1082 -- that specifying an index value greater than Last + 1 indicates some
1083 -- deeper flaw in the caller's algorithm, so that case is treated as a
1086 if Checks
and then Before
> Container
.Last
1087 and then Before
> Container
.Last
+ 1
1089 raise Constraint_Error
with
1090 "Before index is out of range (too large)";
1093 -- We treat inserting 0 items into the container as a no-op, even when
1094 -- the container is busy, so we simply return.
1100 -- There are two constraints we need to satisfy. The first constraint is
1101 -- that a container cannot have more than Count_Type'Last elements, so
1102 -- we must check the sum of the current length and the insertion
1103 -- count. Note that we cannot simply add these values, because of the
1104 -- possibility of overflow.
1106 if Checks
and then Old_Length
> Count_Type
'Last - Count
then
1107 raise Constraint_Error
with "Count is out of range";
1110 -- It is now safe compute the length of the new vector, without fear of
1113 New_Length
:= Old_Length
+ Count
;
1115 -- The second constraint is that the new Last index value cannot exceed
1116 -- Index_Type'Last. In each branch below, we calculate the maximum
1117 -- length (computed from the range of values in Index_Type), and then
1118 -- compare the new length to the maximum length. If the new length is
1119 -- acceptable, then we compute the new last index from that.
1121 if Index_Type
'Base'Last >= Count_Type'Pos (Count_Type'Last) then
1123 -- We have to handle the case when there might be more values in the
1124 -- range of Index_Type than in the range of Count_Type.
1126 if Index_Type'First <= 0 then
1128 -- We know that No_Index (the same as Index_Type'First - 1) is
1129 -- less than 0, so it is safe to compute the following sum without
1130 -- fear of overflow.
1132 Index := No_Index + Index_Type'Base (Count_Type'Last);
1134 if Index <= Index_Type'Last then
1136 -- We have determined that range of Index_Type has at least as
1137 -- many values as in Count_Type, so Count_Type'Last is the
1138 -- maximum number of items that are allowed.
1140 Max_Length := Count_Type'Last;
1143 -- The range of Index_Type has fewer values than in Count_Type,
1144 -- so the maximum number of items is computed from the range of
1147 Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
1151 -- No_Index is equal or greater than 0, so we can safely compute
1152 -- the difference without fear of overflow (which we would have to
1153 -- worry about if No_Index were less than 0, but that case is
1156 if Index_Type'Last - No_Index >=
1157 Count_Type'Pos (Count_Type'Last)
1159 -- We have determined that range of Index_Type has at least as
1160 -- many values as in Count_Type, so Count_Type'Last is the
1161 -- maximum number of items that are allowed.
1163 Max_Length := Count_Type'Last;
1166 -- The range of Index_Type has fewer values than in Count_Type,
1167 -- so the maximum number of items is computed from the range of
1170 Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
1174 elsif Index_Type'First <= 0 then
1176 -- We know that No_Index (the same as Index_Type'First - 1) is less
1177 -- than 0, so it is safe to compute the following sum without fear of
1180 J := Count_Type'Base (No_Index) + Count_Type'Last;
1182 if J <= Count_Type'Base (Index_Type'Last) then
1184 -- We have determined that range of Index_Type has at least as
1185 -- many values as in Count_Type, so Count_Type'Last is the maximum
1186 -- number of items that are allowed.
1188 Max_Length := Count_Type'Last;
1191 -- The range of Index_Type has fewer values than Count_Type does,
1192 -- so the maximum number of items is computed from the range of
1196 Count_Type'Base (Index_Type'Last) - Count_Type'Base (No_Index);
1200 -- No_Index is equal or greater than 0, so we can safely compute the
1201 -- difference without fear of overflow (which we would have to worry
1202 -- about if No_Index were less than 0, but that case is handled
1206 Count_Type'Base (Index_Type'Last) - Count_Type'Base (No_Index);
1209 -- We have just computed the maximum length (number of items). We must
1210 -- now compare the requested length to the maximum length, as we do not
1211 -- allow a vector expand beyond the maximum (because that would create
1212 -- an internal array with a last index value greater than
1213 -- Index_Type'Last, with no way to index those elements).
1215 if Checks and then New_Length > Max_Length then
1216 raise Constraint_Error with "Count is out of range";
1219 if Checks and then New_Length > Container.Capacity then
1220 raise Capacity_Error with "New length is larger than capacity";
1223 J := To_Array_Index (Before);
1225 if Before > Container.Last then
1227 -- The new items are being appended to the vector, so no
1228 -- sliding of existing elements is required.
1230 EA (J .. New_Length) := [others => New_Item];
1233 -- The new items are being inserted before some existing
1234 -- elements, so we must slide the existing elements up to their
1237 EA (J + Count .. New_Length) := EA (J .. Old_Length);
1238 EA (J .. J + Count - 1) := [others => New_Item];
1241 if Index_Type'Base'Last
>= Count_Type
'Pos (Count_Type
'Last) then
1242 Container
.Last
:= No_Index
+ Index_Type
'Base (New_Length
);
1246 Index_Type
'Base (Count_Type
'Base (No_Index
) + New_Length
);
1250 procedure Insert_Vector
1251 (Container
: in out Vector
;
1252 Before
: Extended_Index
;
1255 N
: constant Count_Type
:= Length
(New_Item
);
1256 B
: Count_Type
; -- index Before converted to Count_Type
1259 -- Use Insert_Space to create the "hole" (the destination slice) into
1260 -- which we copy the source items.
1262 Insert_Space
(Container
, Before
, Count
=> N
);
1265 -- There's nothing else to do here (vetting of parameters was
1266 -- performed already in Insert_Space), so we simply return.
1271 B
:= To_Array_Index
(Before
);
1273 if Container
'Address /= New_Item
'Address then
1274 -- This is the simple case. New_Item denotes an object different
1275 -- from Container, so there's nothing special we need to do to copy
1276 -- the source items to their destination, because all of the source
1277 -- items are contiguous.
1279 Container
.Elements
(B
.. B
+ N
- 1) := New_Item
.Elements
(1 .. N
);
1283 -- We refer to array index value Before + N - 1 as J. This is the last
1284 -- index value of the destination slice.
1286 -- New_Item denotes the same object as Container, so an insertion has
1287 -- potentially split the source items. The destination is always the
1288 -- range [Before, J], but the source is [Index_Type'First, Before) and
1289 -- (J, Container.Last]. We perform the copy in two steps, using each of
1290 -- the two slices of the source items.
1293 subtype Src_Index_Subtype
is Count_Type
'Base range 1 .. B
- 1;
1295 Src
: Elements_Array
renames Container
.Elements
(Src_Index_Subtype
);
1298 -- We first copy the source items that precede the space we
1299 -- inserted. (If Before equals Index_Type'First, then this first
1300 -- source slice will be empty, which is harmless.)
1302 Container
.Elements
(B
.. B
+ Src
'Length - 1) := Src
;
1306 subtype Src_Index_Subtype
is Count_Type
'Base range
1307 B
+ N
.. Container
.Length
;
1309 Src
: Elements_Array
renames Container
.Elements
(Src_Index_Subtype
);
1312 -- We next copy the source items that follow the space we inserted.
1314 Container
.Elements
(B
+ N
- Src
'Length .. B
+ N
- 1) := Src
;
1318 procedure Insert_Vector
1319 (Container
: in out Vector
;
1323 Index
: Index_Type
'Base;
1326 if Checks
and then Before
.Container
/= null
1327 and then Before
.Container
/= Container
'Unchecked_Access
1329 raise Program_Error
with "Before cursor denotes wrong container";
1332 if Is_Empty
(New_Item
) then
1336 if Before
.Container
= null
1337 or else Before
.Index
> Container
.Last
1339 if Checks
and then Container
.Last
= Index_Type
'Last then
1340 raise Constraint_Error
with
1341 "vector is already at its maximum length";
1344 Index
:= Container
.Last
+ 1;
1347 Index
:= Before
.Index
;
1350 Insert_Vector
(Container
, Index
, New_Item
);
1353 procedure Insert_Vector
1354 (Container
: in out Vector
;
1357 Position
: out Cursor
)
1359 Index
: Index_Type
'Base;
1362 if Checks
and then Before
.Container
/= null
1363 and then Before
.Container
/= Container
'Unchecked_Access
1365 raise Program_Error
with "Before cursor denotes wrong container";
1368 if Is_Empty
(New_Item
) then
1369 if Before
.Container
= null
1370 or else Before
.Index
> Container
.Last
1372 Position
:= No_Element
;
1374 Position
:= (Container
'Unchecked_Access, Before
.Index
);
1380 if Before
.Container
= null
1381 or else Before
.Index
> Container
.Last
1383 if Checks
and then Container
.Last
= Index_Type
'Last then
1384 raise Constraint_Error
with
1385 "vector is already at its maximum length";
1388 Index
:= Container
.Last
+ 1;
1391 Index
:= Before
.Index
;
1394 Insert_Vector
(Container
, Index
, New_Item
);
1396 Position
:= Cursor
'(Container'Unchecked_Access, Index);
1400 (Container : in out Vector;
1402 New_Item : Element_Type;
1403 Count : Count_Type := 1)
1405 Index : Index_Type'Base;
1408 if Checks and then Before.Container /= null
1409 and then Before.Container /= Container'Unchecked_Access
1411 raise Program_Error with "Before cursor denotes wrong container";
1418 if Before.Container = null
1419 or else Before.Index > Container.Last
1421 if Checks and then Container.Last = Index_Type'Last then
1422 raise Constraint_Error with
1423 "vector is already at its maximum length";
1426 Index := Container.Last + 1;
1429 Index := Before.Index;
1432 Insert (Container, Index, New_Item, Count);
1436 (Container : in out Vector;
1438 New_Item : Element_Type;
1439 Position : out Cursor;
1440 Count : Count_Type := 1)
1442 Index : Index_Type'Base;
1445 if Checks and then Before.Container /= null
1446 and then Before.Container /= Container'Unchecked_Access
1448 raise Program_Error with "Before cursor denotes wrong container";
1452 if Before.Container = null
1453 or else Before.Index > Container.Last
1455 Position := No_Element;
1457 Position := (Container'Unchecked_Access, Before.Index);
1463 if Before.Container = null
1464 or else Before.Index > Container.Last
1466 if Checks and then Container.Last = Index_Type'Last then
1467 raise Constraint_Error with
1468 "vector is already at its maximum length";
1471 Index := Container.Last + 1;
1474 Index := Before.Index;
1477 Insert (Container, Index, New_Item, Count);
1479 Position := Cursor'(Container
'Unchecked_Access, Index
);
1483 (Container
: in out Vector
;
1484 Before
: Extended_Index
;
1485 Count
: Count_Type
:= 1)
1487 New_Item
: Element_Type
; -- Default-initialized value
1488 pragma Warnings
(Off
, New_Item
);
1491 Insert
(Container
, Before
, New_Item
, Count
);
1495 (Container
: in out Vector
;
1497 Position
: out Cursor
;
1498 Count
: Count_Type
:= 1)
1500 New_Item
: Element_Type
; -- Default-initialized value
1501 pragma Warnings
(Off
, New_Item
);
1504 Insert
(Container
, Before
, New_Item
, Position
, Count
);
1511 procedure Insert_Space
1512 (Container
: in out Vector
;
1513 Before
: Extended_Index
;
1514 Count
: Count_Type
:= 1)
1516 EA
: Elements_Array
renames Container
.Elements
;
1517 Old_Length
: constant Count_Type
:= Container
.Length
;
1519 Max_Length
: Count_Type
'Base; -- determined from range of Index_Type
1520 New_Length
: Count_Type
'Base; -- sum of current length and Count
1522 Index
: Index_Type
'Base; -- scratch for intermediate values
1523 J
: Count_Type
'Base; -- scratch
1526 -- The tampering bits exist to prevent an item from being harmfully
1527 -- manipulated while it is being visited. Query, Update, and Iterate
1528 -- increment the busy count on entry, and decrement the count on
1529 -- exit. Insert checks the count to determine whether it is being called
1530 -- while the associated callback procedure is executing.
1532 TC_Check
(Container
.TC
);
1534 -- As a precondition on the generic actual Index_Type, the base type
1535 -- must include Index_Type'Pred (Index_Type'First); this is the value
1536 -- that Container.Last assumes when the vector is empty. However, we do
1537 -- not allow that as the value for Index when specifying where the new
1538 -- items should be inserted, so we must manually check. (That the user
1539 -- is allowed to specify the value at all here is a consequence of the
1540 -- declaration of the Extended_Index subtype, which includes the values
1541 -- in the base range that immediately precede and immediately follow the
1542 -- values in the Index_Type.)
1544 if Checks
and then Before
< Index_Type
'First then
1545 raise Constraint_Error
with
1546 "Before index is out of range (too small)";
1549 -- We do allow a value greater than Container.Last to be specified as
1550 -- the Index, but only if it's immediately greater. This allows for the
1551 -- case of appending items to the back end of the vector. (It is assumed
1552 -- that specifying an index value greater than Last + 1 indicates some
1553 -- deeper flaw in the caller's algorithm, so that case is treated as a
1556 if Checks
and then Before
> Container
.Last
1557 and then Before
> Container
.Last
+ 1
1559 raise Constraint_Error
with
1560 "Before index is out of range (too large)";
1563 -- We treat inserting 0 items into the container as a no-op, even when
1564 -- the container is busy, so we simply return.
1570 -- There are two constraints we need to satisfy. The first constraint is
1571 -- that a container cannot have more than Count_Type'Last elements, so
1572 -- we must check the sum of the current length and the insertion count.
1573 -- Note that we cannot simply add these values, because of the
1574 -- possibility of overflow.
1576 if Checks
and then Old_Length
> Count_Type
'Last - Count
then
1577 raise Constraint_Error
with "Count is out of range";
1580 -- It is now safe compute the length of the new vector, without fear of
1583 New_Length
:= Old_Length
+ Count
;
1585 -- The second constraint is that the new Last index value cannot exceed
1586 -- Index_Type'Last. In each branch below, we calculate the maximum
1587 -- length (computed from the range of values in Index_Type), and then
1588 -- compare the new length to the maximum length. If the new length is
1589 -- acceptable, then we compute the new last index from that.
1591 if Index_Type
'Base'Last >= Count_Type'Pos (Count_Type'Last) then
1593 -- We have to handle the case when there might be more values in the
1594 -- range of Index_Type than in the range of Count_Type.
1596 if Index_Type'First <= 0 then
1598 -- We know that No_Index (the same as Index_Type'First - 1) is
1599 -- less than 0, so it is safe to compute the following sum without
1600 -- fear of overflow.
1602 Index := No_Index + Index_Type'Base (Count_Type'Last);
1604 if Index <= Index_Type'Last then
1606 -- We have determined that range of Index_Type has at least as
1607 -- many values as in Count_Type, so Count_Type'Last is the
1608 -- maximum number of items that are allowed.
1610 Max_Length := Count_Type'Last;
1613 -- The range of Index_Type has fewer values than in Count_Type,
1614 -- so the maximum number of items is computed from the range of
1617 Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
1621 -- No_Index is equal or greater than 0, so we can safely compute
1622 -- the difference without fear of overflow (which we would have to
1623 -- worry about if No_Index were less than 0, but that case is
1626 if Index_Type'Last - No_Index >=
1627 Count_Type'Pos (Count_Type'Last)
1629 -- We have determined that range of Index_Type has at least as
1630 -- many values as in Count_Type, so Count_Type'Last is the
1631 -- maximum number of items that are allowed.
1633 Max_Length := Count_Type'Last;
1636 -- The range of Index_Type has fewer values than in Count_Type,
1637 -- so the maximum number of items is computed from the range of
1640 Max_Length := Count_Type'Base (Index_Type'Last - No_Index);
1644 elsif Index_Type'First <= 0 then
1646 -- We know that No_Index (the same as Index_Type'First - 1) is less
1647 -- than 0, so it is safe to compute the following sum without fear of
1650 J := Count_Type'Base (No_Index) + Count_Type'Last;
1652 if J <= Count_Type'Base (Index_Type'Last) then
1654 -- We have determined that range of Index_Type has at least as
1655 -- many values as in Count_Type, so Count_Type'Last is the maximum
1656 -- number of items that are allowed.
1658 Max_Length := Count_Type'Last;
1661 -- The range of Index_Type has fewer values than Count_Type does,
1662 -- so the maximum number of items is computed from the range of
1666 Count_Type'Base (Index_Type'Last) - Count_Type'Base (No_Index);
1670 -- No_Index is equal or greater than 0, so we can safely compute the
1671 -- difference without fear of overflow (which we would have to worry
1672 -- about if No_Index were less than 0, but that case is handled
1676 Count_Type'Base (Index_Type'Last) - Count_Type'Base (No_Index);
1679 -- We have just computed the maximum length (number of items). We must
1680 -- now compare the requested length to the maximum length, as we do not
1681 -- allow a vector expand beyond the maximum (because that would create
1682 -- an internal array with a last index value greater than
1683 -- Index_Type'Last, with no way to index those elements).
1685 if Checks and then New_Length > Max_Length then
1686 raise Constraint_Error with "Count is out of range";
1689 -- An internal array has already been allocated, so we need to check
1690 -- whether there is enough unused storage for the new items.
1692 if Checks and then New_Length > Container.Capacity then
1693 raise Capacity_Error with "New length is larger than capacity";
1696 -- In this case, we're inserting space into a vector that has already
1697 -- allocated an internal array, and the existing array has enough
1698 -- unused storage for the new items.
1700 if Before <= Container.Last then
1702 -- The space is being inserted before some existing elements,
1703 -- so we must slide the existing elements up to their new home.
1705 J := To_Array_Index (Before);
1706 EA (J + Count .. New_Length) := EA (J .. Old_Length);
1709 -- New_Last is the last index value of the items in the container after
1710 -- insertion. Use the wider of Index_Type'Base and Count_Type'Base to
1711 -- compute its value from the New_Length.
1713 if Index_Type'Base'Last
>= Count_Type
'Pos (Count_Type
'Last) then
1714 Container
.Last
:= No_Index
+ Index_Type
'Base (New_Length
);
1718 Index_Type
'Base (Count_Type
'Base (No_Index
) + New_Length
);
1722 procedure Insert_Space
1723 (Container
: in out Vector
;
1725 Position
: out Cursor
;
1726 Count
: Count_Type
:= 1)
1728 Index
: Index_Type
'Base;
1731 if Checks
and then Before
.Container
/= null
1732 and then Before
.Container
/= Container
'Unchecked_Access
1734 raise Program_Error
with "Before cursor denotes wrong container";
1738 if Before
.Container
= null
1739 or else Before
.Index
> Container
.Last
1741 Position
:= No_Element
;
1743 Position
:= (Container
'Unchecked_Access, Before
.Index
);
1749 if Before
.Container
= null
1750 or else Before
.Index
> Container
.Last
1752 if Checks
and then Container
.Last
= Index_Type
'Last then
1753 raise Constraint_Error
with
1754 "vector is already at its maximum length";
1757 Index
:= Container
.Last
+ 1;
1760 Index
:= Before
.Index
;
1763 Insert_Space
(Container
, Index
, Count
=> Count
);
1765 Position
:= Cursor
'(Container'Unchecked_Access, Index);
1772 function Is_Empty (Container : Vector) return Boolean is
1774 return Container.Last < Index_Type'First;
1782 (Container : Vector;
1783 Process : not null access procedure (Position : Cursor))
1785 Busy : With_Busy (Container.TC'Unrestricted_Access);
1787 for Indx in Index_Type'First .. Container.Last loop
1788 Process (Cursor'(Container
'Unrestricted_Access, Indx
));
1793 (Container
: Vector
)
1794 return Vector_Iterator_Interfaces
.Reversible_Iterator
'Class
1796 V
: constant Vector_Access
:= Container
'Unrestricted_Access;
1798 -- The value of its Index component influences the behavior of the First
1799 -- and Last selector functions of the iterator object. When the Index
1800 -- component is No_Index (as is the case here), this means the iterator
1801 -- object was constructed without a start expression. This is a complete
1802 -- iterator, meaning that the iteration starts from the (logical)
1803 -- beginning of the sequence of items.
1805 -- Note: For a forward iterator, Container.First is the beginning, and
1806 -- for a reverse iterator, Container.Last is the beginning.
1808 return It
: constant Iterator
:=
1809 (Limited_Controlled
with
1813 Busy
(Container
.TC
'Unrestricted_Access.all);
1818 (Container
: Vector
;
1820 return Vector_Iterator_Interfaces
.Reversible_Iterator
'Class
1822 V
: constant Vector_Access
:= Container
'Unrestricted_Access;
1824 -- It was formerly the case that when Start = No_Element, the partial
1825 -- iterator was defined to behave the same as for a complete iterator,
1826 -- and iterate over the entire sequence of items. However, those
1827 -- semantics were unintuitive and arguably error-prone (it is too easy
1828 -- to accidentally create an endless loop), and so they were changed,
1829 -- per the ARG meeting in Denver on 2011/11. However, there was no
1830 -- consensus about what positive meaning this corner case should have,
1831 -- and so it was decided to simply raise an exception. This does imply,
1832 -- however, that it is not possible to use a partial iterator to specify
1833 -- an empty sequence of items.
1835 if Checks
and then Start
.Container
= null then
1836 raise Constraint_Error
with
1837 "Start position for iterator equals No_Element";
1840 if Checks
and then Start
.Container
/= V
then
1841 raise Program_Error
with
1842 "Start cursor of Iterate designates wrong vector";
1845 if Checks
and then Start
.Index
> V
.Last
then
1846 raise Constraint_Error
with
1847 "Start position for iterator equals No_Element";
1850 -- The value of its Index component influences the behavior of the First
1851 -- and Last selector functions of the iterator object. When the Index
1852 -- component is not No_Index (as is the case here), it means that this
1853 -- is a partial iteration, over a subset of the complete sequence of
1854 -- items. The iterator object was constructed with a start expression,
1855 -- indicating the position from which the iteration begins. Note that
1856 -- the start position has the same value irrespective of whether this is
1857 -- a forward or reverse iteration.
1859 return It
: constant Iterator
:=
1860 (Limited_Controlled
with
1862 Index
=> Start
.Index
)
1864 Busy
(Container
.TC
'Unrestricted_Access.all);
1872 function Last
(Container
: Vector
) return Cursor
is
1874 if Is_Empty
(Container
) then
1877 return (Container
'Unrestricted_Access, Container
.Last
);
1881 function Last
(Object
: Iterator
) return Cursor
is
1883 -- The value of the iterator object's Index component influences the
1884 -- behavior of the Last (and First) selector function.
1886 -- When the Index component is No_Index, this means the iterator object
1887 -- was constructed without a start expression, in which case the
1888 -- (reverse) iteration starts from the (logical) beginning of the entire
1889 -- sequence (corresponding to Container.Last, for a reverse iterator).
1891 -- Otherwise, this is iteration over a partial sequence of items. When
1892 -- the Index component is not No_Index, the iterator object was
1893 -- constructed with a start expression, that specifies the position from
1894 -- which the (reverse) partial iteration begins.
1896 if Object
.Index
= No_Index
then
1897 return Last
(Object
.Container
.all);
1899 return Cursor
'(Object.Container, Object.Index);
1907 function Last_Element (Container : Vector) return Element_Type is
1909 if Checks and then Container.Last = No_Index then
1910 raise Constraint_Error with "Container is empty";
1913 return Container.Elements (Container.Length);
1920 function Last_Index (Container : Vector) return Extended_Index is
1922 return Container.Last;
1929 function Length (Container : Vector) return Count_Type is
1930 L : constant Index_Type'Base := Container.Last;
1931 F : constant Index_Type := Index_Type'First;
1934 -- The base range of the index type (Index_Type'Base) might not include
1935 -- all values for length (Count_Type). Contrariwise, the index type
1936 -- might include values outside the range of length. Hence we use
1937 -- whatever type is wider for intermediate values when calculating
1938 -- length. Note that no matter what the index type is, the maximum
1939 -- length to which a vector is allowed to grow is always the minimum
1940 -- of Count_Type'Last and (IT'Last - IT'First + 1).
1942 -- For example, an Index_Type with range -127 .. 127 is only guaranteed
1943 -- to have a base range of -128 .. 127, but the corresponding vector
1944 -- would have lengths in the range 0 .. 255. In this case we would need
1945 -- to use Count_Type'Base for intermediate values.
1947 -- Another case would be the index range -2**63 + 1 .. -2**63 + 10. The
1948 -- vector would have a maximum length of 10, but the index values lie
1949 -- outside the range of Count_Type (which is only 32 bits). In this
1950 -- case we would need to use Index_Type'Base for intermediate values.
1952 if Count_Type'Base'Last
>= Index_Type
'Pos (Index_Type
'Base'Last) then
1953 return Count_Type'Base (L) - Count_Type'Base (F) + 1;
1955 return Count_Type (L - F + 1);
1964 (Target : in out Vector;
1965 Source : in out Vector)
1968 if Target'Address = Source'Address then
1972 TC_Check (Target.TC);
1973 TC_Check (Source.TC);
1975 if Checks and then Target.Capacity < Source.Length then
1976 raise Capacity_Error -- ???
1977 with "Target capacity is less than Source length";
1980 -- Clear Target now, in case element assignment fails
1982 Target.Last := No_Index;
1984 Target.Elements (1 .. Source.Length) :=
1985 Source.Elements (1 .. Source.Length);
1987 Target.Last := Source.Last;
1988 Source.Last := No_Index;
1995 function Next (Position : Cursor) return Cursor is
1997 if Position.Container = null then
1999 elsif Position.Index < Position.Container.Last then
2000 return (Position.Container, Position.Index + 1);
2006 function Next (Object : Iterator; Position : Cursor) return Cursor is
2008 if Position.Container = null then
2012 if Checks and then Position.Container /= Object.Container then
2013 raise Program_Error with
2014 "Position cursor of Next designates wrong vector";
2017 return Next (Position);
2020 procedure Next (Position : in out Cursor) is
2022 if Position.Container = null then
2024 elsif Position.Index < Position.Container.Last then
2025 Position.Index := Position.Index + 1;
2027 Position := No_Element;
2036 (Container : in out Vector;
2037 New_Item : Element_Type;
2038 Count : Count_Type := 1)
2041 Insert (Container, Index_Type'First, New_Item, Count);
2044 --------------------
2045 -- Prepend_Vector --
2046 --------------------
2048 procedure Prepend_Vector (Container : in out Vector; New_Item : Vector) is
2050 Insert_Vector (Container, Index_Type'First, New_Item);
2057 procedure Previous (Position : in out Cursor) is
2059 if Position.Container = null then
2061 elsif Position.Index > Index_Type'First then
2062 Position.Index := Position.Index - 1;
2064 Position := No_Element;
2068 function Previous (Position : Cursor) return Cursor is
2070 if Position.Container = null then
2072 elsif Position.Index > Index_Type'First then
2073 return (Position.Container, Position.Index - 1);
2079 function Previous (Object : Iterator; Position : Cursor) return Cursor is
2081 if Position.Container = null then
2085 if Checks and then Position.Container /= Object.Container then
2086 raise Program_Error with
2087 "Position cursor of Previous designates wrong vector";
2090 return Previous (Position);
2093 ----------------------
2094 -- Pseudo_Reference --
2095 ----------------------
2097 function Pseudo_Reference
2098 (Container : aliased Vector'Class) return Reference_Control_Type
2100 TC : constant Tamper_Counts_Access := Container.TC'Unrestricted_Access;
2102 return R : constant Reference_Control_Type := (Controlled with TC) do
2105 end Pseudo_Reference;
2111 procedure Query_Element
2112 (Container : Vector;
2114 Process : not null access procedure (Element : Element_Type))
2116 Lock : With_Lock (Container.TC'Unrestricted_Access);
2117 V : Vector renames Container'Unrestricted_Access.all;
2119 if Checks and then Index > Container.Last then
2120 raise Constraint_Error with "Index is out of range";
2123 Process (V.Elements (To_Array_Index (Index)));
2126 procedure Query_Element
2128 Process : not null access procedure (Element : Element_Type))
2131 if Checks and then Position.Container = null then
2132 raise Constraint_Error with "Position cursor has no element";
2135 Query_Element (Position.Container.all, Position.Index, Process);
2143 (S : in out Ada.Strings.Text_Buffers.Root_Buffer_Type'Class; V : Vector)
2145 First_Time : Boolean := True;
2146 use System.Put_Images;
2152 First_Time := False;
2154 Simple_Array_Between (S);
2157 Element_Type'Put_Image (S, X);
2168 (Stream : not null access Root_Stream_Type'Class;
2169 Container : out Vector)
2171 Length : Count_Type'Base;
2172 Last : Index_Type'Base := No_Index;
2177 Count_Type'Base'Read
(Stream
, Length
);
2179 Reserve_Capacity
(Container
, Capacity
=> Length
);
2181 for Idx
in Count_Type
range 1 .. Length
loop
2183 Element_Type
'Read (Stream
, Container
.Elements
(Idx
));
2184 Container
.Last
:= Last
;
2189 (Stream
: not null access Root_Stream_Type
'Class;
2190 Position
: out Cursor
)
2193 raise Program_Error
with "attempt to stream vector cursor";
2197 (Stream
: not null access Root_Stream_Type
'Class;
2198 Item
: out Reference_Type
)
2201 raise Program_Error
with "attempt to stream reference";
2205 (Stream
: not null access Root_Stream_Type
'Class;
2206 Item
: out Constant_Reference_Type
)
2209 raise Program_Error
with "attempt to stream reference";
2217 (Container
: aliased in out Vector
;
2218 Position
: Cursor
) return Reference_Type
2221 if Checks
and then Position
.Container
= null then
2222 raise Constraint_Error
with "Position cursor has no element";
2225 if Checks
and then Position
.Container
/= Container
'Unrestricted_Access
2227 raise Program_Error
with "Position cursor denotes wrong container";
2230 if Checks
and then Position
.Index
> Position
.Container
.Last
then
2231 raise Constraint_Error
with "Position cursor is out of range";
2235 A
: Elements_Array
renames Container
.Elements
;
2236 J
: constant Count_Type
:= To_Array_Index
(Position
.Index
);
2237 TC
: constant Tamper_Counts_Access
:=
2238 Container
.TC
'Unrestricted_Access;
2240 return R
: constant Reference_Type
:=
2241 (Element
=> A
(J
)'Unchecked_Access,
2242 Control
=> (Controlled
with TC
))
2250 (Container
: aliased in out Vector
;
2251 Index
: Index_Type
) return Reference_Type
2254 if Checks
and then Index
> Container
.Last
then
2255 raise Constraint_Error
with "Index is out of range";
2259 A
: Elements_Array
renames Container
.Elements
;
2260 J
: constant Count_Type
:= To_Array_Index
(Index
);
2261 TC
: constant Tamper_Counts_Access
:=
2262 Container
.TC
'Unrestricted_Access;
2264 return R
: constant Reference_Type
:=
2265 (Element
=> A
(J
)'Unchecked_Access,
2266 Control
=> (Controlled
with TC
))
2273 ---------------------
2274 -- Replace_Element --
2275 ---------------------
2277 procedure Replace_Element
2278 (Container
: in out Vector
;
2280 New_Item
: Element_Type
)
2283 TE_Check
(Container
.TC
);
2285 if Checks
and then Index
> Container
.Last
then
2286 raise Constraint_Error
with "Index is out of range";
2289 Container
.Elements
(To_Array_Index
(Index
)) := New_Item
;
2290 end Replace_Element
;
2292 procedure Replace_Element
2293 (Container
: in out Vector
;
2295 New_Item
: Element_Type
)
2298 TE_Check
(Container
.TC
);
2300 if Checks
and then Position
.Container
= null then
2301 raise Constraint_Error
with "Position cursor has no element";
2304 if Checks
and then Position
.Container
/= Container
'Unrestricted_Access
2306 raise Program_Error
with "Position cursor denotes wrong container";
2309 if Checks
and then Position
.Index
> Container
.Last
then
2310 raise Constraint_Error
with "Position cursor is out of range";
2313 Container
.Elements
(To_Array_Index
(Position
.Index
)) := New_Item
;
2314 end Replace_Element
;
2316 ----------------------
2317 -- Reserve_Capacity --
2318 ----------------------
2320 procedure Reserve_Capacity
2321 (Container
: in out Vector
;
2322 Capacity
: Count_Type
)
2325 if Checks
and then Capacity
> Container
.Capacity
then
2326 raise Capacity_Error
with "Capacity is out of range";
2328 end Reserve_Capacity
;
2330 ----------------------
2331 -- Reverse_Elements --
2332 ----------------------
2334 procedure Reverse_Elements
(Container
: in out Vector
) is
2335 E
: Elements_Array
renames Container
.Elements
;
2340 if Container
.Length
<= 1 then
2344 -- The exception behavior for the vector container must match that for
2345 -- the list container, so we check for cursor tampering here (which will
2346 -- catch more things) instead of for element tampering (which will catch
2347 -- fewer things). It's true that the elements of this vector container
2348 -- could be safely moved around while (say) an iteration is taking place
2349 -- (iteration only increments the busy counter), and so technically
2350 -- all we would need here is a test for element tampering (indicated
2351 -- by the lock counter), that's simply an artifact of our array-based
2352 -- implementation. Logically Reverse_Elements requires a check for
2353 -- cursor tampering.
2355 TC_Check
(Container
.TC
);
2358 Jdx
:= Container
.Length
;
2359 while Idx
< Jdx
loop
2361 EI
: constant Element_Type
:= E
(Idx
);
2371 end Reverse_Elements
;
2377 function Reverse_Find
2378 (Container
: Vector
;
2379 Item
: Element_Type
;
2380 Position
: Cursor
:= No_Element
) return Cursor
2382 Last
: Index_Type
'Base;
2385 if Checks
and then Position
.Container
/= null
2386 and then Position
.Container
/= Container
'Unrestricted_Access
2388 raise Program_Error
with "Position cursor denotes wrong container";
2392 (if Position
.Container
= null or else Position
.Index
> Container
.Last
2394 else Position
.Index
);
2396 -- Per AI05-0022, the container implementation is required to detect
2397 -- element tampering by a generic actual subprogram.
2400 Lock
: With_Lock
(Container
.TC
'Unrestricted_Access);
2402 for Indx
in reverse Index_Type
'First .. Last
loop
2403 if Container
.Elements
(To_Array_Index
(Indx
)) = Item
then
2404 return Cursor
'(Container'Unrestricted_Access, Indx);
2412 ------------------------
2413 -- Reverse_Find_Index --
2414 ------------------------
2416 function Reverse_Find_Index
2417 (Container : Vector;
2418 Item : Element_Type;
2419 Index : Index_Type := Index_Type'Last) return Extended_Index
2421 -- Per AI05-0022, the container implementation is required to detect
2422 -- element tampering by a generic actual subprogram.
2424 Lock : With_Lock (Container.TC'Unrestricted_Access);
2426 Last : constant Index_Type'Base :=
2427 Index_Type'Min (Container.Last, Index);
2430 for Indx in reverse Index_Type'First .. Last loop
2431 if Container.Elements (To_Array_Index (Indx)) = Item then
2437 end Reverse_Find_Index;
2439 ---------------------
2440 -- Reverse_Iterate --
2441 ---------------------
2443 procedure Reverse_Iterate
2444 (Container : Vector;
2445 Process : not null access procedure (Position : Cursor))
2447 Busy : With_Busy (Container.TC'Unrestricted_Access);
2449 for Indx in reverse Index_Type'First .. Container.Last loop
2450 Process (Cursor'(Container
'Unrestricted_Access, Indx
));
2452 end Reverse_Iterate
;
2458 procedure Set_Length
(Container
: in out Vector
; Length
: Count_Type
) is
2459 Count
: constant Count_Type
'Base := Container
.Length
- Length
;
2462 -- Set_Length allows the user to set the length explicitly, instead of
2463 -- implicitly as a side-effect of deletion or insertion. If the
2464 -- requested length is less than the current length, this is equivalent
2465 -- to deleting items from the back end of the vector. If the requested
2466 -- length is greater than the current length, then this is equivalent to
2467 -- inserting "space" (nonce items) at the end.
2470 Container
.Delete_Last
(Count
);
2471 elsif Checks
and then Container
.Last
>= Index_Type
'Last then
2472 raise Constraint_Error
with "vector is already at its maximum length";
2474 Container
.Insert_Space
(Container
.Last
+ 1, -Count
);
2482 procedure Swap
(Container
: in out Vector
; I
, J
: Index_Type
) is
2483 E
: Elements_Array
renames Container
.Elements
;
2486 TE_Check
(Container
.TC
);
2488 if Checks
and then I
> Container
.Last
then
2489 raise Constraint_Error
with "I index is out of range";
2492 if Checks
and then J
> Container
.Last
then
2493 raise Constraint_Error
with "J index is out of range";
2501 EI_Copy
: constant Element_Type
:= E
(To_Array_Index
(I
));
2503 E
(To_Array_Index
(I
)) := E
(To_Array_Index
(J
));
2504 E
(To_Array_Index
(J
)) := EI_Copy
;
2508 procedure Swap
(Container
: in out Vector
; I
, J
: Cursor
) is
2510 if Checks
and then I
.Container
= null then
2511 raise Constraint_Error
with "I cursor has no element";
2514 if Checks
and then J
.Container
= null then
2515 raise Constraint_Error
with "J cursor has no element";
2518 if Checks
and then I
.Container
/= Container
'Unrestricted_Access then
2519 raise Program_Error
with "I cursor denotes wrong container";
2522 if Checks
and then J
.Container
/= Container
'Unrestricted_Access then
2523 raise Program_Error
with "J cursor denotes wrong container";
2526 Swap
(Container
, I
.Index
, J
.Index
);
2529 --------------------
2530 -- To_Array_Index --
2531 --------------------
2533 function To_Array_Index
(Index
: Index_Type
'Base) return Count_Type
'Base is
2534 Offset
: Count_Type
'Base;
2538 -- Index >= Index_Type'First
2539 -- hence we also know that
2540 -- Index - Index_Type'First >= 0
2542 -- The issue is that even though 0 is guaranteed to be a value in
2543 -- the type Index_Type'Base, there's no guarantee that the difference
2544 -- is a value in that type. To prevent overflow we use the wider
2545 -- of Count_Type'Base and Index_Type'Base to perform intermediate
2548 if Index_Type
'Base'Last >= Count_Type'Pos (Count_Type'Last) then
2549 Offset := Count_Type'Base (Index - Index_Type'First);
2552 Offset := Count_Type'Base (Index) -
2553 Count_Type'Base (Index_Type'First);
2556 -- The array index subtype for all container element arrays
2557 -- always starts with 1.
2567 (Container : Vector;
2568 Index : Extended_Index) return Cursor
2571 if Index not in Index_Type'First .. Container.Last then
2575 return Cursor'(Container
'Unrestricted_Access, Index
);
2582 function To_Index
(Position
: Cursor
) return Extended_Index
is
2584 if Position
.Container
= null then
2588 if Position
.Index
<= Position
.Container
.Last
then
2589 return Position
.Index
;
2599 function To_Vector
(Length
: Count_Type
) return Vector
is
2600 Index
: Count_Type
'Base;
2601 Last
: Index_Type
'Base;
2605 return Empty_Vector
;
2608 -- We create a vector object with a capacity that matches the specified
2609 -- Length, but we do not allow the vector capacity (the length of the
2610 -- internal array) to exceed the number of values in Index_Type'Range
2611 -- (otherwise, there would be no way to refer to those components via an
2612 -- index). We must therefore check whether the specified Length would
2613 -- create a Last index value greater than Index_Type'Last.
2615 if Index_Type
'Base'Last >= Count_Type'Pos (Count_Type'Last) then
2616 -- We perform a two-part test. First we determine whether the
2617 -- computed Last value lies in the base range of the type, and then
2618 -- determine whether it lies in the range of the index (sub)type.
2620 -- Last must satisfy this relation:
2621 -- First + Length - 1 <= Last
2622 -- We regroup terms:
2623 -- First - 1 <= Last - Length
2624 -- Which can rewrite as:
2625 -- No_Index <= Last - Length
2628 Index_Type'Base'Last
- Index_Type
'Base (Length
) < No_Index
2630 raise Constraint_Error
with "Length is out of range";
2633 -- We now know that the computed value of Last is within the base
2634 -- range of the type, so it is safe to compute its value:
2636 Last
:= No_Index
+ Index_Type
'Base (Length
);
2638 -- Finally we test whether the value is within the range of the
2639 -- generic actual index subtype:
2641 if Checks
and then Last
> Index_Type
'Last then
2642 raise Constraint_Error
with "Length is out of range";
2645 elsif Index_Type
'First <= 0 then
2647 -- Here we can compute Last directly, in the normal way. We know that
2648 -- No_Index is less than 0, so there is no danger of overflow when
2649 -- adding the (positive) value of Length.
2651 Index
:= Count_Type
'Base (No_Index
) + Length
; -- Last
2653 if Checks
and then Index
> Count_Type
'Base (Index_Type
'Last) then
2654 raise Constraint_Error
with "Length is out of range";
2657 -- We know that the computed value (having type Count_Type) of Last
2658 -- is within the range of the generic actual index subtype, so it is
2659 -- safe to convert to Index_Type:
2661 Last
:= Index_Type
'Base (Index
);
2664 -- Here Index_Type'First (and Index_Type'Last) is positive, so we
2665 -- must test the length indirectly (by working backwards from the
2666 -- largest possible value of Last), in order to prevent overflow.
2668 Index
:= Count_Type
'Base (Index_Type
'Last) - Length
; -- No_Index
2670 if Checks
and then Index
< Count_Type
'Base (No_Index
) then
2671 raise Constraint_Error
with "Length is out of range";
2674 -- We have determined that the value of Length would not create a
2675 -- Last index value outside of the range of Index_Type, so we can now
2676 -- safely compute its value.
2678 Last
:= Index_Type
'Base (Count_Type
'Base (No_Index
) + Length
);
2681 return V
: Vector
(Capacity
=> Length
) do
2687 (New_Item
: Element_Type
;
2688 Length
: Count_Type
) return Vector
2690 Index
: Count_Type
'Base;
2691 Last
: Index_Type
'Base;
2695 return Empty_Vector
;
2698 -- We create a vector object with a capacity that matches the specified
2699 -- Length, but we do not allow the vector capacity (the length of the
2700 -- internal array) to exceed the number of values in Index_Type'Range
2701 -- (otherwise, there would be no way to refer to those components via an
2702 -- index). We must therefore check whether the specified Length would
2703 -- create a Last index value greater than Index_Type'Last.
2705 if Index_Type
'Base'Last >= Count_Type'Pos (Count_Type'Last) then
2707 -- We perform a two-part test. First we determine whether the
2708 -- computed Last value lies in the base range of the type, and then
2709 -- determine whether it lies in the range of the index (sub)type.
2711 -- Last must satisfy this relation:
2712 -- First + Length - 1 <= Last
2713 -- We regroup terms:
2714 -- First - 1 <= Last - Length
2715 -- Which can rewrite as:
2716 -- No_Index <= Last - Length
2719 Index_Type'Base'Last
- Index_Type
'Base (Length
) < No_Index
2721 raise Constraint_Error
with "Length is out of range";
2724 -- We now know that the computed value of Last is within the base
2725 -- range of the type, so it is safe to compute its value:
2727 Last
:= No_Index
+ Index_Type
'Base (Length
);
2729 -- Finally we test whether the value is within the range of the
2730 -- generic actual index subtype:
2732 if Checks
and then Last
> Index_Type
'Last then
2733 raise Constraint_Error
with "Length is out of range";
2736 elsif Index_Type
'First <= 0 then
2738 -- Here we can compute Last directly, in the normal way. We know that
2739 -- No_Index is less than 0, so there is no danger of overflow when
2740 -- adding the (positive) value of Length.
2742 Index
:= Count_Type
'Base (No_Index
) + Length
; -- same value as V.Last
2744 if Checks
and then Index
> Count_Type
'Base (Index_Type
'Last) then
2745 raise Constraint_Error
with "Length is out of range";
2748 -- We know that the computed value (having type Count_Type) of Last
2749 -- is within the range of the generic actual index subtype, so it is
2750 -- safe to convert to Index_Type:
2752 Last
:= Index_Type
'Base (Index
);
2755 -- Here Index_Type'First (and Index_Type'Last) is positive, so we
2756 -- must test the length indirectly (by working backwards from the
2757 -- largest possible value of Last), in order to prevent overflow.
2759 Index
:= Count_Type
'Base (Index_Type
'Last) - Length
; -- No_Index
2761 if Checks
and then Index
< Count_Type
'Base (No_Index
) then
2762 raise Constraint_Error
with "Length is out of range";
2765 -- We have determined that the value of Length would not create a
2766 -- Last index value outside of the range of Index_Type, so we can now
2767 -- safely compute its value.
2769 Last
:= Index_Type
'Base (Count_Type
'Base (No_Index
) + Length
);
2772 return V
: Vector
(Capacity
=> Length
) do
2773 V
.Elements
:= [others => New_Item
];
2778 --------------------
2779 -- Update_Element --
2780 --------------------
2782 procedure Update_Element
2783 (Container
: in out Vector
;
2785 Process
: not null access procedure (Element
: in out Element_Type
))
2787 Lock
: With_Lock
(Container
.TC
'Unchecked_Access);
2789 if Checks
and then Index
> Container
.Last
then
2790 raise Constraint_Error
with "Index is out of range";
2793 Process
(Container
.Elements
(To_Array_Index
(Index
)));
2796 procedure Update_Element
2797 (Container
: in out Vector
;
2799 Process
: not null access procedure (Element
: in out Element_Type
))
2802 if Checks
and then Position
.Container
= null then
2803 raise Constraint_Error
with "Position cursor has no element";
2806 if Checks
and then Position
.Container
/= Container
'Unrestricted_Access
2808 raise Program_Error
with "Position cursor denotes wrong container";
2811 Update_Element
(Container
, Position
.Index
, Process
);
2819 (Stream
: not null access Root_Stream_Type
'Class;
2825 N
:= Container
.Length
;
2826 Count_Type
'Base'Write (Stream, N);
2828 for J in 1 .. N loop
2829 Element_Type'Write (Stream, Container.Elements (J));
2834 (Stream : not null access Root_Stream_Type'Class;
2838 raise Program_Error with "attempt to stream vector cursor";
2842 (Stream : not null access Root_Stream_Type'Class;
2843 Item : Reference_Type)
2846 raise Program_Error with "attempt to stream reference";
2850 (Stream : not null access Root_Stream_Type'Class;
2851 Item : Constant_Reference_Type)
2854 raise Program_Error with "attempt to stream reference";
2857 end Ada.Containers.Bounded_Vectors;