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

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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 83b6596e5dbf4e9a4632c09412e3f8f170768c72..d01469f226472523aa8ae2f50d0b71e63c1872fb 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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

diff --git a/gcc/ada/g-dyntab.adb b/gcc/ada/g-dyntab.adb
index eff48cbdd8f0012d3a0e54bc76f2cbb7f6a1bcd9..7159059ce57bf124473361403a3fd0816ec318bf 100644 (file)
--- a/gcc/ada/g-dyntab.adb
+++ b/gcc/ada/g-dyntab.adb
@@ -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
+   begin
       pragma Assert (not T.Locked);
-      Item_Copy : constant Table_Component_Type := Item;
 
-   begin
       --  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;
 
    --------------

diff --git a/gcc/ada/g-dyntab.ads b/gcc/ada/g-dyntab.ads
index a1e9507a6d44256a2f53af5346d6a828fc4ac0fd..cb4b74123bdcf1c2018d0110ba96e08532c37bfd 100644 (file)
--- a/gcc/ada/g-dyntab.ads
+++ b/gcc/ada/g-dyntab.ads
@@ -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

diff --git a/gcc/ada/g-table.ads b/gcc/ada/g-table.ads
index 3df5694fcf7e28e847813ff20d3fe620138171e0..77e5bafcd355920b8da3a2de4c1aca86d5cdc376 100644 (file)
--- a/gcc/ada/g-table.ads
+++ b/gcc/ada/g-table.ads
@@ -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;

diff --git a/gcc/ada/sinput.ads b/gcc/ada/sinput.ads
index 7162d0fd747a761b6589362421162aa2cc156c00..6b5b412b35dcee14abd4437db14c26319e6a1fbe 100644 (file)
--- a/gcc/ada/sinput.ads
+++ b/gcc/ada/sinput.ads
@@ -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;