Skip to content

R
riscv-gcc-1
Commit d43d5ef7 by Matthew Heaney Committed by Arnaud Charlet
Options

a-convec.ads, [...]: Declaration of subtype Extended_Index was changed. 

2005-07-04  Matthew Heaney  <heaney@adacore.com>

	* a-convec.ads, a-coinve.ads: Declaration of subtype Extended_Index
	was changed.
	* a-coinve.adb: Perform constraint checks explicitly.

From-SVN: r101597
parent c8effb4f
Showing with 421 additions and 298 deletions
gcc/ada/a-coinve.adb
...@@ -76,7 +76,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -76,7 +76,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
exception exception
when others => when others =>
for J in Index_Type'First .. Index_Type'Pred (I) loop for J in Index_Type'First .. I - 1 loop
Free (Elements (J)); Free (Elements (J));
end loop; end loop;
...@@ -106,7 +106,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -106,7 +106,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
exception exception
when others => when others =>
for J in Index_Type'First .. Index_Type'Pred (I) loop for J in Index_Type'First .. I - 1 loop
Free (Elements (J)); Free (Elements (J));
end loop; end loop;
...@@ -120,9 +120,15 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -120,9 +120,15 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
declare declare
Last_As_Int : constant Int'Base := Last_As_Int : constant Int'Base := -- TODO: handle overflow
Int (Index_Type'First) + Int (LN) + Int (RN) - 1; Int (Index_Type'First) + Int (LN) + Int (RN) - 1;
begin
if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
raise Constraint_Error;
end if;
declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (Last_As_Int);
LE : Elements_Type renames LE : Elements_Type renames
...@@ -134,11 +140,11 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -134,11 +140,11 @@ package body Ada.Containers.Indefinite_Vectors is
Elements : Elements_Access := Elements : Elements_Access :=
new Elements_Type (Index_Type'First .. Last); new Elements_Type (Index_Type'First .. Last);
I : Index_Type'Base := Index_Type'Pred (Index_Type'First); I : Index_Type'Base := No_Index;
begin begin
for LI in LE'Range loop for LI in LE'Range loop
I := Index_Type'Succ (I); I := I + 1;
begin begin
if LE (LI) /= null then if LE (LI) /= null then
...@@ -146,7 +152,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -146,7 +152,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
exception exception
when others => when others =>
for J in Index_Type'First .. Index_Type'Pred (I) loop for J in Index_Type'First .. I - 1 loop
Free (Elements (J)); Free (Elements (J));
end loop; end loop;
...@@ -156,7 +162,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -156,7 +162,7 @@ package body Ada.Containers.Indefinite_Vectors is
end loop; end loop;
for RI in RE'Range loop for RI in RE'Range loop
I := Index_Type'Succ (I); I := I + 1;
begin begin
if RE (RI) /= null then if RE (RI) /= null then
...@@ -164,7 +170,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -164,7 +170,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
exception exception
when others => when others =>
for J in Index_Type'First .. Index_Type'Pred (I) loop for J in Index_Type'First .. I - 1 loop
Free (Elements (J)); Free (Elements (J));
end loop; end loop;
...@@ -175,6 +181,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -175,6 +181,7 @@ package body Ada.Containers.Indefinite_Vectors is
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
end; end;
end;
end "&"; end "&";
function "&" (Left : Vector; Right : Element_Type) return Vector is function "&" (Left : Vector; Right : Element_Type) return Vector is
...@@ -205,6 +212,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -205,6 +212,12 @@ package body Ada.Containers.Indefinite_Vectors is
Last_As_Int : constant Int'Base := Last_As_Int : constant Int'Base :=
Int (Index_Type'First) + Int (LN); Int (Index_Type'First) + Int (LN);
begin
if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
raise Constraint_Error;
end if;
declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (Last_As_Int);
LE : Elements_Type renames LE : Elements_Type renames
...@@ -221,7 +234,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -221,7 +234,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
exception exception
when others => when others =>
for J in Index_Type'First .. Index_Type'Pred (I) loop for J in Index_Type'First .. I - 1 loop
Free (Elements (J)); Free (Elements (J));
end loop; end loop;
...@@ -234,14 +247,9 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -234,14 +247,9 @@ package body Ada.Containers.Indefinite_Vectors is
Elements (Elements'Last) := new Element_Type'(Right); Elements (Elements'Last) := new Element_Type'(Right);
exception exception
when others => when others =>
declare for J in Index_Type'First .. Elements'Last - 1 loop
subtype J_Subtype is Index_Type'Base range
Index_Type'First .. Index_Type'Pred (Elements'Last);
begin
for J in J_Subtype loop
Free (Elements (J)); Free (Elements (J));
end loop; end loop;
end;
Free (Elements); Free (Elements);
raise; raise;
...@@ -249,6 +257,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -249,6 +257,7 @@ package body Ada.Containers.Indefinite_Vectors is
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
end; end;
end;
end "&"; end "&";
function "&" (Left : Element_Type; Right : Vector) return Vector is function "&" (Left : Element_Type; Right : Vector) return Vector is
...@@ -279,6 +288,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -279,6 +288,12 @@ package body Ada.Containers.Indefinite_Vectors is
Last_As_Int : constant Int'Base := Last_As_Int : constant Int'Base :=
Int (Index_Type'First) + Int (RN); Int (Index_Type'First) + Int (RN);
begin
if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
raise Constraint_Error;
end if;
declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (Last_As_Int);
RE : Elements_Type renames RE : Elements_Type renames
...@@ -299,7 +314,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -299,7 +314,7 @@ package body Ada.Containers.Indefinite_Vectors is
end; end;
for RI in RE'Range loop for RI in RE'Range loop
I := Index_Type'Succ (I); I := I + 1;
begin begin
if RE (RI) /= null then if RE (RI) /= null then
...@@ -307,7 +322,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -307,7 +322,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
exception exception
when others => when others =>
for J in Index_Type'First .. Index_Type'Pred (I) loop for J in Index_Type'First .. I - 1 loop
Free (Elements (J)); Free (Elements (J));
end loop; end loop;
...@@ -318,14 +333,21 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -318,14 +333,21 @@ package body Ada.Containers.Indefinite_Vectors is
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
end; end;
end;
end "&"; end "&";
function "&" (Left, Right : Element_Type) return Vector is function "&" (Left, Right : Element_Type) return Vector is
subtype IT is Index_Type'Base range begin
Index_Type'First .. Index_Type'Succ (Index_Type'First); if Index_Type'First >= Index_Type'Last then
raise Constraint_Error;
end if;
declare
Last : constant Index_Type := Index_Type'First + 1;
Elements : Elements_Access := new Elements_Type (IT); subtype ET is Elements_Type (Index_Type'First .. Last);
Elements : Elements_Access := new ET;
begin begin
begin begin
Elements (Elements'First) := new Element_Type'(Left); Elements (Elements'First) := new Element_Type'(Left);
...@@ -345,6 +367,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -345,6 +367,7 @@ package body Ada.Containers.Indefinite_Vectors is
end; end;
return (Controlled with Elements, Elements'Last, 0, 0); return (Controlled with Elements, Elements'Last, 0, 0);
end;
end "&"; end "&";
--------- ---------
...@@ -362,17 +385,6 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -362,17 +385,6 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
for J in Index_Type'First .. Left.Last loop for J in Index_Type'First .. Left.Last loop
-- NOTE:
-- I think it's a bounded error to read or otherwise manipulate
-- an "empty" element, which here means that it has the value
-- null. If it's a bounded error then an exception might
-- propagate, or it might not. We take advantage of that
-- permission here to allow empty elements to be compared.
--
-- Whether this is the right decision I'm not really sure. If
-- you have a contrary argument then let me know.
-- END NOTE.
if Left.Elements (J) = null then if Left.Elements (J) = null then
if Right.Elements (J) /= null then if Right.Elements (J) /= null then
return False; return False;
...@@ -383,7 +395,6 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -383,7 +395,6 @@ package body Ada.Containers.Indefinite_Vectors is
elsif Left.Elements (J).all /= Right.Elements (J).all then elsif Left.Elements (J).all /= Right.Elements (J).all then
return False; return False;
end if; end if;
end loop; end loop;
...@@ -396,13 +407,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -396,13 +407,7 @@ package body Ada.Containers.Indefinite_Vectors is
procedure Adjust (Container : in out Vector) is procedure Adjust (Container : in out Vector) is
begin begin
if Container.Elements = null then if Container.Last = No_Index then
return;
end if;
if Container.Elements'Length = 0
or else Container.Last < Index_Type'First
then
Container.Elements := null; Container.Elements := null;
return; return;
end if; end if;
...@@ -410,6 +415,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -410,6 +415,7 @@ package body Ada.Containers.Indefinite_Vectors is
declare declare
E : Elements_Type renames Container.Elements.all; E : Elements_Type renames Container.Elements.all;
L : constant Index_Type := Container.Last; L : constant Index_Type := Container.Last;
begin begin
Container.Elements := null; Container.Elements := null;
Container.Last := No_Index; Container.Last := No_Index;
...@@ -438,9 +444,13 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -438,9 +444,13 @@ package body Ada.Containers.Indefinite_Vectors is
return; return;
end if; end if;
if Container.Last = Index_Type'Last then
raise Constraint_Error;
end if;
Insert Insert
(Container, (Container,
Index_Type'Succ (Container.Last), Container.Last + 1,
New_Item); New_Item);
end Append; end Append;
...@@ -454,9 +464,13 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -454,9 +464,13 @@ package body Ada.Containers.Indefinite_Vectors is
return; return;
end if; end if;
if Container.Last = Index_Type'Last then
raise Constraint_Error;
end if;
Insert Insert
(Container, (Container,
Index_Type'Succ (Container.Last), Container.Last + 1,
New_Item, New_Item,
Count); Count);
end Append; end Append;
...@@ -522,12 +536,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -522,12 +536,12 @@ package body Ada.Containers.Indefinite_Vectors is
raise Program_Error; raise Program_Error;
end if; end if;
for J in reverse Index_Type'First .. Container.Last loop while Container.Last >= Index_Type'First loop
declare declare
X : Element_Access := Container.Elements (J); X : Element_Access := Container.Elements (Container.Last);
begin begin
Container.Elements (J) := null; Container.Elements (Container.Last) := null;
Container.Last := Index_Type'Pred (J); Container.Last := Container.Last - 1;
Free (X); Free (X);
end; end;
end loop; end loop;
...@@ -575,27 +589,41 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -575,27 +589,41 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
declare declare
I_As_Int : constant Int := Int (Index); Index_As_Int : constant Int := Int (Index);
Old_Last_As_Int : constant Int := Int (Container.Last); Old_Last_As_Int : constant Int := Int (Container.Last);
-- TODO: somewhat vestigial...fix.
Count1 : constant Int'Base := Int (Count); Count1 : constant Int'Base := Int (Count);
Count2 : constant Int'Base := Old_Last_As_Int - I_As_Int + 1; Count2 : constant Int'Base := Old_Last_As_Int - Index_As_Int + 1;
N : constant Int'Base := Int'Min (Count1, Count2); N : constant Int'Base := Int'Min (Count1, Count2);
J_As_Int : constant Int'Base := I_As_Int + N; J_As_Int : constant Int'Base := Index_As_Int + N;
J : constant Index_Type'Base := Index_Type'Base (J_As_Int);
E : Elements_Type renames Container.Elements.all; E : Elements_Type renames Container.Elements.all;
New_Last_As_Int : constant Int'Base := Old_Last_As_Int - N; begin
if J_As_Int > Old_Last_As_Int then
while Container.Last >= Index loop
declare
K : constant Index_Type := Container.Last;
X : Element_Access := E (K);
begin
E (K) := null;
Container.Last := K - 1;
Free (X);
end;
end loop;
New_Last : constant Extended_Index := else
Extended_Index (New_Last_As_Int); declare
J : constant Index_Type := Index_Type (J_As_Int);
New_Last_As_Int : constant Int'Base := Old_Last_As_Int - N;
New_Last : constant Index_Type :=
Index_Type (New_Last_As_Int);
begin begin
for K in Index .. Index_Type'Pred (J) loop for K in Index .. J - 1 loop
declare declare
X : Element_Access := E (K); X : Element_Access := E (K);
begin begin
...@@ -607,6 +635,8 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -607,6 +635,8 @@ package body Ada.Containers.Indefinite_Vectors is
E (Index .. New_Last) := E (J .. Container.Last); E (Index .. New_Last) := E (J .. Container.Last);
Container.Last := New_Last; Container.Last := New_Last;
end; end;
end if;
end;
end Delete; end Delete;
procedure Delete procedure Delete
...@@ -664,21 +694,35 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -664,21 +694,35 @@ package body Ada.Containers.Indefinite_Vectors is
(Container : in out Vector; (Container : in out Vector;
Count : Count_Type := 1) Count : Count_Type := 1)
is is
Index : Int'Base; N : constant Count_Type := Length (Container);
begin begin
if Count = 0 then if Count = 0
or else N = 0
then
return; return;
end if; end if;
if Count >= Length (Container) then if Container.Busy > 0 then
Clear (Container); raise Program_Error;
return;
end if; end if;
Index := Int'Base (Container.Last) - Int'Base (Count) + 1; declare
E : Elements_Type renames Container.Elements.all;
begin
for Indx in 1 .. Count_Type'Min (Count, N) loop
declare
J : constant Index_Type := Container.Last;
X : Element_Access := E (J);
Delete (Container, Index_Type'Base (Index), Count); begin
E (J) := null;
Container.Last := J - 1;
Free (X);
end;
end loop;
end;
end Delete_Last; end Delete_Last;
------------- -------------
...@@ -689,14 +733,20 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -689,14 +733,20 @@ package body Ada.Containers.Indefinite_Vectors is
(Container : Vector; (Container : Vector;
Index : Index_Type) return Element_Type Index : Index_Type) return Element_Type
is is
subtype T is Index_Type'Base range
Index_Type'First .. Container.Last;
begin begin
return Container.Elements (T'(Index)).all; if Index > Container.Last then
raise Constraint_Error;
end if;
return Container.Elements (Index).all;
end Element; end Element;
function Element (Position : Cursor) return Element_Type is function Element (Position : Cursor) return Element_Type is
begin begin
if Position.Container = null then
raise Constraint_Error;
end if;
return Element (Position.Container.all, Position.Index); return Element (Position.Container.all, Position.Index);
end Element; end Element;
...@@ -970,9 +1020,6 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -970,9 +1020,6 @@ package body Ada.Containers.Indefinite_Vectors is
New_Last_As_Int : Int'Base; New_Last_As_Int : Int'Base;
New_Last : Index_Type; New_Last : Index_Type;
Index : Extended_Index; -- TODO: see note in a-convec.adb.
Dst_Last : Index_Type;
Dst : Elements_Access; Dst : Elements_Access;
begin begin
...@@ -995,6 +1042,11 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -995,6 +1042,11 @@ package body Ada.Containers.Indefinite_Vectors is
begin begin
New_Last_As_Int := Old_Last_As_Int + N; New_Last_As_Int := Old_Last_As_Int + N;
if New_Last_As_Int > Index_Type'Pos (Index_Type'Last) then
raise Constraint_Error;
end if;
New_Last := Index_Type (New_Last_As_Int); New_Last := Index_Type (New_Last_As_Int);
end; end;
...@@ -1002,28 +1054,16 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1002,28 +1054,16 @@ package body Ada.Containers.Indefinite_Vectors is
raise Program_Error; raise Program_Error;
end if; end if;
declare
Old_First_As_Int : constant Int := Int (Before);
New_First_As_Int : constant Int'Base := Old_First_As_Int + N;
begin
Index := Extended_Index (New_First_As_Int); -- TODO
end;
if Container.Elements = null then if Container.Elements = null then
declare Container.Elements :=
subtype Elements_Subtype is new Elements_Type (Index_Type'First .. New_Last);
Elements_Type (Index_Type'First .. New_Last);
begin Container.Last := No_Index;
Container.Elements := new Elements_Subtype;
Container.Last := Index_Type'Pred (Index_Type'First);
for J in Container.Elements'Range loop for J in Container.Elements'Range loop
Container.Elements (J) := new Element_Type'(New_Item); Container.Elements (J) := new Element_Type'(New_Item);
Container.Last := J; Container.Last := J;
end loop; end loop;
end;
return; return;
end if; end if;
...@@ -1032,42 +1072,35 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1032,42 +1072,35 @@ package body Ada.Containers.Indefinite_Vectors is
declare declare
E : Elements_Type renames Container.Elements.all; E : Elements_Type renames Container.Elements.all;
begin begin
if Before <= Container.Last then
declare
Index_As_Int : constant Int'Base :=
Index_Type'Pos (Before) + N;
Index : constant Index_Type := Index_Type (Index_As_Int);
J : Index_Type'Base := Before;
begin
E (Index .. New_Last) := E (Before .. Container.Last); E (Index .. New_Last) := E (Before .. Container.Last);
Container.Last := New_Last; Container.Last := New_Last;
-- NOTE: while J < Index loop
-- Now we do the allocation. If it fails, we can propagate the
-- exception and invariants are more or less satisfied. The
-- issue is that we have some slots still null, and the client
-- has no way of detecting whether the slot is null (unless we
-- give him a way).
--
-- Another way is to allocate a subarray on the stack, do the
-- allocation into that array, and if that success then do
-- the insertion proper. The issue there is that you have to
-- allocate the subarray on the stack, and that may fail if the
-- subarray is long.
--
-- Or we could try to roll-back the changes: deallocate the
-- elements we have successfully deallocated, and then copy
-- the elements ptrs back to their original posns.
-- END NOTE.
-- NOTE: I have written the loop manually here. I could
-- have done it this way too:
-- E (Before .. Index_Type'Pred (Index)) :=
-- (others => new Element_Type'New_Item);
-- END NOTE.
for J in Before .. Index_Type'Pred (Index) loop
begin
E (J) := new Element_Type'(New_Item); E (J) := new Element_Type'(New_Item);
J := J + 1;
end loop;
exception exception
when others => when others =>
E (J .. Index_Type'Pred (Index)) := (others => null); E (J .. Index - 1) := (others => null);
raise; raise;
end; end;
else
for J in Before .. New_Last loop
E (J) := new Element_Type'(New_Item);
Container.Last := J;
end loop; end loop;
end if;
end; end;
return; return;
...@@ -1075,62 +1108,80 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1075,62 +1108,80 @@ package body Ada.Containers.Indefinite_Vectors is
declare declare
First : constant Int := Int (Index_Type'First); First : constant Int := Int (Index_Type'First);
New_Size : constant Int'Base := New_Last_As_Int - First + 1; New_Size : constant Int'Base := New_Last_As_Int - First + 1;
Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1; Size : Int'Base := Int'Max (1, Container.Elements'Length);
Size, Dst_Last_As_Int : Int'Base;
begin begin
if New_Size >= Max_Size / 2 then while Size < New_Size loop
Dst_Last := Index_Type'Last; if Size > Int'Last / 2 then
Size := Int'Last;
else exit;
Size := Container.Elements'Length;
if Size = 0 then
Size := 1;
end if; end if;
while Size < New_Size loop
Size := 2 * Size; Size := 2 * Size;
end loop; end loop;
Dst_Last_As_Int := First + Size - 1; -- TODO: The following calculations aren't quite right, since
Dst_Last := Index_Type (Dst_Last_As_Int); -- there will be overflow if Index_Type'Range is very large
-- (e.g. this package is instantiated with a 64-bit integer).
-- END TODO.
declare
Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1;
begin
if Size > Max_Size then
Size := Max_Size;
end if; end if;
end; end;
declare
Dst_Last : constant Index_Type := Index_Type (First + Size - 1);
begin
Dst := new Elements_Type (Index_Type'First .. Dst_Last); Dst := new Elements_Type (Index_Type'First .. Dst_Last);
end;
end;
if Before <= Container.Last then
declare declare
Src : Elements_Type renames Container.Elements.all; Index_As_Int : constant Int'Base :=
Index_Type'Pos (Before) + N;
Index : constant Index_Type := Index_Type (Index_As_Int);
Src : Elements_Access := Container.Elements;
begin begin
Dst (Index_Type'First .. Index_Type'Pred (Before)) := Dst (Index_Type'First .. Before - 1) :=
Src (Index_Type'First .. Index_Type'Pred (Before)); Src (Index_Type'First .. Before - 1);
Dst (Index .. New_Last) := Src (Before .. Container.Last); Dst (Index .. New_Last) := Src (Before .. Container.Last);
end;
declare
X : Elements_Access := Container.Elements;
begin
Container.Elements := Dst; Container.Elements := Dst;
Container.Last := New_Last; Container.Last := New_Last;
Free (Src);
Free (X); for J in Before .. Index - 1 loop
Dst (J) := new Element_Type'(New_Item);
end loop;
end; end;
-- NOTE: else
-- Now do the allocation. If the allocation fails, declare
-- then the worst thing is that we have a few null slots. Src : Elements_Access := Container.Elements;
-- Our invariants are otherwise satisfied.
-- END NOTE. begin
Dst (Index_Type'First .. Container.Last) :=
Src (Index_Type'First .. Container.Last);
Container.Elements := Dst;
Free (Src);
for J in Before .. Index_Type'Pred (Index) loop for J in Before .. New_Last loop
Dst (J) := new Element_Type'(New_Item); Dst (J) := new Element_Type'(New_Item);
Container.Last := J;
end loop; end loop;
end;
end if;
end Insert; end Insert;
procedure Insert procedure Insert
...@@ -1157,29 +1208,26 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1157,29 +1208,26 @@ package body Ada.Containers.Indefinite_Vectors is
Insert_Space (Container, Before, Count => N); Insert_Space (Container, Before, Count => N);
if Container'Address = New_Item'Address then
declare declare
Dst_Last_As_Int : constant Int'Base := Dst_Last_As_Int : constant Int'Base :=
Int'Base (Before) + Int'Base (N) - 1; Int'Base (Before) + Int'Base (N) - 1;
Dst_Last : constant Index_Type := Index_Type (Dst_Last_As_Int); Dst_Last : constant Index_Type := Index_Type (Dst_Last_As_Int);
Dst_Index : Index_Type'Base := Index_Type'Pred (Before);
Dst : Elements_Type renames Dst : Elements_Type renames
Container.Elements (Before .. Dst_Last); Container.Elements (Before .. Dst_Last);
Dst_Index : Index_Type'Base := Before - 1;
begin begin
if Container'Address /= New_Item'Address then
declare declare
subtype Src_Index_Subtype is Index_Type'Base range
Index_Type'First .. Index_Type'Pred (Before);
Src : Elements_Type renames Src : Elements_Type renames
Container.Elements (Src_Index_Subtype); New_Item.Elements (Index_Type'First .. New_Item.Last);
begin begin
for Src_Index in Src'Range loop for Src_Index in Src'Range loop
Dst_Index := Index_Type'Succ (Dst_Index); Dst_Index := Dst_Index + 1;
if Src (Src_Index) /= null then if Src (Src_Index) /= null then
Dst (Dst_Index) := new Element_Type'(Src (Src_Index).all); Dst (Dst_Index) := new Element_Type'(Src (Src_Index).all);
...@@ -1187,49 +1235,47 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1187,49 +1235,47 @@ package body Ada.Containers.Indefinite_Vectors is
end loop; end loop;
end; end;
return;
end if;
declare declare
subtype Src_Index_Subtype is Index_Type'Base range subtype Src_Index_Subtype is Index_Type'Base range
Index_Type'Succ (Dst_Last) .. Container.Last; Index_Type'First .. Before - 1;
Src : Elements_Type renames Src : Elements_Type renames
Container.Elements (Src_Index_Subtype); Container.Elements (Src_Index_Subtype);
begin begin
for Src_Index in Src'Range loop for Src_Index in Src'Range loop
Dst_Index := Index_Type'Succ (Dst_Index); Dst_Index := Dst_Index + 1;
if Src (Src_Index) /= null then if Src (Src_Index) /= null then
Dst (Dst_Index) := new Element_Type'(Src (Src_Index).all); Dst (Dst_Index) := new Element_Type'(Src (Src_Index).all);
end if; end if;
end loop; end loop;
end; end;
end;
else if Dst_Last = Container.Last then
declare return;
Dst_Last_As_Int : constant Int'Base := end if;
Int'Base (Before) + Int'Base (N) - 1;
Dst_Last : constant Index_Type := Index_Type (Dst_Last_As_Int);
Dst_Index : Index_Type'Base := Index_Type'Pred (Before); declare
subtype Src_Index_Subtype is Index_Type'Base range
Dst_Last + 1 .. Container.Last;
Src : Elements_Type renames Src : Elements_Type renames
New_Item.Elements (Index_Type'First .. New_Item.Last); Container.Elements (Src_Index_Subtype);
Dst : Elements_Type renames
Container.Elements (Before .. Dst_Last);
begin begin
for Src_Index in Src'Range loop for Src_Index in Src'Range loop
Dst_Index := Index_Type'Succ (Dst_Index); Dst_Index := Dst_Index + 1;
if Src (Src_Index) /= null then if Src (Src_Index) /= null then
Dst (Dst_Index) := new Element_Type'(Src (Src_Index).all); Dst (Dst_Index) := new Element_Type'(Src (Src_Index).all);
end if; end if;
end loop; end loop;
end; end;
end;
end if;
end Insert; end Insert;
procedure Insert procedure Insert
...@@ -1253,7 +1299,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1253,7 +1299,12 @@ package body Ada.Containers.Indefinite_Vectors is
if Before.Container = null if Before.Container = null
or else Before.Index > Container.Last or else Before.Index > Container.Last
then then
Index := Index_Type'Succ (Container.Last); if Container.Last = Index_Type'Last then
raise Constraint_Error;
end if;
Index := Container.Last + 1;
else else
Index := Before.Index; Index := Before.Index;
end if; end if;
...@@ -1291,7 +1342,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1291,7 +1342,12 @@ package body Ada.Containers.Indefinite_Vectors is
if Before.Container = null if Before.Container = null
or else Before.Index > Container.Last or else Before.Index > Container.Last
then then
Index := Index_Type'Succ (Container.Last); if Container.Last = Index_Type'Last then
raise Constraint_Error;
end if;
Index := Container.Last + 1;
else else
Index := Before.Index; Index := Before.Index;
end if; end if;
...@@ -1323,7 +1379,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1323,7 +1379,12 @@ package body Ada.Containers.Indefinite_Vectors is
if Before.Container = null if Before.Container = null
or else Before.Index > Container.Last or else Before.Index > Container.Last
then then
Index := Index_Type'Succ (Container.Last); if Container.Last = Index_Type'Last then
raise Constraint_Error;
end if;
Index := Container.Last + 1;
else else
Index := Before.Index; Index := Before.Index;
end if; end if;
...@@ -1362,7 +1423,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1362,7 +1423,12 @@ package body Ada.Containers.Indefinite_Vectors is
if Before.Container = null if Before.Container = null
or else Before.Index > Container.Last or else Before.Index > Container.Last
then then
Index := Index_Type'Succ (Container.Last); if Container.Last = Index_Type'Last then
raise Constraint_Error;
end if;
Index := Container.Last + 1;
else else
Index := Before.Index; Index := Before.Index;
end if; end if;
...@@ -1386,9 +1452,6 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1386,9 +1452,6 @@ package body Ada.Containers.Indefinite_Vectors is
New_Last_As_Int : Int'Base; New_Last_As_Int : Int'Base;
New_Last : Index_Type; New_Last : Index_Type;
Index : Extended_Index; -- TODO: see a-convec.adb.
Dst_Last : Index_Type;
Dst : Elements_Access; Dst : Elements_Access;
begin begin
...@@ -1411,6 +1474,11 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1411,6 +1474,11 @@ package body Ada.Containers.Indefinite_Vectors is
begin begin
New_Last_As_Int := Old_Last_As_Int + N; New_Last_As_Int := Old_Last_As_Int + N;
if New_Last_As_Int > Index_Type'Pos (Index_Type'Last) then
raise Constraint_Error;
end if;
New_Last := Index_Type (New_Last_As_Int); New_Last := Index_Type (New_Last_As_Int);
end; end;
...@@ -1418,90 +1486,98 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1418,90 +1486,98 @@ package body Ada.Containers.Indefinite_Vectors is
raise Program_Error; raise Program_Error;
end if; end if;
declare
Old_First_As_Int : constant Int := Int (Before);
New_First_As_Int : constant Int'Base := Old_First_As_Int + N;
begin
Index := Extended_Index (New_First_As_Int); -- TODO
end;
if Container.Elements = null then if Container.Elements = null then
declare Container.Elements :=
subtype Elements_Subtype is new Elements_Type (Index_Type'First .. New_Last);
Elements_Type (Index_Type'First .. New_Last);
begin
Container.Elements := new Elements_Subtype;
Container.Last := New_Last;
end;
Container.Last := New_Last;
return; return;
end if; end if;
if New_Last <= Container.Elements'Last then if New_Last <= Container.Elements'Last then
declare declare
E : Elements_Type renames Container.Elements.all; E : Elements_Type renames Container.Elements.all;
begin begin
E (Index .. New_Last) := E (Before .. Container.Last); if Before <= Container.Last then
E (Before .. Index_Type'Pred (Index)) := (others => null); declare
Index_As_Int : constant Int'Base :=
Index_Type'Pos (Before) + N;
Container.Last := New_Last; Index : constant Index_Type := Index_Type (Index_As_Int);
begin
E (Index .. New_Last) := E (Before .. Container.Last);
E (Before .. Index - 1) := (others => null);
end;
end if;
end; end;
Container.Last := New_Last;
return; return;
end if; end if;
declare declare
First : constant Int := Int (Index_Type'First); First : constant Int := Int (Index_Type'First);
New_Size : constant Int'Base := New_Last_As_Int - First + 1;
New_Size : constant Int'Base := Size : Int'Base := Int'Max (1, Container.Elements'Length);
Int (New_Last_As_Int) - First + 1;
Max_Size : constant Int'Base :=
Int (Index_Type'Last) - First + 1;
Size, Dst_Last_As_Int : Int'Base;
begin begin
if New_Size >= Max_Size / 2 then while Size < New_Size loop
Dst_Last := Index_Type'Last; if Size > Int'Last / 2 then
Size := Int'Last;
else exit;
Size := Container.Elements'Length;
if Size = 0 then
Size := 1;
end if; end if;
while Size < New_Size loop
Size := 2 * Size; Size := 2 * Size;
end loop; end loop;
Dst_Last_As_Int := First + Size - 1; -- TODO: The following calculations aren't quite right, since
Dst_Last := Index_Type (Dst_Last_As_Int); -- there will be overflow if Index_Type'Range is very large
-- (e.g. this package is instantiated with a 64-bit integer).
-- END TODO.
declare
Max_Size : constant Int'Base := Int (Index_Type'Last) - First + 1;
begin
if Size > Max_Size then
Size := Max_Size;
end if; end if;
end; end;
declare
Dst_Last : constant Index_Type := Index_Type (First + Size - 1);
begin
Dst := new Elements_Type (Index_Type'First .. Dst_Last); Dst := new Elements_Type (Index_Type'First .. Dst_Last);
end;
end;
declare
Src : Elements_Access := Container.Elements;
begin
if Before <= Container.Last then
declare declare
Src : Elements_Type renames Container.Elements.all; Index_As_Int : constant Int'Base :=
Index_Type'Pos (Before) + N;
Index : constant Index_Type := Index_Type (Index_As_Int);
begin begin
Dst (Index_Type'First .. Index_Type'Pred (Before)) := Dst (Index_Type'First .. Before - 1) :=
Src (Index_Type'First .. Index_Type'Pred (Before)); Src (Index_Type'First .. Before - 1);
Dst (Index .. New_Last) := Src (Before .. Container.Last); Dst (Index .. New_Last) := Src (Before .. Container.Last);
end; end;
declare else
X : Elements_Access := Container.Elements; Dst (Index_Type'First .. Container.Last) :=
begin Src (Index_Type'First .. Container.Last);
end if;
Container.Elements := Dst; Container.Elements := Dst;
Container.Last := New_Last; Container.Last := New_Last;
Free (Src);
Free (X);
end; end;
end Insert_Space; end Insert_Space;
...@@ -1535,7 +1611,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1535,7 +1611,12 @@ package body Ada.Containers.Indefinite_Vectors is
if Before.Container = null if Before.Container = null
or else Before.Index > Container.Last or else Before.Index > Container.Last
then then
Index := Index_Type'Succ (Container.Last); if Container.Last = Index_Type'Last then
raise Constraint_Error;
end if;
Index := Container.Last + 1;
else else
Index := Before.Index; Index := Before.Index;
end if; end if;
...@@ -1620,7 +1701,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1620,7 +1701,12 @@ package body Ada.Containers.Indefinite_Vectors is
L : constant Int := Int (Container.Last); L : constant Int := Int (Container.Last);
F : constant Int := Int (Index_Type'First); F : constant Int := Int (Index_Type'First);
N : constant Int'Base := L - F + 1; N : constant Int'Base := L - F + 1;
begin begin
if N > Count_Type'Pos (Count_Type'Last) then
raise Constraint_Error;
end if;
return Count_Type (N); return Count_Type (N);
end Length; end Length;
...@@ -1644,16 +1730,13 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1644,16 +1730,13 @@ package body Ada.Containers.Indefinite_Vectors is
Clear (Target); Clear (Target);
declare declare
X : Elements_Access := Target.Elements; Target_Elements : constant Elements_Access := Target.Elements;
begin begin
Target.Elements := null; Target.Elements := Source.Elements;
Free (X); Source.Elements := Target_Elements;
end; end;
Target.Elements := Source.Elements;
Target.Last := Source.Last; Target.Last := Source.Last;
Source.Elements := null;
Source.Last := No_Index; Source.Last := No_Index;
end Move; end Move;
...@@ -1668,7 +1751,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1668,7 +1751,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
if Position.Index < Position.Container.Last then if Position.Index < Position.Container.Last then
return (Position.Container, Index_Type'Succ (Position.Index)); return (Position.Container, Position.Index + 1);
end if; end if;
return No_Element; return No_Element;
...@@ -1685,7 +1768,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1685,7 +1768,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
if Position.Index < Position.Container.Last then if Position.Index < Position.Container.Last then
Position.Index := Index_Type'Succ (Position.Index); Position.Index := Position.Index + 1;
else else
Position := No_Element; Position := No_Element;
end if; end if;
...@@ -1723,7 +1806,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1723,7 +1806,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
if Position.Index > Index_Type'First then if Position.Index > Index_Type'First then
Position.Index := Index_Type'Pred (Position.Index); Position.Index := Position.Index - 1;
else else
Position := No_Element; Position := No_Element;
end if; end if;
...@@ -1736,7 +1819,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1736,7 +1819,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
if Position.Index > Index_Type'First then if Position.Index > Index_Type'First then
return (Position.Container, Index_Type'Pred (Position.Index)); return (Position.Container, Position.Index - 1);
end if; end if;
return No_Element; return No_Element;
...@@ -1751,21 +1834,20 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1751,21 +1834,20 @@ package body Ada.Containers.Indefinite_Vectors is
Index : Index_Type; Index : Index_Type;
Process : not null access procedure (Element : in Element_Type)) Process : not null access procedure (Element : in Element_Type))
is is
subtype T is Index_Type'Base range
Index_Type'First .. Container.Last;
E : Element_Type renames Container.Elements (T'(Index)).all;
V : Vector renames Container'Unrestricted_Access.all; V : Vector renames Container'Unrestricted_Access.all;
B : Natural renames V.Busy; B : Natural renames V.Busy;
L : Natural renames V.Lock; L : Natural renames V.Lock;
begin begin
if Index > Container.Last then
raise Constraint_Error;
end if;
B := B + 1; B := B + 1;
L := L + 1; L := L + 1;
begin begin
Process (E); Process (V.Elements (Index).all);
exception exception
when others => when others =>
L := L - 1; L := L - 1;
...@@ -1782,6 +1864,10 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1782,6 +1864,10 @@ package body Ada.Containers.Indefinite_Vectors is
Process : not null access procedure (Element : in Element_Type)) Process : not null access procedure (Element : in Element_Type))
is is
begin begin
if Position.Container = null then
raise Constraint_Error;
end if;
Query_Element (Position.Container.all, Position.Index, Process); Query_Element (Position.Container.all, Position.Index, Process);
end Query_Element; end Query_Element;
...@@ -1808,7 +1894,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1808,7 +1894,7 @@ package body Ada.Containers.Indefinite_Vectors is
end if; end if;
for J in Count_Type range 1 .. Length loop for J in Count_Type range 1 .. Length loop
Last := Index_Type'Succ (Last); Last := Last + 1;
Boolean'Read (Stream, B); Boolean'Read (Stream, B);
...@@ -1830,22 +1916,29 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1830,22 +1916,29 @@ package body Ada.Containers.Indefinite_Vectors is
Index : Index_Type; Index : Index_Type;
By : Element_Type) By : Element_Type)
is is
subtype T is Index_Type'Base range
Index_Type'First .. Container.Last;
X : Element_Access := Container.Elements (T'(Index));
begin begin
if Index > Container.Last then
raise Constraint_Error;
end if;
if Container.Lock > 0 then if Container.Lock > 0 then
raise Program_Error; raise Program_Error;
end if; end if;
Container.Elements (T'(Index)) := new Element_Type'(By); declare
X : Element_Access := Container.Elements (Index);
begin
Container.Elements (Index) := new Element_Type'(By);
Free (X); Free (X);
end;
end Replace_Element; end Replace_Element;
procedure Replace_Element (Position : Cursor; By : Element_Type) is procedure Replace_Element (Position : Cursor; By : Element_Type) is
begin begin
if Position.Container = null then
raise Constraint_Error;
end if;
Replace_Element (Position.Container.all, Position.Index, By); Replace_Element (Position.Container.all, Position.Index, By);
end Replace_Element; end Replace_Element;
...@@ -1885,11 +1978,11 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1885,11 +1978,11 @@ package body Ada.Containers.Indefinite_Vectors is
Elements_Type (Array_Index_Subtype); Elements_Type (Array_Index_Subtype);
X : Elements_Access := Container.Elements; X : Elements_Access := Container.Elements;
begin begin
Container.Elements := new Array_Subtype'(Src); Container.Elements := new Array_Subtype'(Src);
Free (X); Free (X);
end; end;
end if; end if;
return; return;
...@@ -1900,8 +1993,13 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1900,8 +1993,13 @@ package body Ada.Containers.Indefinite_Vectors is
Last_As_Int : constant Int'Base := Last_As_Int : constant Int'Base :=
Int (Index_Type'First) + Int (Capacity) - 1; Int (Index_Type'First) + Int (Capacity) - 1;
Last : constant Index_Type := begin
Index_Type (Last_As_Int); if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
raise Constraint_Error;
end if;
declare
Last : constant Index_Type := Index_Type (Last_As_Int);
subtype Array_Subtype is subtype Array_Subtype is
Elements_Type (Index_Type'First .. Last); Elements_Type (Index_Type'First .. Last);
...@@ -1909,6 +2007,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1909,6 +2007,7 @@ package body Ada.Containers.Indefinite_Vectors is
begin begin
Container.Elements := new Array_Subtype; Container.Elements := new Array_Subtype;
end; end;
end;
return; return;
end if; end if;
...@@ -1935,7 +2034,6 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1935,7 +2034,6 @@ package body Ada.Containers.Indefinite_Vectors is
Container.Elements := new Array_Subtype'(Src); Container.Elements := new Array_Subtype'(Src);
Free (X); Free (X);
end; end;
end if; end if;
return; return;
...@@ -1953,6 +2051,12 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1953,6 +2051,12 @@ package body Ada.Containers.Indefinite_Vectors is
Last_As_Int : constant Int'Base := Last_As_Int : constant Int'Base :=
Int (Index_Type'First) + Int (Capacity) - 1; Int (Index_Type'First) + Int (Capacity) - 1;
begin
if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
raise Constraint_Error;
end if;
declare
Last : constant Index_Type := Index_Type (Last_As_Int); Last : constant Index_Type := Index_Type (Last_As_Int);
subtype Array_Subtype is subtype Array_Subtype is
...@@ -1976,6 +2080,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -1976,6 +2080,7 @@ package body Ada.Containers.Indefinite_Vectors is
Free (X); Free (X);
end; end;
end;
end Reserve_Capacity; end Reserve_Capacity;
------------------ ------------------
...@@ -2087,42 +2192,36 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2087,42 +2192,36 @@ package body Ada.Containers.Indefinite_Vectors is
return; return;
end if; end if;
if Length = 0 then
Clear (Container);
return;
end if;
if Container.Busy > 0 then if Container.Busy > 0 then
raise Program_Error; raise Program_Error;
end if; end if;
if Length < N then
for Index in 1 .. N - Length loop
declare declare
Last_As_Int : constant Int'Base := J : constant Index_Type := Container.Last;
Int (Index_Type'First) + Int (Length) - 1; X : Element_Access := Container.Elements (J);
Last : constant Index_Type :=
Index_Type (Last_As_Int);
begin begin
if Length > N then Container.Elements (J) := null;
if Length > Capacity (Container) then Container.Last := J - 1;
Reserve_Capacity (Container, Capacity => Length); Free (X);
end if; end;
end loop;
Container.Last := Last;
return; return;
end if; end if;
for Indx in reverse Index_Type'Succ (Last) .. Container.Last loop if Length > Capacity (Container) then
Reserve_Capacity (Container, Capacity => Length);
end if;
declare declare
X : Element_Access := Container.Elements (Indx); Last_As_Int : constant Int'Base :=
Int (Index_Type'First) + Int (Length) - 1;
begin begin
Container.Elements (Indx) := null; Container.Last := Index_Type (Last_As_Int);
Container.Last := Index_Type'Pred (Container.Last);
Free (X);
end;
end loop;
end; end;
end Set_Length; end Set_Length;
...@@ -2134,19 +2233,27 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2134,19 +2233,27 @@ package body Ada.Containers.Indefinite_Vectors is
(Container : Vector; (Container : Vector;
I, J : Index_Type) I, J : Index_Type)
is is
subtype T is Index_Type'Base range begin
Index_Type'First .. Container.Last; if I > Container.Last
or else J > Container.Last
then
raise Constraint_Error;
end if;
EI : Element_Type renames Container.Elements (T'(I)).all; if I = J then
EJ : Element_Type renames Container.Elements (T'(J)).all; return;
end if;
begin
if Container.Lock > 0 then if Container.Lock > 0 then
raise Program_Error; raise Program_Error;
end if; end if;
declare declare
EI_Copy : constant Element_Type := EI; EI : Element_Access renames Container.Elements (I);
EJ : Element_Access renames Container.Elements (J);
EI_Copy : constant Element_Access := EI;
begin begin
EI := EJ; EI := EJ;
EJ := EI_Copy; EJ := EI_Copy;
...@@ -2215,10 +2322,17 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2215,10 +2322,17 @@ package body Ada.Containers.Indefinite_Vectors is
declare declare
First : constant Int := Int (Index_Type'First); First : constant Int := Int (Index_Type'First);
Last_As_Int : constant Int'Base := First + Int (Length) - 1; Last_As_Int : constant Int'Base := First + Int (Length) - 1;
Last : constant Index_Type := Index_Type (Last_As_Int); Last : Index_Type;
Elements : constant Elements_Access := Elements : Elements_Access;
new Elements_Type (Index_Type'First .. Last);
begin begin
if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
raise Constraint_Error;
end if;
Last := Index_Type (Last_As_Int);
Elements := new Elements_Type (Index_Type'First .. Last);
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
end; end;
end To_Vector; end To_Vector;
...@@ -2235,16 +2349,28 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2235,16 +2349,28 @@ package body Ada.Containers.Indefinite_Vectors is
declare declare
First : constant Int := Int (Index_Type'First); First : constant Int := Int (Index_Type'First);
Last_As_Int : constant Int'Base := First + Int (Length) - 1; Last_As_Int : constant Int'Base := First + Int (Length) - 1;
Last : constant Index_Type := Index_Type (Last_As_Int); Last : Index_Type'Base;
Elements : Elements_Access := Elements : Elements_Access;
new Elements_Type (Index_Type'First .. Last);
begin begin
for Indx in Elements'Range loop if Last_As_Int > Index_Type'Pos (Index_Type'Last) then
raise Constraint_Error;
end if;
Last := Index_Type (Last_As_Int);
Elements := new Elements_Type (Index_Type'First .. Last);
Last := Index_Type'First;
begin begin
Elements (Indx) := new Element_Type'(New_Item); loop
Elements (Last) := new Element_Type'(New_Item);
exit when Last = Elements'Last;
Last := Last + 1;
end loop;
exception exception
when others => when others =>
for J in Index_Type'First .. Index_Type'Pred (Indx) loop for J in Index_Type'First .. Last - 1 loop
Free (Elements (J)); Free (Elements (J));
end loop; end loop;
...@@ -2252,8 +2378,6 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2252,8 +2378,6 @@ package body Ada.Containers.Indefinite_Vectors is
raise; raise;
end; end;
end loop;
return (Controlled with Elements, Last, 0, 0); return (Controlled with Elements, Last, 0, 0);
end; end;
end To_Vector; end To_Vector;
...@@ -2267,21 +2391,20 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2267,21 +2391,20 @@ package body Ada.Containers.Indefinite_Vectors is
Index : Index_Type; Index : Index_Type;
Process : not null access procedure (Element : in out Element_Type)) Process : not null access procedure (Element : in out Element_Type))
is is
subtype T is Index_Type'Base range
Index_Type'First .. Container.Last;
E : Element_Type renames Container.Elements (T'(Index)).all;
V : Vector renames Container'Unrestricted_Access.all; V : Vector renames Container'Unrestricted_Access.all;
B : Natural renames V.Busy; B : Natural renames V.Busy;
L : Natural renames V.Lock; L : Natural renames V.Lock;
begin begin
if Index > Container.Last then
raise Constraint_Error;
end if;
B := B + 1; B := B + 1;
L := L + 1; L := L + 1;
begin begin
Process (E); Process (V.Elements (Index).all);
exception exception
when others => when others =>
L := L - 1; L := L - 1;
...@@ -2298,6 +2421,10 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2298,6 +2421,10 @@ package body Ada.Containers.Indefinite_Vectors is
Process : not null access procedure (Element : in out Element_Type)) Process : not null access procedure (Element : in out Element_Type))
is is
begin begin
if Position.Container = null then
raise Constraint_Error;
end if;
Update_Element (Position.Container.all, Position.Index, Process); Update_Element (Position.Container.all, Position.Index, Process);
end Update_Element; end Update_Element;
...@@ -2327,9 +2454,7 @@ package body Ada.Containers.Indefinite_Vectors is ...@@ -2327,9 +2454,7 @@ package body Ada.Containers.Indefinite_Vectors is
-- There's another way to do this. Instead a separate -- There's another way to do this. Instead a separate
-- Boolean for each element, you could write a Boolean -- Boolean for each element, you could write a Boolean
-- followed by a count of how many nulls or non-nulls -- followed by a count of how many nulls or non-nulls
-- follow in the array. Alternately you could use a -- follow in the array.
-- signed integer, and use the sign as the indicator
-- of null-ness.
if E (Indx) = null then if E (Indx) = null then
Boolean'Write (Stream, False); Boolean'Write (Stream, False);
......
gcc/ada/a-coinve.ads
...@@ -48,8 +48,7 @@ pragma Preelaborate (Indefinite_Vectors); ...@@ -48,8 +48,7 @@ pragma Preelaborate (Indefinite_Vectors);
subtype Extended_Index is Index_Type'Base subtype Extended_Index is Index_Type'Base
range Index_Type'First - 1 .. range Index_Type'First - 1 ..
Index_Type'Last + Index_Type'Min (Index_Type'Base'Last - 1, Index_Type'Last) + 1;
Boolean'Pos (Index_Type'Base'Last > Index_Type'Last);
No_Index : constant Extended_Index := Extended_Index'First; No_Index : constant Extended_Index := Extended_Index'First;
......
gcc/ada/a-convec.ads
...@@ -46,8 +46,7 @@ pragma Preelaborate (Vectors); ...@@ -46,8 +46,7 @@ pragma Preelaborate (Vectors);
subtype Extended_Index is Index_Type'Base subtype Extended_Index is Index_Type'Base
range Index_Type'First - 1 .. range Index_Type'First - 1 ..
Index_Type'Last + Index_Type'Min (Index_Type'Base'Last - 1, Index_Type'Last) + 1;
Boolean'Pos (Index_Type'Base'Last > Index_Type'Last);
No_Index : constant Extended_Index := Extended_Index'First; No_Index : constant Extended_Index := Extended_Index'First;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment