FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

g-dyntab.ads, [...]: Remove incorrect assertion.

Browse source 
2017-04-27  Bob Duff  <duff@adacore.com>

	* g-dyntab.ads, g-dyntab.adb, g-table.ads: Remove incorrect assertion.
	If the table grows and then shrinks back to empty, we won't necessarily
	point back to the empty array. Code cleanups.
	* sinput.ads: Add 'Base to Size clause to match the declared
	component subtypes.

From-SVN: r247329
This commit is contained in:
Bob Duff 2017-04-27 13:05:10 +00:00 • committed by Arnaud Charlet
parent f2acfbce60
commit 7494697b8c
5 changed files with 42 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/ada/ChangeLog
View file

@ -1,3 +1,11 @@
2017-04-27 Bob Duff <duff@adacore.com>
* g-dyntab.ads, g-dyntab.adb, g-table.ads: Remove incorrect assertion.
If the table grows and then shrinks back to empty, we won't necessarily
point back to the empty array. Code cleanups.
* sinput.ads: Add 'Base to Size clause to match the declared
component subtypes.
2017-04-27 Claire Dross <dross@adacore.com>
* a-cforma.adb, a-cforma.ads (=): Generic parameter removed to

44
gcc/ada/g-dyntab.adb
View file

@ -46,7 +46,7 @@ package body GNAT.Dynamic_Tables is
-- This is called when we are about to set the value of Last to a value
-- that is larger than Last_Allocated. This reallocates the table to the
-- larger size, as indicated by New_Last. At the time this is called,
-- T.P.Last is still the old value.
-- Last (T) is still the old value, and this does not modify it.
--------------
-- Allocate --
@ -57,7 +57,7 @@ package body GNAT.Dynamic_Tables is
-- Note that Num can be negative
pragma Assert (not T.Locked);
Set_Last (T, T.P.Last + Table_Index_Type'Base (Num));
Set_Last (T, Last (T) + Table_Index_Type'Base (Num));
end Allocate;
------------
@ -65,9 +65,17 @@ package body GNAT.Dynamic_Tables is
------------
procedure Append (T : in out Instance; New_Val : Table_Component_Type) is
begin
pragma Assert (not T.Locked);
Set_Item (T, T.P.Last + 1, New_Val);
New_Last : constant Table_Last_Type := Last (T) + 1;
begin
if New_Last <= T.P.Last_Allocated then
-- fast path
T.P.Last := New_Last;
T.Table (New_Last) := New_Val;
else
Set_Item (T, New_Last, New_Val);
end if;
end Append;
----------------
@ -185,7 +193,7 @@ package body GNAT.Dynamic_Tables is
begin
if T.Table /= Empty_Table_Ptr then
New_Table (First .. T.P.Last) := Old_Table (First .. T.P.Last);
New_Table (First .. Last (T)) := Old_Table (First .. Last (T));
Free (Old_Table);
end if;
@ -238,10 +246,8 @@ package body GNAT.Dynamic_Tables is
--------------
function Is_Empty (T : Instance) return Boolean is
Result : constant Boolean := T.P.Last = Table_Low_Bound - 1;
begin
pragma Assert (Result = (T.Table = Empty_Table_Ptr));
return Result;
return Last (T) = Table_Low_Bound - 1;
end Is_Empty;
----------
@ -292,7 +298,7 @@ package body GNAT.Dynamic_Tables is
subtype Table_Length_Type is Table_Index_Type'Base
range 0 .. Table_Index_Type'Base'Last;
Length : constant Table_Length_Type := T.P.Last - First + 1;
Length : constant Table_Length_Type := Last (T) - First + 1;
Comp_Size_In_Bytes : constant Table_Length_Type :=
Table_Type'Component_Size / System.Storage_Unit;
@ -302,7 +308,7 @@ package body GNAT.Dynamic_Tables is
begin
if Release_Threshold = 0 or else Length < Length_Threshold then
return T.P.Last;
return Last (T);
else
declare
Extra_Length : constant Table_Length_Type := Length / 1000;
@ -320,7 +326,7 @@ package body GNAT.Dynamic_Tables is
begin
if New_Last_Alloc < T.P.Last_Allocated then
pragma Assert (T.P.Last < T.P.Last_Allocated);
pragma Assert (Last (T) < T.P.Last_Allocated);
pragma Assert (T.Table /= Empty_Table_Ptr);
declare
@ -359,10 +365,9 @@ package body GNAT.Dynamic_Tables is
Index : Valid_Table_Index_Type;
Item : Table_Component_Type)
is
pragma Assert (not T.Locked);
Item_Copy : constant Table_Component_Type := Item;
begin
pragma Assert (not T.Locked);
-- If Set_Last is going to reallocate the table, we make a copy of Item,
-- in case the call was "Set_Item (T, X, T.Table (Y));", and Item is
-- passed by reference. Without the copy, we would deallocate the array
@ -376,14 +381,13 @@ package body GNAT.Dynamic_Tables is
T.Table (Index) := Item_Copy;
end;
return;
end if;
else
if Index > Last (T) then
Set_Last (T, Index);
end if;
if Index > T.P.Last then
Set_Last (T, Index);
T.Table (Index) := Item;
end if;
T.Table (Index) := Item_Copy;
end Set_Item;
--------------

1
gcc/ada/g-dyntab.ads
View file

@ -183,6 +183,7 @@ package GNAT.Dynamic_Tables is
end record;
function Is_Empty (T : Instance) return Boolean;
pragma Inline (Is_Empty);
procedure Init (T : in out Instance);
-- Reinitializes the table to empty. There is no need to call this before

8
gcc/ada/g-table.ads
View file

@ -82,7 +82,9 @@ package GNAT.Table is
function Is_Empty return Boolean;
procedure Init;
pragma Inline (Init);
procedure Free;
pragma Inline (Free);
function First return Table_Index_Type;
pragma Inline (First);
@ -91,6 +93,7 @@ package GNAT.Table is
pragma Inline (Last);
procedure Release;
pragma Inline (Release);
procedure Set_Last (New_Val : Table_Last_Type);
pragma Inline (Set_Last);
@ -105,6 +108,7 @@ package GNAT.Table is
pragma Inline (Append);
procedure Append_All (New_Vals : Table_Type);
pragma Inline (Append_All);
procedure Set_Item
(Index : Valid_Table_Index_Type;
@ -115,10 +119,12 @@ package GNAT.Table is
-- Type used for Save/Restore subprograms
function Save return Saved_Table;
pragma Inline (Save);
-- Resets table to empty, but saves old contents of table in returned
-- value, for possible later restoration by a call to Restore.
procedure Restore (T : in out Saved_Table);
pragma Inline (Restore);
-- Given a Saved_Table value returned by a prior call to Save, restores
-- the table to the state it was in at the time of the Save call.
@ -137,9 +143,11 @@ package GNAT.Table is
Item : Table_Component_Type;
Quit : in out Boolean) is <>;
procedure For_Each;
pragma Inline (For_Each);
generic
with function Lt (Comp1, Comp2 : Table_Component_Type) return Boolean;
procedure Sort_Table;
pragma Inline (Sort_Table);
end GNAT.Table;

2
gcc/ada/sinput.ads
View file

@ -936,7 +936,7 @@ private
type Dope_Rec is record
First, Last : Source_Ptr'Base;
end record;
Dope_Rec_Size : constant := 2 * Source_Ptr'Size;
Dope_Rec_Size : constant := 2 * Source_Ptr'Base'Size;
for Dope_Rec'Size use Dope_Rec_Size;
for Dope_Rec'Alignment use Dope_Rec_Size / 8;
type Dope_Ptr is access all Dope_Rec;