[multiple changes]
2015-05-22 Bob Duff <duff@adacore.com> * a-convec.ads, a-convec.adb (Append): Check for fast path. Split out slow path into separate procedure. Inline Append. Fast path now avoids calling Insert. (Finalize): Do the busy checking last, so the container gets emptied. (Insert, Insert_Space): Remove redundancy. 2015-05-22 Robert Dewar <dewar@adacore.com> * switch-c.adb (Scan_Front_End_Switches): Insist on -gnatc for -gnatd.V. From-SVN: r223567
This commit is contained in:
parent
84238eb02a
commit
d992a425b7
|
@ -1,3 +1,16 @@
|
|||
2015-05-22 Bob Duff <duff@adacore.com>
|
||||
|
||||
* a-convec.ads, a-convec.adb (Append): Check for fast path. Split
|
||||
out slow path into separate procedure. Inline Append. Fast path
|
||||
now avoids calling Insert.
|
||||
(Finalize): Do the busy checking last, so the container gets emptied.
|
||||
(Insert, Insert_Space): Remove redundancy.
|
||||
|
||||
2015-05-22 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* switch-c.adb (Scan_Front_End_Switches): Insist on -gnatc
|
||||
for -gnatd.V.
|
||||
|
||||
2015-05-22 Arnaud Charlet <charlet@adacore.com>
|
||||
|
||||
* gnatvsn.ads: Minor code reorg to remember more easily to update
|
||||
|
|
|
@ -59,6 +59,13 @@ package body Ada.Containers.Vectors is
|
|||
(Object : Iterator;
|
||||
Position : Cursor) return Cursor;
|
||||
|
||||
procedure Append_Slow_Path
|
||||
(Container : in out Vector;
|
||||
New_Item : Element_Type;
|
||||
Count : Count_Type);
|
||||
-- This is the slow path for Append. This is split out to minimize the size
|
||||
-- of Append, because we have Inline (Append).
|
||||
|
||||
---------
|
||||
-- "&" --
|
||||
---------
|
||||
|
@ -91,7 +98,7 @@ package body Ada.Containers.Vectors is
|
|||
Elements : constant Elements_Access :=
|
||||
new Elements_Type'(Right.Last, RE);
|
||||
begin
|
||||
return (Controlled with Elements, Right.Last, 0, 0);
|
||||
return (Controlled with Elements, Right.Last, others => <>);
|
||||
end;
|
||||
end if;
|
||||
|
||||
|
@ -102,7 +109,7 @@ package body Ada.Containers.Vectors is
|
|||
Elements : constant Elements_Access :=
|
||||
new Elements_Type'(Left.Last, LE);
|
||||
begin
|
||||
return (Controlled with Elements, Left.Last, 0, 0);
|
||||
return (Controlled with Elements, Left.Last, others => <>);
|
||||
end;
|
||||
|
||||
end if;
|
||||
|
@ -129,7 +136,7 @@ package body Ada.Containers.Vectors is
|
|||
-- exceed Index_Type'Last. We use the wider of Index_Type'Base and
|
||||
-- Count_Type'Base as the type for intermediate values.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
|
||||
-- We perform a two-part test. First we determine whether the
|
||||
-- computed Last value lies in the base range of the type, and then
|
||||
|
@ -202,7 +209,7 @@ package body Ada.Containers.Vectors is
|
|||
Elements : constant Elements_Access :=
|
||||
new Elements_Type'(Last, LE & RE);
|
||||
begin
|
||||
return (Controlled with Elements, Last, 0, 0);
|
||||
return (Controlled with Elements, Last, others => <>);
|
||||
end;
|
||||
end "&";
|
||||
|
||||
|
@ -223,7 +230,7 @@ package body Ada.Containers.Vectors is
|
|||
EA => (others => Right));
|
||||
|
||||
begin
|
||||
return (Controlled with Elements, Index_Type'First, 0, 0);
|
||||
return (Controlled with Elements, Index_Type'First, others => <>);
|
||||
end;
|
||||
end if;
|
||||
|
||||
|
@ -248,7 +255,7 @@ package body Ada.Containers.Vectors is
|
|||
Elements : constant Elements_Access :=
|
||||
new Elements_Type'(Last => Last, EA => LE & Right);
|
||||
begin
|
||||
return (Controlled with Elements, Last, 0, 0);
|
||||
return (Controlled with Elements, Last, others => <>);
|
||||
end;
|
||||
end "&";
|
||||
|
||||
|
@ -268,7 +275,7 @@ package body Ada.Containers.Vectors is
|
|||
(Last => Index_Type'First,
|
||||
EA => (others => Left));
|
||||
begin
|
||||
return (Controlled with Elements, Index_Type'First, 0, 0);
|
||||
return (Controlled with Elements, Index_Type'First, others => <>);
|
||||
end;
|
||||
end if;
|
||||
|
||||
|
@ -298,7 +305,7 @@ package body Ada.Containers.Vectors is
|
|||
EA => Left & RE);
|
||||
|
||||
begin
|
||||
return (Controlled with Elements, Last, 0, 0);
|
||||
return (Controlled with Elements, Last, others => <>);
|
||||
end;
|
||||
end "&";
|
||||
|
||||
|
@ -328,7 +335,7 @@ package body Ada.Containers.Vectors is
|
|||
EA => (Left, Right));
|
||||
|
||||
begin
|
||||
return (Controlled with Elements, Last, 0, 0);
|
||||
return (Controlled with Elements, Last, others => <>);
|
||||
end;
|
||||
end "&";
|
||||
|
||||
|
@ -456,6 +463,45 @@ package body Ada.Containers.Vectors is
|
|||
New_Item : Element_Type;
|
||||
Count : Count_Type := 1)
|
||||
is
|
||||
begin
|
||||
-- In the general case, we pass the buck to Insert, but for efficiency,
|
||||
-- we check for the usual case where Count = 1 and the vector has enough
|
||||
-- room for at least one more element.
|
||||
|
||||
if Count = 1
|
||||
and then Container.Elements /= null
|
||||
and then Container.Last /= Container.Elements.Last
|
||||
then
|
||||
if Container.Busy > 0 then
|
||||
raise Program_Error with
|
||||
"attempt to tamper with cursors (vector is busy)";
|
||||
end if;
|
||||
|
||||
-- Increment Container.Last after assigning the New_Item, so we
|
||||
-- leave the Container unmodified in case Finalize/Adjust raises
|
||||
-- an exception.
|
||||
|
||||
declare
|
||||
New_Last : constant Index_Type := Container.Last + 1;
|
||||
begin
|
||||
Container.Elements.EA (New_Last) := New_Item;
|
||||
Container.Last := New_Last;
|
||||
end;
|
||||
|
||||
else
|
||||
Append_Slow_Path (Container, New_Item, Count);
|
||||
end if;
|
||||
end Append;
|
||||
|
||||
----------------------
|
||||
-- Append_Slow_Path --
|
||||
----------------------
|
||||
|
||||
procedure Append_Slow_Path
|
||||
(Container : in out Vector;
|
||||
New_Item : Element_Type;
|
||||
Count : Count_Type)
|
||||
is
|
||||
begin
|
||||
if Count = 0 then
|
||||
return;
|
||||
|
@ -464,7 +510,7 @@ package body Ada.Containers.Vectors is
|
|||
else
|
||||
Insert (Container, Container.Last + 1, New_Item, Count);
|
||||
end if;
|
||||
end Append;
|
||||
end Append_Slow_Path;
|
||||
|
||||
------------
|
||||
-- Assign --
|
||||
|
@ -705,7 +751,7 @@ package body Ada.Containers.Vectors is
|
|||
-- index value New_Last is the last index value of their new home, and
|
||||
-- index value J is the first index of their old home.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
New_Last := Old_Last - Index_Type'Base (Count);
|
||||
J := Index + Index_Type'Base (Count);
|
||||
else
|
||||
|
@ -814,7 +860,7 @@ package body Ada.Containers.Vectors is
|
|||
if Count >= Container.Length then
|
||||
Container.Last := No_Index;
|
||||
|
||||
elsif Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
elsif Index_Type'Base'Last >= Count_Type_Last then
|
||||
Container.Last := Container.Last - Index_Type'Base (Count);
|
||||
|
||||
else
|
||||
|
@ -858,14 +904,14 @@ package body Ada.Containers.Vectors is
|
|||
X : Elements_Access := Container.Elements;
|
||||
|
||||
begin
|
||||
Container.Elements := null;
|
||||
Container.Last := No_Index;
|
||||
|
||||
Free (X);
|
||||
|
||||
if Container.Busy > 0 then
|
||||
raise Program_Error with
|
||||
"attempt to tamper with cursors (vector is busy)";
|
||||
|
||||
else
|
||||
Container.Elements := null;
|
||||
Container.Last := No_Index;
|
||||
Free (X);
|
||||
end if;
|
||||
end Finalize;
|
||||
|
||||
|
@ -1334,7 +1380,7 @@ package body Ada.Containers.Vectors is
|
|||
-- deeper flaw in the caller's algorithm, so that case is treated as a
|
||||
-- proper error.)
|
||||
|
||||
if Before > Container.Last and then Before > Container.Last + 1 then
|
||||
if Before > Container.Last + 1 then
|
||||
raise Constraint_Error with
|
||||
"Before index is out of range (too large)";
|
||||
end if;
|
||||
|
@ -1367,7 +1413,7 @@ package body Ada.Containers.Vectors is
|
|||
-- compare the new length to the maximum length. If the new length is
|
||||
-- acceptable, then we compute the new last index from that.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
|
||||
-- We have to handle the case when there might be more values in the
|
||||
-- range of Index_Type than in the range of Count_Type.
|
||||
|
@ -1402,9 +1448,8 @@ package body Ada.Containers.Vectors is
|
|||
-- worry about if No_Index were less than 0, but that case is
|
||||
-- handled above).
|
||||
|
||||
if Index_Type'Last - No_Index >=
|
||||
Count_Type'Pos (Count_Type'Last)
|
||||
then
|
||||
if Index_Type'Last - No_Index >= Count_Type_Last then
|
||||
|
||||
-- We have determined that range of Index_Type has at least as
|
||||
-- many values as in Count_Type, so Count_Type'Last is the
|
||||
-- maximum number of items that are allowed.
|
||||
|
@ -1469,7 +1514,7 @@ package body Ada.Containers.Vectors is
|
|||
-- insertion. Use the wider of Index_Type'Base and Count_Type'Base to
|
||||
-- compute its value from the New_Length.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
New_Last := No_Index + Index_Type'Base (New_Length);
|
||||
else
|
||||
New_Last := Index_Type'Base (Count_Type'Base (No_Index) + New_Length);
|
||||
|
@ -1537,7 +1582,7 @@ package body Ada.Containers.Vectors is
|
|||
-- new home. We use the wider of Index_Type'Base and
|
||||
-- Count_Type'Base as the type for intermediate index values.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
Index := Before + Index_Type'Base (Count);
|
||||
else
|
||||
Index := Index_Type'Base (Count_Type'Base (Before) + Count);
|
||||
|
@ -1583,7 +1628,7 @@ package body Ada.Containers.Vectors is
|
|||
-- We have computed the length of the new internal array (and this is
|
||||
-- what "vector capacity" means), so use that to compute its last index.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
Dst_Last := No_Index + Index_Type'Base (New_Capacity);
|
||||
else
|
||||
Dst_Last :=
|
||||
|
@ -1616,7 +1661,7 @@ package body Ada.Containers.Vectors is
|
|||
-- The new items are being inserted before some existing elements,
|
||||
-- so we must slide the existing elements up to their new home.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
Index := Before + Index_Type'Base (Count);
|
||||
else
|
||||
Index := Index_Type'Base (Count_Type'Base (Before) + Count);
|
||||
|
@ -1679,7 +1724,7 @@ package body Ada.Containers.Vectors is
|
|||
-- We calculate the last index value of the destination slice using the
|
||||
-- wider of Index_Type'Base and count_Type'Base.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
J := (Before - 1) + Index_Type'Base (N);
|
||||
else
|
||||
J := Index_Type'Base (Count_Type'Base (Before - 1) + N);
|
||||
|
@ -1722,7 +1767,7 @@ package body Ada.Containers.Vectors is
|
|||
-- equals Index_Type'First, then this first source slice will be
|
||||
-- empty, which is harmless.)
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
K := L + Index_Type'Base (Src'Length);
|
||||
else
|
||||
K := Index_Type'Base (Count_Type'Base (L) + Src'Length);
|
||||
|
@ -1765,7 +1810,7 @@ package body Ada.Containers.Vectors is
|
|||
-- destination that receives this slice of the source. (For the
|
||||
-- reasons given above, this slice is guaranteed to be non-empty.)
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
K := F - Index_Type'Base (Src'Length);
|
||||
else
|
||||
K := Index_Type'Base (Count_Type'Base (F) - Src'Length);
|
||||
|
@ -1996,7 +2041,7 @@ package body Ada.Containers.Vectors is
|
|||
-- deeper flaw in the caller's algorithm, so that case is treated as a
|
||||
-- proper error.)
|
||||
|
||||
if Before > Container.Last and then Before > Container.Last + 1 then
|
||||
if Before > Container.Last + 1 then
|
||||
raise Constraint_Error with
|
||||
"Before index is out of range (too large)";
|
||||
end if;
|
||||
|
@ -2029,7 +2074,7 @@ package body Ada.Containers.Vectors is
|
|||
-- compare the new length to the maximum length. If the new length is
|
||||
-- acceptable, then we compute the new last index from that.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
|
||||
-- We have to handle the case when there might be more values in the
|
||||
-- range of Index_Type than in the range of Count_Type.
|
||||
|
@ -2064,9 +2109,8 @@ package body Ada.Containers.Vectors is
|
|||
-- worry about if No_Index were less than 0, but that case is
|
||||
-- handled above).
|
||||
|
||||
if Index_Type'Last - No_Index >=
|
||||
Count_Type'Pos (Count_Type'Last)
|
||||
then
|
||||
if Index_Type'Last - No_Index >= Count_Type_Last then
|
||||
|
||||
-- We have determined that range of Index_Type has at least as
|
||||
-- many values as in Count_Type, so Count_Type'Last is the
|
||||
-- maximum number of items that are allowed.
|
||||
|
@ -2131,7 +2175,7 @@ package body Ada.Containers.Vectors is
|
|||
-- insertion. Use the wider of Index_Type'Base and Count_Type'Base to
|
||||
-- compute its value from the New_Length.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
New_Last := No_Index + Index_Type'Base (New_Length);
|
||||
else
|
||||
New_Last := Index_Type'Base (Count_Type'Base (No_Index) + New_Length);
|
||||
|
@ -2192,7 +2236,7 @@ package body Ada.Containers.Vectors is
|
|||
-- home. We use the wider of Index_Type'Base and
|
||||
-- Count_Type'Base as the type for intermediate index values.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
Index := Before + Index_Type'Base (Count);
|
||||
|
||||
else
|
||||
|
@ -2238,7 +2282,7 @@ package body Ada.Containers.Vectors is
|
|||
-- We have computed the length of the new internal array (and this is
|
||||
-- what "vector capacity" means), so use that to compute its last index.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
Dst_Last := No_Index + Index_Type'Base (New_Capacity);
|
||||
else
|
||||
Dst_Last :=
|
||||
|
@ -2269,7 +2313,7 @@ package body Ada.Containers.Vectors is
|
|||
-- The space is being inserted before some existing elements, so
|
||||
-- we must slide the existing elements up to their new home.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
Index := Before + Index_Type'Base (Count);
|
||||
else
|
||||
Index := Index_Type'Base (Count_Type'Base (Before) + Count);
|
||||
|
@ -3011,7 +3055,7 @@ package body Ada.Containers.Vectors is
|
|||
-- the Last index value of the new internal array, in a way that avoids
|
||||
-- any possibility of overflow.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
|
||||
-- We perform a two-part test. First we determine whether the
|
||||
-- computed Last value lies in the base range of the type, and then
|
||||
|
@ -3528,7 +3572,7 @@ package body Ada.Containers.Vectors is
|
|||
-- index). We must therefore check whether the specified Length would
|
||||
-- create a Last index value greater than Index_Type'Last.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
|
||||
-- We perform a two-part test. First we determine whether the
|
||||
-- computed Last value lies in the base range of the type, and then
|
||||
|
@ -3595,7 +3639,7 @@ package body Ada.Containers.Vectors is
|
|||
|
||||
Elements := new Elements_Type (Last);
|
||||
|
||||
return Vector'(Controlled with Elements, Last, 0, 0);
|
||||
return Vector'(Controlled with Elements, Last, others => <>);
|
||||
end To_Vector;
|
||||
|
||||
function To_Vector
|
||||
|
@ -3618,7 +3662,7 @@ package body Ada.Containers.Vectors is
|
|||
-- index). We must therefore check whether the specified Length would
|
||||
-- create a Last index value greater than Index_Type'Last.
|
||||
|
||||
if Index_Type'Base'Last >= Count_Type'Pos (Count_Type'Last) then
|
||||
if Index_Type'Base'Last >= Count_Type_Last then
|
||||
|
||||
-- We perform a two-part test. First we determine whether the
|
||||
-- computed Last value lies in the base range of the type, and then
|
||||
|
@ -3685,7 +3729,7 @@ package body Ada.Containers.Vectors is
|
|||
|
||||
Elements := new Elements_Type'(Last, EA => (others => New_Item));
|
||||
|
||||
return Vector'(Controlled with Elements, Last, 0, 0);
|
||||
return Vector'(Controlled with Elements, Last, others => <>);
|
||||
end To_Vector;
|
||||
|
||||
--------------------
|
||||
|
|
|
@ -352,6 +352,7 @@ package Ada.Containers.Vectors is
|
|||
|
||||
private
|
||||
|
||||
pragma Inline (Append);
|
||||
pragma Inline (First_Index);
|
||||
pragma Inline (Last_Index);
|
||||
pragma Inline (Element);
|
||||
|
@ -368,24 +369,23 @@ private
|
|||
type Elements_Array is array (Index_Type range <>) of aliased Element_Type;
|
||||
function "=" (L, R : Elements_Array) return Boolean is abstract;
|
||||
|
||||
type Elements_Type (Last : Index_Type) is limited record
|
||||
type Elements_Type (Last : Extended_Index) is limited record
|
||||
EA : Elements_Array (Index_Type'First .. Last);
|
||||
end record;
|
||||
|
||||
type Elements_Access is access Elements_Type;
|
||||
type Elements_Access is access all Elements_Type;
|
||||
|
||||
use Ada.Finalization;
|
||||
use Ada.Streams;
|
||||
|
||||
type Vector is new Controlled with record
|
||||
Elements : Elements_Access;
|
||||
Elements : Elements_Access := null;
|
||||
Last : Extended_Index := No_Index;
|
||||
Busy : Natural := 0;
|
||||
Lock : Natural := 0;
|
||||
end record;
|
||||
|
||||
overriding procedure Adjust (Container : in out Vector);
|
||||
|
||||
overriding procedure Finalize (Container : in out Vector);
|
||||
|
||||
procedure Write
|
||||
|
@ -495,6 +495,10 @@ private
|
|||
|
||||
No_Element : constant Cursor := Cursor'(null, Index_Type'First);
|
||||
|
||||
Empty_Vector : constant Vector := (Controlled with null, No_Index, 0, 0);
|
||||
Empty_Vector : constant Vector := (Controlled with others => <>);
|
||||
|
||||
Count_Type_Last : constant := Count_Type'Last;
|
||||
-- Count_Type'Last as a universal_integer, so we can compare Index_Type
|
||||
-- values against this without type conversions that might overflow.
|
||||
|
||||
end Ada.Containers.Vectors;
|
||||
|
|
|
@ -387,6 +387,15 @@ package body Switch.C is
|
|||
Osint.Fail
|
||||
("-gnatd.b must be first if combined "
|
||||
& "with other switches");
|
||||
|
||||
-- Special check, -gnatd.V must occur after -gnatc
|
||||
|
||||
elsif C = 'V'
|
||||
and then Operating_Mode /= Check_Semantics
|
||||
then
|
||||
Osint.Fail
|
||||
("gnatd.V requires previous occurrence "
|
||||
& "of -gnatc");
|
||||
end if;
|
||||
|
||||
-- Not a dotted flag
|
||||
|
|
Loading…
Reference in New Issue